feat(capture): persist bounded table snapshots with atomic writes

A version 1 capture contains a fixed header, three metadata strings and the table frames below the selected root. Integers are little-endian and no OCaml values are marshalled, so the reader can check lengths and tags before constructing a paging context.

## Header

```text

offset  bytes  encoding  field

0       8      bytes     53 43 4f 50 45 00 01 0a

8       4      u32       domid

12      4      u32       vcpu

16      4      u32       physical-address width

20      4      u32       feature flags

24      56     7 * u64   cr0 cr2 cr3 cr4 efer rflags rip

80      4      u32       root-override tag

84      8      u64       root-override value

feature flags

  bit 0 = nx

  bit 1 = 1 gib pages

  other bits = rejected

root override

  tag 0 = use saved cr3, value must be zero

  tag 1 = select value as the raw root, retain saved cr3

  other tags = rejected

```

## Payload

```text

string       = u32 byte-length, byte-length bytes

metadata     = string source, string consistency, string domain-identity

frame        = u64 guest-physical-address, u32 tag, frame-payload

tag 0        = 4096 bytes of table contents

tag 1        = string read-error

frames       = u32 count, count frame records

file         = header, metadata, frames, 16-byte digest

digest       = raw md5 of every preceding byte

bounds

  runtime                 = 64-bit

  physical width          = 32..52

  string length           <= 4096

  frame count             <= 65536

  file length             <= 280000000

  frame alignment         = 4096

  duplicate frames        = rejected

  unknown frame tags      = rejected

  out-of-width addresses  = rejected

  trailing payload bytes  = rejected

  checksum mismatch       = rejected

```

MD5 detects accidental corruption and does not authenticate a capture. Writes go through a mode-0600 temporary file beside the destination, followed by `fsync` and rename, but the directory itself is not synchronised and the rename may therefore be lost after a host crash.

## Import

```text

command

  scope import TRANSCRIPT OUTPUT [--source TEXT]

records

  context CR0 CR2 CR3 CR4 EFER RFLAGS RIP PHYS_BITS NX GB_PAGES

  page ADDRESS HEX

  missing ADDRESS REASON

grammar

  addresses and registers = unsigned decimal or 0x-prefixed hex

  phys_bits               = decimal

  nx and gb_pages         = 0 or 1

  hex                     = 8192 hex digits in ascending byte order

  field separator         = ordinary spaces

  record separator        = newline

  reason                  = rest of line, may be empty

  context count           = exactly one, may follow frame records

  duplicate frames        = rejected

  unknown records         = rejected

  line length             <= 16384 bytes

  input length            <= 840000000 bytes

  imported root override  = none

  imported domid and vcpu  = 0

```

## Reports

```text

schema               = scope.report.v1

addresses and sizes  = hexadecimal strings

complete             = completeness of the requested analysis

info                  = checks the selected table graph

walk                  = structural fault bits, no assumed access or privilege

explain               = error code for the explicit request

ac                    = captured rflags unless --ac overrides it

error_code_scope      = structural_bits_only or request

diff

  intervals            = disjoint virtual ranges

  mapping states       = values and paths at the interval start

  leaf sizes           = original sizes retained

  huge-page split      = potentially one record per smaller leaf

  unreadable subtree   = incomplete, never treated as absent

limits

  traversal budget     = abort before emitting a partial report

  alias budget         = abort before emitting a partial report

  error stream         = stderr, structured when --json is selected

  result stream        = stdout

  exit 0               = complete, no fault or finding

  exit 1               = predicted fault, invalid table, alias or diff

  exit 2               = incomplete or operational failure

  exit 64              = usage error

```

module Frames = Map.Make (struct

  type t = int64

  let compare = Address.compare

end)

type t = {

  context : Model.context;

  frames : (string, string) result Frames.t;

}

let maximum_pages = 65536

let maximum_bytes = 280_000_000

let context capture = capture.context

let pages capture = Frames.cardinal capture.frames

let make context frames =

  Model.validate context;

  if List.length frames > maximum_pages then invalid_arg "too many capture pages";

  let frames = List.fold_left (fun map (address, page) ->

    let raw = Address.Physical.to_int64 address in

    if Int64.logand raw 0xfffL <> 0L || Address.compare raw (Address.mask context.features.phys_bits) > 0 then

      invalid_arg "unaligned or out-of-range table frame";

    if Frames.mem raw map then invalid_arg "duplicate table frame";

    (match page with

    | Ok bytes when String.length bytes <> 4096 -> invalid_arg "table must contain 4096 bytes"

    | Error reason when String.length reason > 4096 -> invalid_arg "table error is too long"

    | _ -> ());

    Frames.add raw page map) Frames.empty frames

  in

  { context; frames }

let read capture address =

  let raw = Address.Physical.to_int64 address in

  match Frames.find_opt raw capture.frames with

  | Some page -> page

  | None -> Error ("table not captured at " ^ Address.hex raw)

let with_root capture root =

  let context = { capture.context with root_override = Some root } in

  Model.validate context;

  { capture with context }

let collect ?(max_pages = maximum_pages) context reader =

  Model.validate context;

  if max_pages < 1 || max_pages > maximum_pages then invalid_arg "invalid capture page budget";

  let frames = ref Frames.empty and visited = Hashtbl.create 64 in

  let rec go level address =

    let raw = Address.Physical.to_int64 address in

    if not (Hashtbl.mem visited (level, raw)) then begin

      Hashtbl.add visited (level, raw) ();

      let page = match Frames.find_opt raw !frames with

        | Some page -> page

        | None ->

            if Frames.cardinal !frames >= max_pages then raise (Model.Limit "capture page budget exceeded");

            let page = reader address in

            (match page with Ok bytes when String.length bytes <> 4096 -> invalid_arg "short table read" | _ -> ());

            frames := Frames.add raw page !frames;

            page

      in

      match page with

      | Error _ -> ()

      | Ok bytes ->

          for index = 0 to 511 do

            let entry = String.get_int64_le bytes (index * 8) in

            match Paging.decode context.features ~nxe:(Address.bit context.registers.efer 11) ~level entry with

            | Paging.Table next -> go (level - 1) next

            | _ -> ()

          done

    end

  in

  go 4 (Model.root context);

  { context; frames = !frames }

let complete capture =

  let closure = collect capture.context (read capture) in

  Frames.for_all (fun _ -> function Ok _ -> true | Error _ -> false) closure.frames

let add_u32 buffer n =

  let bytes = Bytes.create 4 in

  Bytes.set_int32_le bytes 0 (Int32.of_int n);

  Buffer.add_bytes buffer bytes

let add_u64 buffer n =

  let bytes = Bytes.create 8 in

  Bytes.set_int64_le bytes 0 n;

  Buffer.add_bytes buffer bytes

let add_string buffer s =

  if String.length s > 4096 then invalid_arg "capture string exceeds 4096 bytes";

  add_u32 buffer (String.length s);

  Buffer.add_string buffer s

let encode capture =

  let buffer = Buffer.create (128 + pages capture * 4112) in

  Buffer.add_string buffer "SCOPE\000\001\n";

  let c = capture.context in

  add_u32 buffer c.domid;

  add_u32 buffer c.vcpu;

  add_u32 buffer c.features.phys_bits;

  add_u32 buffer ((if c.features.nx then 1 else 0) lor (if c.features.gb_pages then 2 else 0));

  let r = c.registers in

  List.iter (add_u64 buffer) [r.cr0; r.cr2; r.cr3; r.cr4; r.efer; r.rflags; r.rip];

  add_u32 buffer (if c.root_override = None then 0 else 1);

  add_u64 buffer (Option.value c.root_override ~default:0L);

  List.iter (add_string buffer) [c.source; c.consistency; c.identity];

  add_u32 buffer (pages capture);

  Frames.iter (fun address page ->

    add_u64 buffer address;

    match page with

    | Ok bytes -> add_u32 buffer 0; Buffer.add_string buffer bytes

    | Error reason -> add_u32 buffer 1; add_string buffer reason) capture.frames;

  let payload = Buffer.contents buffer in

  payload ^ Digest.string payload

let save path capture =

  let bytes = encode capture in

  let temporary, channel = Filename.open_temp_file ~temp_dir:(Filename.dirname path) ".scope" ".tmp" in

  Fun.protect ~finally:(fun () -> close_out_noerr channel; if Sys.file_exists temporary then Sys.remove temporary)

    (fun () ->

      output_string channel bytes;

      flush channel;

      Unix.fsync (Unix.descr_of_out_channel channel);

      close_out channel;

      Unix.rename temporary path)

let load path =

  let channel = open_in_bin path in

  let bytes = Fun.protect ~finally:(fun () -> close_in_noerr channel) (fun () ->

    let length = in_channel_length channel in

    if length > maximum_bytes || length < 24 then invalid_arg "capture size outside format bounds";

    really_input_string channel length)

  in

  let limit = String.length bytes - 16 in

  if Digest.string (String.sub bytes 0 limit) <> String.sub bytes limit 16 then

    invalid_arg "capture checksum mismatch";

  let position = ref 0 in

  let take n =

    if n < 0 || n > limit - !position then invalid_arg "truncated capture";

    let s = String.sub bytes !position n in

    position := !position + n;

    s

  in

  let u32 () =

    let n = Int64.logand (Int64.of_int32 (String.get_int32_le (take 4) 0)) 0xffffffffL in

    if n > Int64.of_int max_int then invalid_arg "capture integer overflow";

    Int64.to_int n

  in

  let u64 () = String.get_int64_le (take 8) 0 in

  let string () = let n = u32 () in if n > 4096 then invalid_arg "capture string too long"; take n in

  if take 8 <> "SCOPE\000\001\n" then invalid_arg "unsupported capture format";

  let domid = u32 () in

  let vcpu = u32 () in

  let phys_bits = u32 () in

  let flags = u32 () in

  if flags land (lnot 3) <> 0 then invalid_arg "unsupported feature flags";

  let cr0 = u64 () in

  let cr2 = u64 () in

  let cr3 = u64 () in

  let cr4 = u64 () in

  let efer = u64 () in

  let rflags = u64 () in

  let rip = u64 () in

  let root_tag = u32 () in

  let root_value = u64 () in

  let root_override = match root_tag, root_value with

    | 0, 0L -> None | 1, value -> Some value | _ -> invalid_arg "invalid root override record"

  in

  let source = string () in

  let consistency = string () in

  let identity = string () in

  let count = u32 () in

  if count > maximum_pages then invalid_arg "too many capture pages";

  let frames = List.init count (fun _ ->

    let address = Address.Physical.of_int64 (u64 ()) in

    let page = match u32 () with

      | 0 -> Ok (take 4096)

      | 1 -> Error (string ())

      | _ -> invalid_arg "invalid table record tag"

    in

    address, page)

  in

  if !position <> limit then invalid_arg "trailing capture data";

  make { registers = { cr0; cr2; cr3; cr4; efer; rflags; rip }; root_override;

    features = { phys_bits; nx = flags land 1 <> 0; gb_pages = flags land 2 <> 0 };

    source; consistency; identity; domid; vcpu } frames

let import ~source path =

  let channel = open_in path in

  Fun.protect ~finally:(fun () -> close_in_noerr channel) (fun () ->

    if in_channel_length channel > maximum_bytes * 3 then invalid_arg "import exceeds format size budget";

    let context = ref None and frames = ref [] and count = ref 0 in

    let number = ref 0 in

    (try while true do

      let line = input_line channel in

      incr number;

      if String.length line > 16384 then invalid_arg "import line exceeds 16384 bytes";

      let fields = String.split_on_char ' ' line |> List.filter ((<>) "") in

      match fields with

      | [] -> ()

      | ["context"; cr0; cr2; cr3; cr4; efer; rflags; rip; phys_bits; nx; gb_pages] ->

          if !context <> None then invalid_arg "duplicate import context";

          let boolean = function "0" -> false | "1" -> true | _ -> invalid_arg "invalid feature boolean" in

          let open Model in

          context := Some { registers = { cr0 = Address.parse cr0; cr2 = Address.parse cr2;

              cr3 = Address.parse cr3; cr4 = Address.parse cr4; efer = Address.parse efer;

              rflags = Address.parse rflags; rip = Address.parse rip };

            features = { phys_bits = int_of_string phys_bits; nx = boolean nx; gb_pages = boolean gb_pages };

            root_override = None; source; consistency = "offline import; producer defines consistency";

            identity = "import"; domid = 0; vcpu = 0 }

      | ["page"; address; hex] ->

          incr count;

          if !count > maximum_pages then invalid_arg "too many imported pages";

          if String.length hex <> 8192 then invalid_arg "page hex must contain 8192 digits";

          let digit = function

            | '0' .. '9' as c -> Char.code c - Char.code '0'

            | 'a' .. 'f' as c -> Char.code c - Char.code 'a' + 10

            | 'A' .. 'F' as c -> Char.code c - Char.code 'A' + 10

            | _ -> invalid_arg "invalid page hex"

          in

          let bytes = String.init 4096 (fun i -> Char.chr ((digit hex.[2*i] lsl 4) lor digit hex.[2*i+1])) in

          frames := (Address.Physical.of_int64 (Address.parse address), Ok bytes) :: !frames

      | "missing" :: address :: reason ->

          incr count;

          if !count > maximum_pages then invalid_arg "too many imported pages";

          frames := (Address.Physical.of_int64 (Address.parse address), Error (String.concat " " reason)) :: !frames

      | _ -> invalid_arg (Printf.sprintf "invalid import record on line %d" !number)

    done with End_of_file -> ());

    match !context with None -> invalid_arg "missing import context" | Some context -> make context !frames)

type t

val make : Model.context -> (Address.Physical.t * (string, string) result) list -> t

val context : t -> Model.context

val read : t -> Model.reader

val pages : t -> int

val with_root : t -> int64 -> t

val collect : ?max_pages:int -> Model.context -> Model.reader -> t

val complete : t -> bool

val save : string -> t -> unit

val load : string -> t

val import : source:string -> string -> t