A => .github/workflows/check.yml +17 -0
@@ 1,17 @@
+name: check
+on: [push, pull_request]
+jobs:
+ check:
+ runs-on: ubuntu-24.04
+ strategy:
+ matrix:
+ ocaml: [4.14.2, 5.5.0]
+ steps:
+ - uses: actions/checkout@v4
+ - uses: ocaml/setup-ocaml@v3
+ with:
+ ocaml-compiler: ${{ matrix.ocaml }}
+ - run: sudo apt-get update && sudo apt-get install -y qemu-system-x86 libxen-dev
+ - run: opam install . --deps-only --with-test
+ - run: opam exec -- make check
+ - run: opam exec -- make xen
A => .gitignore +4 -0
@@ 1,4 @@
+_build/
+*.install
+guest/build/
+__pycache__/
A => Makefile +18 -0
@@ 1,18 @@
+.PHONY: all check guest xen clean
+
+all:
+ dune build @all
+
+check:
+ dune runtest
+ $(MAKE) -C guest check
+
+guest: all
+ $(MAKE) -C guest check
+
+xen:
+ python3 test/xen.py $(XEN_INCLUDE)
+
+clean:
+ dune clean
+ $(MAKE) -C guest clean
A => README.md +3 -0
@@ 1,3 @@
+Inspects four level x86_64 guest page tables on Xen and replays captures offline. It reports the entries consulted during translation and predicts ordinary explicit paging accesses using the captured register state and an explicit guest feature profile.
+
+https://github.com/user-attachments/assets/6f04c3f8-36fb-4c3e-9736-68b43d92baf3
A => bin/dune +4 -0
@@ 1,4 @@
+(executable
+ (name main)
+ (public_name scope)
+ (libraries scope unix))
A => bin/main.ml +309 -0
@@ 1,309 @@
+open Scope
+open Model
+
+exception Usage of string
+exception Interrupted of int
+
+let usage = "scope 0.1.0\n\n\
+ scope info CAPTURE\n\
+ scope walk CAPTURE ADDRESS\n\
+ scope explain CAPTURE ADDRESS --access read|write|execute --privilege supervisor|user\n\
+ scope mappings CAPTURE\n\
+ scope aliases CAPTURE\n\
+ scope diff BEFORE AFTER [--include-ad]\n\
+ scope capture DOMAIN OUTPUT --vcpu N --phys-bits N --nx on|off --gb-pages on|off [--pause]\n\
+ scope watch DOMAIN DIRECTORY --vcpu N --phys-bits N --nx on|off --gb-pages on|off [--pause]\n\
+ scope import TRANSCRIPT OUTPUT\n\
+ scope demo DIRECTORY\n\n\
+addresses are unsigned decimal or 0x-prefixed hexadecimal\n\
+exit status: 0 success, 1 fault or findings, 2 incomplete or operational failure, 64 usage\n"
+
+type options = {
+ mutable json : bool;
+ mutable root : int64 option;
+ mutable max_entries : int;
+ mutable max_pages : int;
+ mutable max_pairs : int;
+ mutable include_ad : bool;
+ mutable access : access option;
+ mutable privilege : privilege option;
+ mutable ac : bool option;
+ mutable vcpu : int option;
+ mutable phys_bits : int option;
+ mutable nx : bool option;
+ mutable gb_pages : bool option;
+ mutable pause : bool;
+ mutable first : int64 option;
+ mutable last : int64 option;
+ mutable source : string;
+ mutable interval : float;
+ mutable count : int;
+ mutable retain : int;
+ mutable scan_aliases : bool;
+}
+
+let boolean = function "on" -> true | "off" -> false | _ -> raise (Usage "expected on or off")
+let required name = function Some value -> value | None -> raise (Usage ("missing " ^ name))
+
+let parse () =
+ let options = { json = false; root = None; max_entries = 2_000_000; max_pages = 65536;
+ max_pairs = 100_000; include_ad = false; access = None; privilege = None; ac = None;
+ vcpu = None; phys_bits = None; nx = None; gb_pages = None; pause = false;
+ first = None; last = None; source = "offline import";
+ interval = 2.; count = 0; retain = 32; scan_aliases = false } in
+ let positional = ref [] in
+ let seen = Hashtbl.create 16 in
+ let wrap flag action = fun value ->
+ if Hashtbl.mem seen flag then raise (Usage ("duplicate option " ^ flag));
+ Hashtbl.add seen flag ();
+ action value
+ in
+ let specs = [
+ "--interval", Arg.Float (wrap "--interval" (fun n -> options.interval <- n)), "SECONDS delay after each watch sample";
+ "--count", Arg.Int (wrap "--count" (fun n -> options.count <- n)), "N watch samples, zero means until interrupted";
+ "--retain", Arg.Int (wrap "--retain" (fun n -> options.retain <- n)), "N evidence pairs to retain";
+ "--aliases", Arg.Unit (wrap "--aliases" (fun () -> options.scan_aliases <- true)), " scan writable/executable aliases while watching";
+ "--json", Arg.Unit (wrap "--json" (fun () -> options.json <- true)), " emit scope.report.v1 json";
+ "--root", Arg.String (wrap "--root" (fun s -> options.root <- Some (Address.parse s))), "ADDRESS select root while preserving captured cr3";
+ "--max-entries", Arg.Int (wrap "--max-entries" (fun n -> options.max_entries <- n)), "N traversal budget";
+ "--max-pages", Arg.Int (wrap "--max-pages" (fun n -> options.max_pages <- n)), "N capture page budget";
+ "--max-pairs", Arg.Int (wrap "--max-pairs" (fun n -> options.max_pairs <- n)), "N alias output budget";
+ "--include-ad", Arg.Unit (wrap "--include-ad" (fun () -> options.include_ad <- true)), " include accessed and dirty changes";
+ "--access", Arg.Symbol (["read"; "write"; "execute"], wrap "--access" (fun s ->
+ options.access <- Some (match s with "read" -> Read | "write" -> Write | _ -> Execute))), " requested access";
+ "--privilege", Arg.Symbol (["supervisor"; "user"], wrap "--privilege" (fun s ->
+ options.privilege <- Some (if s = "user" then User else Supervisor))), " access privilege";
+ "--ac", Arg.String (wrap "--ac" (fun s -> options.ac <- Some (boolean s))), "on|off override captured ac for explicit data accesses";
+ "--vcpu", Arg.Int (wrap "--vcpu" (fun n -> options.vcpu <- Some n)), "N vcpu to capture";
+ "--phys-bits", Arg.Int (wrap "--phys-bits" (fun n -> options.phys_bits <- Some n)), "N guest maxphyaddr";
+ "--nx", Arg.String (wrap "--nx" (fun s -> options.nx <- Some (boolean s))), "on|off guest nx capability";
+ "--gb-pages", Arg.String (wrap "--gb-pages" (fun s -> options.gb_pages <- Some (boolean s))), "on|off guest 1 gib page capability";
+ "--pause", Arg.Unit (wrap "--pause" (fun () -> options.pause <- true)), " hold a controller pause during capture";
+ "--start", Arg.String (wrap "--start" (fun s -> options.first <- Some (Address.parse s))), "ADDRESS select overlapping regions";
+ "--end", Arg.String (wrap "--end" (fun s -> options.last <- Some (Address.parse s))), "ADDRESS inclusive range end";
+ "--source", Arg.String (wrap "--source" (fun s -> options.source <- s)), "TEXT import provenance";
+ ] in
+ Arg.parse_argv Sys.argv specs (fun value -> positional := value :: !positional) usage;
+ if options.max_entries < 1 || options.max_pages < 1 || options.max_pairs < 1 then raise (Usage "budgets must be positive");
+ if not (Float.is_finite options.interval) || options.interval <= 0. || options.count < 0 || options.retain < 1 then
+ raise (Usage "watch interval and retention must be positive; count must be nonnegative");
+ (match options.first, options.last with Some a, Some b when Address.compare a b > 0 ->
+ raise (Usage "range start exceeds range end") | _ -> ());
+ options, List.rev !positional, seen
+
+let selected options (region : Paging.region) =
+ (match options.first with None -> true | Some first -> Address.compare (Paging.last region) first >= 0) &&
+ (match options.last with None -> true | Some last -> Address.compare region.start last <= 0)
+
+let complete regions = List.for_all (fun (region : Paging.region) ->
+ match region.state with Paging.Unknown _ -> false | _ -> true) regions
+
+let invalid regions = List.exists (fun (region : Paging.region) ->
+ match region.state with Paging.Broken _ -> true | _ -> false) regions
+
+let run options positional seen =
+ let command = match positional with command :: _ -> command | [] -> raise (Usage usage) in
+ let allowed = ["--json"] @ (match command with
+ | "info" -> []
+ | "walk" -> ["--root"]
+ | "explain" -> ["--root"; "--access"; "--privilege"; "--ac"]
+ | "mappings" -> ["--root"; "--max-entries"; "--start"; "--end"]
+ | "aliases" -> ["--root"; "--max-entries"; "--max-pairs"; "--start"; "--end"]
+ | "diff" -> ["--root"; "--max-entries"; "--start"; "--end"; "--include-ad"]
+ | "capture" -> ["--root"; "--max-pages"; "--vcpu"; "--phys-bits"; "--nx"; "--gb-pages"; "--pause"]
+ | "watch" -> ["--root"; "--max-pages"; "--max-entries"; "--max-pairs"; "--vcpu"; "--phys-bits";
+ "--nx"; "--gb-pages"; "--pause"; "--interval"; "--count"; "--retain"; "--aliases";
+ "--include-ad"; "--start"; "--end"]
+ | "import" -> ["--source"]
+ | "demo" -> []
+ | _ -> raise (Usage ("unknown command: " ^ command))) in
+ Hashtbl.iter (fun flag () -> if not (List.mem flag allowed) then raise (Usage (flag ^ " does not apply to " ^ command))) seen;
+ let load path =
+ let capture = Capture.load path in
+ match options.root with None -> capture | Some root -> Capture.with_root capture root
+ in
+ let enumerate capture = Paging.enumerate ~max_entries:options.max_entries (Capture.context capture) (Capture.read capture) in
+ let output_context capture = if not options.json then Report.print_context (Capture.context capture) in
+ let emit capture complete fields = Json.print (Report.envelope command (Capture.context capture) complete fields) in
+ match positional with
+ | ["watch"; domain; directory] ->
+ let domid = try int_of_string domain with Failure _ -> raise (Usage "invalid domain id") in
+ let vcpu = required "--vcpu" options.vcpu in
+ let features = { phys_bits = required "--phys-bits" options.phys_bits;
+ nx = required "--nx" options.nx; gb_pages = required "--gb-pages" options.gb_pages } in
+ let capture () = Xen.capture ~domid ~vcpu ~pause:options.pause ~features ~root:options.root ~max_pages:options.max_pages in
+ let emit (event : Watch.event) =
+ let context = Capture.context event.after in
+ if options.json then Json.print (Report.envelope "watch" context event.complete [
+ "event", Json.String event.kind; "sample", Json.Int event.sample;
+ "time", Json.String (Printf.sprintf "%.6f" event.time);
+ "evidence", (if event.directory = "" then Json.Null else Json.String event.directory);
+ "summary", Json.Object ["mappings", Json.Int event.mappings; "mapped_virtual_bytes", Json.hex event.bytes;
+ "executable", Json.Int event.executable; "writable", Json.Int event.writable; "huge", Json.Int event.huge];
+ "context_changes", Json.List (List.map Json.string event.context_changes);
+ "changes", Json.List (List.map Report.change event.changes);
+ "aliases", Json.List (List.map Report.alias event.aliases)])
+ else begin
+ Printf.printf "time=%.3f sample=%d event=%s root=%s mappings=%d bytes=%s executable=%d writable=%d huge=%d complete=%b\n"
+ event.time event.sample event.kind (Address.hex (Address.Physical.to_int64 (Model.root context)))
+ event.mappings (Address.hex event.bytes) event.executable event.writable event.huge event.complete;
+ List.iter (fun (change : Analysis.change) ->
+ Printf.printf " %s length=%s changes=%s\n" (Address.hex change.start) (Address.hex change.length)
+ (String.concat "," change.kinds);
+ List.iter (fun (label, state) -> match state with
+ | Some (Paging.Present m) -> Printf.printf " %s physical=%s page_size=%s %s\n"
+ label (Address.hex (Address.Physical.to_int64 m.physical_address)) (Address.hex m.size) (Report.rights m.permissions)
+ | _ -> ()) ["before", change.before; "after", change.after]) event.changes;
+ if event.directory <> "" then Printf.printf " evidence=%S aliases=%d context_changes=%s\n"
+ event.directory (List.length event.aliases) (String.concat "," event.context_changes);
+ if event.directory <> "" then List.iter (fun (alias : Analysis.alias) ->
+ Printf.printf " alias physical=%s length=%s writable=%s executable=%s\n"
+ (Address.hex alias.physical) (Address.hex alias.length)
+ (Address.hex (Address.Virtual.to_int64 alias.writable.virtual_address))
+ (Address.hex (Address.Virtual.to_int64 alias.executable.virtual_address))) event.aliases
+ end;
+ flush stdout
+ in
+ (try Watch.run ~capture ~wait:Unix.sleepf ~emit ~directory ~interval:options.interval
+ ~count:options.count ~retain:options.retain ~max_entries:options.max_entries ~max_pairs:options.max_pairs
+ ~include_ad:options.include_ad ~scan_aliases:options.scan_aliases ~selected:(selected options) ()
+ with Interrupted _ -> 0)
+ | ["demo"; directory] ->
+ Demo.write directory;
+ if options.json then Json.print (Json.Object ["schema", Json.String "scope.report.v1";
+ "command", Json.String "demo"; "directory", Json.String directory])
+ else Printf.printf "captures=%s/before,%s/after source=synthetic\n" directory directory;
+ 0
+ | ["import"; transcript; destination] ->
+ let capture = Capture.import ~source:options.source transcript in
+ let complete = Capture.complete capture in
+ Capture.save destination capture;
+ if options.json then emit capture complete ["path", Json.String destination; "pages", Json.Int (Capture.pages capture)]
+ else Printf.printf "capture=%s pages=%d complete=%b\n" destination (Capture.pages capture) complete;
+ if complete then 0 else 2
+ | ["capture"; domain; destination] ->
+ let domid = try int_of_string domain with Failure _ -> raise (Usage "invalid domain id") in
+ let vcpu = required "--vcpu" options.vcpu in
+ let features = { phys_bits = required "--phys-bits" options.phys_bits;
+ nx = required "--nx" options.nx; gb_pages = required "--gb-pages" options.gb_pages } in
+ let capture = Xen.capture ~domid ~vcpu ~pause:options.pause ~features ~root:options.root ~max_pages:options.max_pages in
+ let complete = Capture.complete capture in
+ Capture.save destination capture;
+ output_context capture;
+ if options.json then emit capture complete ["path", Json.String destination; "pages", Json.Int (Capture.pages capture)]
+ else Printf.printf "capture=%s pages=%d complete=%b\n" destination (Capture.pages capture) complete;
+ if complete then 0 else 2
+ | ["info"; path] ->
+ let capture = load path in
+ let complete = Capture.complete capture in
+ output_context capture;
+ if options.json then emit capture complete ["pages", Json.Int (Capture.pages capture); "xen_available", Json.Bool (Xen.available ())]
+ else Printf.printf "pages=%d complete=%b xen_available=%b\n" (Capture.pages capture) complete (Xen.available ());
+ if complete then 0 else 2
+ | [("walk" | "explain"); path; address] ->
+ let capture = load path in
+ let context = Capture.context capture in
+ let address = Address.Virtual.of_int64 (Address.parse address) in
+ let request = if command = "walk" then None else Some {
+ access = required "--access" options.access;
+ privilege = required "--privilege" options.privilege;
+ ac = Option.value options.ac ~default:(Address.bit context.registers.rflags 18) } in
+ let result = match request with
+ | None -> Paging.walk context (Capture.read capture) address
+ | Some request -> Paging.explain context (Capture.read capture) address request
+ in
+ let complete = match result.outcome with Incomplete _ -> false | _ -> true in
+ output_context capture;
+ if options.json then emit capture complete [
+ "address", Json.hex (Address.Virtual.to_int64 address);
+ "error_code_scope", Json.String (if request = None then "structural_bits_only" else "request");
+ "request", Json.option (fun (request : request) -> Json.Object ["access", Json.String (access_name request.access);
+ "privilege", Json.String (privilege_name request.privilege); "ac", Json.Bool request.ac]) request;
+ "trace", Json.List (List.map Report.step result.trace); "result", Report.outcome result.outcome]
+ else begin
+ if request = None then print_endline "access=unspecified error_code=structural-bits-only";
+ Option.iter (fun (request : request) -> Printf.printf "access=%s privilege=%s ac=%b\n"
+ (access_name request.access) (privilege_name request.privilege) request.ac) request;
+ Report.print_result result
+ end;
+ (match result.outcome with Mapped _ -> 0 | Fault _ -> 1 | Incomplete _ -> 2)
+ | ["mappings"; path] ->
+ let capture = load path in
+ let regions = enumerate capture |> List.filter (selected options) in
+ let complete = complete regions in
+ output_context capture;
+ if options.json then emit capture complete ["regions", Json.List (List.map Report.region regions)]
+ else List.iter Report.print_region regions;
+ if not complete then 2 else if invalid regions then 1 else 0
+ | ["aliases"; path] ->
+ let capture = load path in
+ let regions = enumerate capture |> List.filter (selected options) in
+ let complete = complete regions in
+ let aliases = Analysis.aliases ~max_pairs:options.max_pairs regions in
+ output_context capture;
+ if options.json then emit capture complete ["aliases", Json.List (List.map Report.alias aliases);
+ "regions", Json.List (List.filter_map (fun region ->
+ match region.Paging.state with Paging.Present _ -> None | _ -> Some (Report.region region)) regions)]
+ else begin
+ List.iter (fun (alias : Analysis.alias) ->
+ Printf.printf "physical=%s length=%s writable=%s executable=%s\n"
+ (Address.hex alias.physical) (Address.hex alias.length)
+ (Address.hex (Address.Virtual.to_int64 alias.writable.virtual_address))
+ (Address.hex (Address.Virtual.to_int64 alias.executable.virtual_address));
+ List.iter Report.print_step alias.writable.trace;
+ List.iter Report.print_step alias.executable.trace) aliases;
+ List.iter (fun region -> match region.Paging.state with Paging.Present _ -> () | _ -> Report.print_region region) regions
+ end;
+ if not complete then 2 else if aliases = [] && not (invalid regions) then 0 else 1
+ | ["diff"; before; after] ->
+ let a = load before and b = load after in
+ let context_changes = Model.context_changes (Capture.context a) (Capture.context b) in
+ let ra = enumerate a and rb = enumerate b in
+ let changes = Analysis.diff ~include_ad:options.include_ad ra rb |> List.filter (fun (c : Analysis.change) ->
+ selected options { Paging.start = c.start; length = c.length; state = Paging.Unknown "" }) in
+ let complete = not (List.exists (fun (c : Analysis.change) -> List.mem "incomplete" c.kinds) changes) in
+ if options.json then emit a complete ["after_context", Report.context (Capture.context b);
+ "context_changes", Json.List (List.map Json.string context_changes);
+ "include_ad", Json.Bool options.include_ad; "changes", Json.List (List.map Report.change changes)]
+ else begin
+ Report.print_context (Capture.context a);
+ print_endline "after:";
+ Report.print_context (Capture.context b);
+ Printf.printf "context_changes=%s include_ad=%b\n" (String.concat "," context_changes) options.include_ad;
+ List.iter (fun (c : Analysis.change) ->
+ Printf.printf "%s length=%s changes=%s\n" (Address.hex c.start) (Address.hex c.length) (String.concat "," c.kinds);
+ let print label = function
+ | None -> Printf.printf " %s absent\n" label
+ | Some (Paging.Present m) -> Printf.printf " %s physical=%s page_size=%s %s leaf=%s\n" label
+ (Address.hex (Address.Physical.to_int64 m.physical_address)) (Address.hex m.size)
+ (Report.rights m.permissions) (Address.hex m.leaf)
+ | Some (Paging.Unknown reason) -> Printf.printf " %s incomplete=%s\n" label reason
+ | Some (Paging.Broken reason) -> Printf.printf " %s invalid=%s\n" label reason
+ in
+ print "before" c.before;
+ print "after" c.after) changes
+ end;
+ if not complete then 2 else if changes = [] && context_changes = [] then 0 else 1
+ | _ -> raise (Usage ("wrong arguments for " ^ command ^ "\n" ^ usage))
+
+let () =
+ Sys.set_signal Sys.sigint (Sys.Signal_handle (fun signal -> raise (Interrupted signal)));
+ Sys.set_signal Sys.sigterm (Sys.Signal_handle (fun signal -> raise (Interrupted signal)));
+ let json = Array.exists ((=) "--json") Sys.argv in
+ let fail code reason =
+ if json then Json.output stderr (Json.Object ["schema", Json.String "scope.report.v1";
+ "error", Json.String reason; "complete", Json.Bool false])
+ else Printf.eprintf "scope: %s\n" reason;
+ if json then output_char stderr '\n';
+ exit code
+ in
+ try
+ let options, positional, seen = parse () in
+ exit (run options positional seen)
+ with
+ | Usage reason | Arg.Bad reason -> fail 64 reason
+ | Arg.Help text -> print_string text; exit 0
+ | Invalid_argument reason | Failure reason | Sys_error reason | Model.Limit reason -> fail 2 reason
+ | Fun.Finally_raised exn -> fail 2 ("cleanup failed: " ^ Printexc.to_string exn)
+ | Unix.Unix_error (error, operation, path) -> fail 2 (operation ^ " " ^ path ^ ": " ^ Unix.error_message error)
+ | Interrupted signal -> fail 2 (Printf.sprintf "interrupted by signal %d" signal)
A => dune-project +8 -0
@@ 1,8 @@
+(lang dune 3.10)
+(name scope)
+(version 0.1.0)
+(generate_opam_files true)
+(package
+ (name scope)
+ (synopsis "Inspect and replay Xen guest page tables")
+ (depends (ocaml (>= 4.14)) dune))
A => examples/after +0 -0
A => examples/before +0 -0
A => guest/Makefile +30 -0
@@ 1,30 @@
+CC ?= cc
+LD ?= ld
+OBJCOPY ?= objcopy
+CFLAGS = -std=c11 -O2 -Wall -Wextra -Werror -ffreestanding -fno-pie -fno-stack-protector -fno-builtin -mno-red-zone -mgeneral-regs-only
+
+.PHONY: all check clean
+
+all: build/disk
+
+build:
+ mkdir -p build
+
+build/boot.o: boot.S | build
+ $(CC) -c -m64 -fno-pie $< -o $@
+
+build/guest.o: guest.c | build
+ $(CC) $(CFLAGS) -c $< -o $@
+
+build/guest: build/boot.o build/guest.o layout.ld
+ $(LD) -T layout.ld build/boot.o build/guest.o -o $@
+
+build/disk: build/guest
+ $(OBJCOPY) -O binary $< $@
+ python3 -c 'from pathlib import Path; p = Path("$@"); b = p.read_bytes(); assert len(b) <= 61440; p.write_bytes(b.ljust(61952, b"\0"))'
+
+check: build/disk
+ python3 verify.py ../_build/default/bin/main.exe build/disk
+
+clean:
+ rm -rf build
A => guest/boot.S +173 -0
@@ 1,173 @@
+.section .boot,"ax"
+.code16
+.global boot
+boot:
+ cli
+ xor %ax, %ax
+ mov %ax, %ds
+ mov %ax, %es
+ mov %ax, %ss
+ mov $0x7c00, %sp
+ mov $packet, %si
+ mov $0x42, %ah
+ int $0x13
+ jc stopped
+ in $0x92, %al
+ or $2, %al
+ out %al, $0x92
+ lgdt descriptor
+ mov %cr0, %eax
+ or $1, %eax
+ mov %eax, %cr0
+ ljmpl $8, $protected
+stopped:
+ hlt
+ jmp stopped
+.balign 8
+packet:
+ .byte 16, 0
+ .word 120
+ .word 0, 0x1000
+ .quad 1
+.global gdt
+gdt:
+ .quad 0
+ .quad 0x00cf9a000000ffff
+ .quad 0x00cf92000000ffff
+ .quad 0x00af9a000000ffff
+ .quad 0x00affa000000ffff
+ .quad 0x00cff2000000ffff
+ .quad 0, 0
+descriptor:
+ .word 63
+ .long gdt
+.org 510
+.word 0xaa55
+
+.section .text
+.code32
+protected:
+ mov $0x10, %ax
+ mov %ax, %ds
+ mov %ax, %es
+ mov %ax, %ss
+ mov $0x90000, %esp
+ cld
+ mov $0x70000, %edi
+ xor %eax, %eax
+ mov $3072, %ecx
+ rep stosl
+ movl $0x71003, 0x70000
+ movl $0x72003, 0x71000
+ mov $0x72000, %edi
+ mov $0x83, %eax
+ mov $512, %ecx
+1:
+ mov %eax, (%edi)
+ add $0x200000, %eax
+ add $8, %edi
+ loop 1b
+ mov $0x20, %eax
+ mov %eax, %cr4
+ mov $0x70000, %eax
+ mov %eax, %cr3
+ mov $0xc0000080, %ecx
+ rdmsr
+ or $0x900, %eax
+ wrmsr
+ mov %cr0, %eax
+ or $0x80010000, %eax
+ mov %eax, %cr0
+ ljmp $0x18, $longmode
+
+.code64
+longmode:
+ mov $0x10, %ax
+ mov %ax, %ds
+ mov %ax, %es
+ mov %ax, %ss
+ mov $0x90000, %rsp
+ lea __bss_start(%rip), %rdi
+ lea __bss_end(%rip), %rcx
+ sub %rdi, %rcx
+ xor %eax, %eax
+ rep stosb
+ call guest
+2:
+ hlt
+ jmp 2b
+
+.global probe
+probe:
+ mov %rsp, recovery_stack(%rip)
+ lea 5f(%rip), %rax
+ mov %rax, recovery_address(%rip)
+ test %edi, %edi
+ jz 3f
+ cmp $1, %edi
+ je 4f
+ call *%rsi
+ jmp 5f
+3:
+ mov (%rsi), %rax
+ jmp 5f
+4:
+ movq $0xc3, (%rsi)
+5:
+ ret
+
+.global probe_user
+probe_user:
+ mov %rsp, recovery_stack(%rip)
+ lea 9f(%rip), %rax
+ mov %rax, recovery_address(%rip)
+ pushq $0x2b
+ pushq $0x86000
+ pushq $2
+ pushq $0x23
+ lea 6f(%rip), %rax
+ push %rax
+ iretq
+6:
+ test %edi, %edi
+ jz 7f
+ cmp $1, %edi
+ je 8f
+ call *%rsi
+ int $0x80
+7:
+ mov (%rsi), %rax
+ int $0x80
+8:
+ movq $0xc3, (%rsi)
+ int $0x80
+9:
+ ret
+
+.global completed
+completed:
+ pushq $0
+ jmp recover
+
+.global pagefault
+pagefault:
+ movq $14, observed_vector(%rip)
+ jmp recover
+.global protection
+protection:
+ movq $13, observed_vector(%rip)
+recover:
+ push %rax
+ mov 8(%rsp), %rax
+ mov %rax, observed_error(%rip)
+ mov recovery_address(%rip), %rax
+ mov %rax, 16(%rsp)
+ mov recovery_stack(%rip), %rax
+ mov %rax, 40(%rsp)
+ movq $0x18, 24(%rsp)
+ movq $0x10, 48(%rsp)
+ pop %rax
+ add $8, %rsp
+ iretq
+
+.section .note.GNU-stack,"",@progbits
A => guest/guest.c +223 -0
@@ 1,223 @@
+#include <stdint.h>
+#include <stddef.h>
+
+static uint64_t root[512] __attribute__((aligned(4096)));
+static uint64_t directory[512] __attribute__((aligned(4096)));
+static uint64_t middle[512] __attribute__((aligned(4096)));
+static uint64_t table[512] __attribute__((aligned(4096)));
+static uint8_t payload[4096] __attribute__((aligned(4096)));
+
+volatile uint64_t recovery_stack;
+volatile uint64_t recovery_address;
+volatile uint64_t observed_vector;
+volatile uint64_t observed_error;
+
+extern void probe(int access, uint64_t address);
+extern void pagefault(void);
+extern void protection(void);
+extern void completed(void);
+extern void probe_user(int access, uint64_t address);
+extern uint64_t gdt[];
+
+struct gate {
+ uint16_t low;
+ uint16_t selector;
+ uint8_t ist;
+ uint8_t flags;
+ uint16_t middle;
+ uint32_t high;
+ uint32_t reserved;
+} __attribute__((packed));
+
+static struct gate idt[256];
+static int phys_bits;
+static int nx;
+static int gb_pages;
+static int user_mode;
+static uint64_t root_bits;
+
+static struct {
+ uint32_t reserved;
+ uint64_t rsp[3];
+ uint64_t reserved1;
+ uint64_t ist[7];
+ uint64_t reserved2;
+ uint16_t reserved3;
+ uint16_t iomap;
+} __attribute__((packed)) tss;
+
+static void put(char c) {
+ __asm__ volatile("outb %0, $0xe9" : : "a"(c));
+}
+
+static void text(const char *s) {
+ while (*s) put(*s++);
+}
+
+static void hex(uint64_t n) {
+ text("0x");
+ for (int shift = 60; shift >= 0; shift -= 4) put("0123456789abcdef"[(n >> shift) & 15]);
+}
+
+static void decimal(int n) {
+ if (n >= 10) decimal(n / 10);
+ put('0' + n % 10);
+}
+
+static uint64_t cr0(void) {
+ uint64_t value;
+ __asm__ volatile("mov %%cr0, %0" : "=r"(value));
+ return value;
+}
+
+static uint64_t cr4(void) {
+ uint64_t value;
+ __asm__ volatile("mov %%cr4, %0" : "=r"(value));
+ return value;
+}
+
+static void set_cr0(uint64_t value) {
+ __asm__ volatile("mov %0, %%cr0" : : "r"(value) : "memory");
+}
+
+static void set_cr4(uint64_t value) {
+ __asm__ volatile("mov %0, %%cr4" : : "r"(value) : "memory");
+}
+
+static uint64_t efer(void) {
+ uint32_t low, high;
+ __asm__ volatile("rdmsr" : "=a"(low), "=d"(high) : "c"(0xc0000080));
+ return (uint64_t)high << 32 | low;
+}
+
+static void set_efer(uint64_t value) {
+ __asm__ volatile("wrmsr" : : "a"((uint32_t)value), "d"((uint32_t)(value >> 32)), "c"(0xc0000080));
+}
+
+static void set_ac(int enabled) {
+ uint64_t flags;
+ __asm__ volatile("pushfq; pop %0" : "=r"(flags));
+ flags = enabled ? flags | (1u << 18) : flags & ~(1u << 18);
+ __asm__ volatile("push %0; popfq" : : "r"(flags) : "cc", "memory");
+}
+
+static void flush(void) {
+ __asm__ volatile("mov %0, %%cr3" : : "r"((uint64_t)root | root_bits) : "memory");
+}
+
+static void gate(int vector, void (*handler)(void)) {
+ uint64_t address = (uint64_t)handler;
+ idt[vector] = (struct gate){address, 0x18, 0, 0x8e, address >> 16, address >> 32, 0};
+}
+
+static void reset(void) {
+ __asm__ volatile("mov %0, %%cr3" : : "r"(0x70000ull) : "memory");
+ set_cr4(0x20);
+ set_cr0(cr0() | (1u << 16));
+ set_efer(efer() | (1u << 11));
+ set_ac(0);
+ user_mode = 0;
+ root_bits = 0;
+ for (int i = 0; i < 512; i++) root[i] = directory[i] = middle[i] = table[i] = 0;
+ root[0] = (uint64_t)directory | 7;
+ directory[0] = (uint64_t)middle | 7;
+ middle[0] = 0x83;
+ middle[2] = (uint64_t)table | 7;
+ table[0] = (uint64_t)payload | 3;
+ payload[0] = 0xc3;
+ flush();
+}
+
+static void page(uint64_t *frame) {
+ text("page ");
+ hex((uint64_t)frame);
+ put(' ');
+ const uint8_t *bytes = (const uint8_t *)frame;
+ for (int i = 0; i < 4096; i++) {
+ put("0123456789abcdef"[bytes[i] >> 4]);
+ put("0123456789abcdef"[bytes[i] & 15]);
+ }
+ put('\n');
+}
+
+static void run(const char *name, int access, uint64_t address) {
+ uint64_t flags, current_cr2, current_cr3;
+ flush();
+ __asm__ volatile("pushfq; pop %0" : "=r"(flags));
+ __asm__ volatile("mov %%cr2, %0" : "=r"(current_cr2));
+ __asm__ volatile("mov %%cr3, %0" : "=r"(current_cr3));
+ text("begin "); text(name); put(' '); decimal(access); put(' '); hex(address);
+ text(user_mode ? " user\n" : " supervisor\n");
+ text("context "); hex(cr0()); put(' '); hex(current_cr2); put(' '); hex(current_cr3);
+ put(' '); hex(cr4()); put(' '); hex(efer()); put(' '); hex(flags); text(" 0x0 ");
+ decimal(phys_bits); put(' '); decimal(nx); put(' '); decimal(gb_pages); put('\n');
+ page(root); page(directory); page(middle); page(table);
+ observed_vector = 0;
+ observed_error = 0;
+ flush();
+ if (user_mode) probe_user(access, address);
+ else probe(access, address);
+ text("observed "); decimal(observed_vector); put(' '); decimal(observed_error); put('\n');
+ text("end\n");
+}
+
+static void run_user(const char *name, int access) {
+ middle[0] |= 4;
+ user_mode = 1;
+ run(name, access, 0x400000);
+}
+
+void guest(void) {
+ uint32_t a, b, c, d;
+ __asm__ volatile("cpuid" : "=a"(a), "=b"(b), "=c"(c), "=d"(d) : "a"(0x80000008), "c"(0));
+ phys_bits = a & 255;
+ __asm__ volatile("cpuid" : "=a"(a), "=b"(b), "=c"(c), "=d"(d) : "a"(0x80000001), "c"(0));
+ nx = (d >> 20) & 1;
+ gb_pages = (d >> 26) & 1;
+ gate(13, protection);
+ gate(14, pagefault);
+ gate(0x80, completed);
+ idt[0x80].flags = 0xee;
+ tss.rsp[0] = 0x88000;
+ tss.iomap = sizeof(tss);
+ uint64_t base = (uint64_t)&tss;
+ gdt[6] = (sizeof(tss) - 1) | ((base & 0xffffff) << 16) | (0x89ull << 40) | ((base >> 24) << 56);
+ gdt[7] = base >> 32;
+ __asm__ volatile("ltr %0" : : "r"((uint16_t)0x30));
+ struct { uint16_t limit; uint64_t base; } __attribute__((packed)) idtr = {sizeof(idt) - 1, (uint64_t)idt};
+ __asm__ volatile("lidt %0" : : "m"(idtr));
+ reset(); run("read", 0, 0x400000);
+ reset(); run("write", 1, 0x400000);
+ reset(); run("execute", 2, 0x400000);
+ reset(); middle[2] &= ~2ull; run("parent", 1, 0x400000);
+ reset(); middle[2] &= ~2ull; set_cr0(cr0() & ~(1u << 16)); run("wp", 1, 0x400000);
+ reset(); table[0] |= 1ull << 63; run("nx", 2, 0x400000);
+ reset(); middle[2] |= 1ull << 63; run("ancestor", 2, 0x400000);
+ reset(); table[0] = 0; run("absent", 0, 0x400000);
+ reset(); table[0] = 0; run("absentwrite", 1, 0x400000);
+ reset(); table[0] = 0; run("absentfetch", 2, 0x400000);
+ reset(); table[0] |= 1ull << phys_bits; run("reserved", 0, 0x400000);
+ reset(); table[0] |= 1ull << 63; set_efer(efer() & ~(1u << 11)); run("nxe", 0, 0x400000);
+ reset(); middle[2] = 0x2083; run("alignment", 0, 0x400000);
+ reset(); middle[2] = 0x1083; run("huge", 0, 0x401000);
+ reset(); directory[1] = 0x83; run("giga", 0, 0x40001000);
+ reset(); table[0] |= 0x80; run("pat", 0, 0x400000);
+ reset(); root[1] = 0x83; run("pml", 0, 0x8000000000);
+ reset(); run("canonical", 0, 0x800000000000);
+ reset(); table[0] |= 4; set_cr4(cr4() | (1u << 20)); run("smep", 2, 0x400000);
+ reset(); table[0] |= 4; set_cr4(cr4() | (1u << 21)); run("smap", 0, 0x400000);
+ reset(); table[0] |= 4; set_cr4(cr4() | (1u << 21)); run("smapwrite", 1, 0x400000);
+ reset(); table[0] |= 4; set_cr4(cr4() | (1u << 21)); set_ac(1); run("ac", 1, 0x400000);
+ reset(); middle[2] &= ~2ull; table[0] = 0; run("precedence", 1, 0x400000);
+ reset(); run_user("userdenied", 0);
+ reset(); table[0] |= 4; run_user("userread", 0);
+ reset(); table[0] |= 4; run_user("userwrite", 1);
+ reset(); table[0] |= 4; run_user("userfetch", 2);
+ reset(); table[0] |= 4; middle[2] &= ~2ull; set_cr0(cr0() & ~(1u << 16)); run_user("userwp", 1);
+ reset(); table[0] |= (1ull << 63) | 4; run_user("usernx", 2);
+ reset(); root_bits = 0xabc; run("rootbits", 0, 0x400000);
+ reset(); set_cr4(cr4() | (1u << 17)); root_bits = 0xabc; run("pcid", 0, 0x400000);
+ text("done\n");
+ __asm__ volatile("outl %0, $0xf4" : : "a"(0x10));
+ for (;;) __asm__ volatile("hlt");
+}
A => guest/layout.ld +13 -0
@@ 1,13 @@
+ENTRY(boot)
+SECTIONS {
+ .boot 0x7c00 : AT(0) { *(.boot) }
+ .text 0x10000 : AT(512) { *(.text*) }
+ .rodata : AT(LOADADDR(.text) + SIZEOF(.text)) { *(.rodata*) }
+ .data : AT(LOADADDR(.rodata) + SIZEOF(.rodata)) { *(.data*) }
+ .bss (NOLOAD) : ALIGN(4096) {
+ __bss_start = .;
+ *(.bss*) *(COMMON)
+ __bss_end = .;
+ }
+ /DISCARD/ : { *(.eh_frame*) *(.note*) *(.comment*) }
+}
A => guest/verify.py +66 -0
@@ 1,66 @@
+import json
+from pathlib import Path
+import subprocess
+import sys
+import tempfile
+
+
+scope = Path(sys.argv[1]).resolve()
+disk = Path(sys.argv[2]).resolve()
+with tempfile.TemporaryDirectory(prefix="scopeguest") as directory:
+ root = Path(directory)
+ transcript = root / "transcript"
+ command = [
+ "qemu-system-x86_64", "-machine", "pc,accel=tcg", "-cpu", "max",
+ "-m", "32M", "-display", "none", "-serial", "none", "-monitor", "none",
+ "-no-reboot", "-drive", f"format=raw,file={disk}",
+ "-debugcon", f"file:{transcript}", "-device", "isa-debug-exit,iobase=0xf4,iosize=0x04",
+ ]
+ try:
+ result = subprocess.run(command, capture_output=True, text=True, timeout=45)
+ except subprocess.TimeoutExpired:
+ print(transcript.read_text()[-2000:] if transcript.exists() else "no guest output", file=sys.stderr)
+ raise
+ assert result.returncode == 33, (result.returncode, result.stderr, transcript.read_text()[-2000:])
+ lines = transcript.read_text().splitlines()
+ assert lines[-1] == "done", "guest did not finish"
+ current = None
+ checks = 0
+ discrepancies = 0
+ for line in lines:
+ if line.startswith("begin "):
+ _, name, access, address, privilege = line.split()
+ current = []
+ elif line.startswith("context ") or line.startswith("page "):
+ assert current is not None
+ current.append(line)
+ elif line.startswith("observed "):
+ _, vector, error = line.split()
+ observed = int(vector), int(error)
+ elif line == "end":
+ assert current is not None
+ source = root / "source"
+ capture = root / "capture"
+ source.write_text("\n".join(current) + "\n")
+ subprocess.run([str(scope), "import", str(source), str(capture), "--source", f"qemu guest case {name}"],
+ check=True, capture_output=True, text=True)
+ result = subprocess.run([str(scope), "explain", str(capture), address, "--access",
+ ["read", "write", "execute"][int(access)], "--privilege", privilege, "--json"],
+ capture_output=True, text=True, timeout=10)
+ assert result.returncode in (0, 1), (name, result.stderr)
+ prediction = json.loads(result.stdout)["result"]
+ if prediction["status"] == "mapped":
+ predicted = 0, 0
+ else:
+ predicted = prediction["fault"]["vector"], prediction["fault"]["error_code"]
+ if observed != predicted:
+ known = name in {"reserved", "nxe", "alignment", "pml"} and observed == (14, predicted[1] & ~1) and predicted == (14, 9)
+ assert known, (name, "observed", observed, "predicted", predicted, prediction)
+ discrepancies += 1
+ print(f"{name}: known tcg discrepancy, observed=0x{observed[1]:x} architectural=0x{predicted[1]:x}")
+ else:
+ print(f"{name}: vector={observed[0]} error=0x{observed[1]:x}")
+ checks += 1
+ current = None
+ assert checks == 31, checks
+ print(f"{checks - discrepancies} exact guest comparisons, {discrepancies} reserved-bit tcg discrepancies")
A => lib/address.ml +33 -0
@@ 1,33 @@
+module Virtual = struct
+ type t = int64
+ let of_int64 x = x
+ let to_int64 x = x
+end
+
+module Physical = struct
+ type t = int64
+ let of_int64 x = x
+ let to_int64 x = x
+end
+
+module Machine = struct
+ type t = int64
+ let of_int64 x = x
+ let to_int64 x = x
+end
+
+let compare = Int64.unsigned_compare
+let hex x = Printf.sprintf "0x%016Lx" x
+
+let parse s =
+ if String.length s = 0 || s.[0] = '-' || s.[0] = '+' then
+ invalid_arg ("invalid unsigned address: " ^ s);
+ try Int64.of_string (if String.starts_with ~prefix:"0x" s then s else "0u" ^ s)
+ with Failure _ -> invalid_arg ("invalid unsigned address: " ^ s)
+
+let bit x n = Int64.logand x (Int64.shift_left 1L n) <> 0L
+let mask n = Int64.pred (Int64.shift_left 1L n)
+let align x n = Int64.logand x (Int64.lognot (mask n))
+let canonical x =
+ let high = Int64.shift_right x 47 in
+ high = 0L || high = -1L
A => lib/address.mli +25 -0
@@ 1,25 @@
+module Virtual : sig
+ type t
+ val of_int64 : int64 -> t
+ val to_int64 : t -> int64
+end
+
+module Physical : sig
+ type t
+ val of_int64 : int64 -> t
+ val to_int64 : t -> int64
+end
+
+module Machine : sig
+ type t
+ val of_int64 : int64 -> t
+ val to_int64 : t -> int64
+end
+
+val compare : int64 -> int64 -> int
+val hex : int64 -> string
+val parse : string -> int64
+val bit : int64 -> int -> bool
+val mask : int -> int64
+val align : int64 -> int -> int64
+val canonical : int64 -> bool
A => lib/analysis.ml +105 -0
@@ 1,105 @@
+open Model
+open Paging
+
+type change = { start : int64; length : int64; before : state option; after : state option; kinds : string list }
+
+let offset_mapping (region : region) address mapping =
+ let offset = Int64.sub address region.start in
+ { mapping with virtual_address = Address.Virtual.of_int64 address;
+ physical_address = Address.Physical.of_int64 (Int64.add (Address.Physical.to_int64 mapping.physical_address) offset) }
+
+let state_at (region : region) address = match region.state with
+ | Present mapping -> Present (offset_mapping region address mapping)
+ | state -> state
+
+let attributes mapping =
+ let huge = mapping.size <> 4096L in
+ let pat = Address.bit mapping.leaf (if huge then 12 else 7) in
+ Int64.logor (Int64.logand mapping.leaf 0x118L) (if pat then 0x80L else 0L)
+
+let history (mapping : mapping) =
+ let leaf = List.length mapping.trace - 1 in
+ List.mapi (fun index (s : step) -> Int64.logand s.raw (if index = leaf then 0x60L else 0x20L)) mapping.trace
+
+let differences ~include_ad before after =
+ match before, after with
+ | Some (Unknown _), _ | _, Some (Unknown _) -> ["incomplete"]
+ | Some (Broken a), Some (Broken b) when a = b -> []
+ | Some (Broken _), _ | _, Some (Broken _) -> ["invalid"]
+ | None, None -> []
+ | None, Some _ -> ["added"]
+ | Some _, None -> ["removed"]
+ | Some (Present a), Some (Present b) ->
+ List.filter_map (fun (changed, kind) -> if changed then Some kind else None) [
+ (a.physical_address <> b.physical_address, "backing");
+ (a.permissions <> b.permissions, "permissions");
+ (a.size <> b.size, "page_size");
+ (attributes a <> attributes b, "attributes");
+ (include_ad && history a <> history b, "accessed_dirty") ]
+
+let diff ?(include_ad = false) before after =
+ let boundaries regions = List.fold_left (fun acc (region : region) ->
+ let finish = Int64.add region.start region.length in
+ region.start :: if finish = 0L then acc else finish :: acc) [] regions
+ in
+ let points = List.sort_uniq Address.compare (boundaries before @ boundaries after) in
+ let before = ref before and after = ref after in
+ let lookup regions address =
+ let rec advance () = match !regions with
+ | region :: rest when Address.compare (last region) address < 0 -> regions := rest; advance ()
+ | _ -> ()
+ in
+ advance ();
+ match !regions with
+ | region :: _ when Address.compare region.start address <= 0 -> Some (state_at region address)
+ | _ -> None
+ in
+ let rec go acc = function
+ | [] -> List.rev acc
+ | start :: rest ->
+ let finish = match rest with next :: _ -> Int64.pred next | [] -> -1L in
+ let a = lookup before start and b = lookup after start in
+ let kinds = differences ~include_ad a b in
+ let acc = if kinds = [] then acc else {
+ start; length = Int64.succ (Int64.sub finish start); before = a; after = b; kinds } :: acc in
+ go acc rest
+ in
+ go [] points
+
+type alias = { physical : int64; length : int64; writable : mapping; executable : mapping }
+
+let aliases ?(max_pairs = 100_000) regions =
+ let module Active = Map.Make (Int) in
+ let mappings = List.filter_map (fun r -> match r.state with Present m -> Some m | _ -> None) regions in
+ let physical m = Address.Physical.to_int64 m.physical_address in
+ let finish m = Int64.add (physical m) m.size in
+ let events = List.mapi (fun id mapping ->
+ [physical mapping, 1, id, mapping; finish mapping, 0, id, mapping]) mappings |> List.concat
+ |> List.sort (fun (a, ak, ai, _) (b, bk, bi, _) ->
+ let compared = Address.compare a b in
+ if compared <> 0 then compared else let compared = Int.compare ak bk in
+ if compared <> 0 then compared else Int.compare ai bi)
+ in
+ let writable = ref Active.empty and executable = ref Active.empty in
+ let acc = ref [] and count = ref 0 in
+ let emit writable executable =
+ incr count;
+ if !count > max_pairs then raise (Limit "alias pair budget exceeded");
+ let start = if physical writable > physical executable then physical writable else physical executable in
+ let stop = min (finish writable) (finish executable) in
+ acc := { physical = start; length = Int64.sub stop start; writable; executable } :: !acc
+ in
+ List.iter (fun (_, kind, id, mapping) ->
+ if kind = 0 then begin
+ writable := Active.remove id !writable;
+ executable := Active.remove id !executable
+ end else begin
+ (* end -> start at equal addresses keeps adjacent frames out of the overlap set *)
+ if mapping.permissions.writable then
+ Active.iter (fun _ other -> emit mapping other) !executable;
+ if mapping.permissions.executable then
+ Active.iter (fun _ other -> emit other mapping) !writable;
+ if mapping.permissions.writable then writable := Active.add id mapping !writable;
+ if mapping.permissions.executable then executable := Active.add id mapping !executable
+ end) events;
+ List.rev !acc
A => lib/capture.ml +242 -0
@@ 1,242 @@
+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 buffer = Bytes.create 16384 in
+ let line () =
+ let rec read length =
+ match input_char channel with
+ | '\n' -> Bytes.sub_string buffer 0 length
+ | c ->
+ if length = Bytes.length buffer then invalid_arg "import line exceeds 16384 bytes";
+ Bytes.set buffer length c;
+ read (length + 1)
+ | exception End_of_file ->
+ if length = 0 then raise End_of_file;
+ Bytes.sub_string buffer 0 length
+ in
+ read 0
+ in
+ let context = ref None and frames = ref [] and count = ref 0 in
+ let number = ref 0 in
+ (try while true do
+ let line = line () in
+ incr number;
+ 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)
A => lib/capture.mli +11 -0
@@ 1,11 @@
+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
A => lib/demo.ml +29 -0
@@ 1,29 @@
+open Model
+
+let context = {
+ registers = { cr0 = 0x80010001L; cr2 = 0L; cr3 = 0x1000L; cr4 = 0x20L;
+ efer = 0xd00L; rflags = 2L; rip = 0L };
+ features = { phys_bits = 48; nx = true; gb_pages = true };
+ root_override = None;
+ source = "synthetic fixture"; consistency = "immutable synthetic tables";
+ identity = "scope-demo"; domid = 0; vcpu = 0;
+}
+
+let page entries =
+ let bytes = Bytes.make 4096 '\000' in
+ List.iter (fun (index, entry) -> Bytes.set_int64_le bytes (index * 8) entry) entries;
+ Bytes.to_string bytes
+
+let frames ~after = [
+ 0x1000L, page [0, 0x2007L];
+ 0x2000L, page [0, 0x3007L];
+ 0x3000L, page [2, (if after then 0x4003L else 0x4001L); 4, 0x5003L];
+ 0x4000L, page [0, 0x9003L];
+ 0x5000L, page [0, Int64.logor 0x8000000000000000L (if after then 0xa003L else 0x9003L)] ]
+
+let capture ~after = Capture.make context (List.map (fun (address, bytes) -> Address.Physical.of_int64 address, Ok bytes) (frames ~after))
+
+let write directory =
+ if not (Sys.file_exists directory) then Unix.mkdir directory 0o755;
+ Capture.save (Filename.concat directory "before") (capture ~after:false);
+ Capture.save (Filename.concat directory "after") (capture ~after:true)
A => lib/dune +9 -0
@@ 1,9 @@
+(library
+ (name scope)
+ (public_name scope)
+ (libraries unix)
+ (foreign_stubs
+ (language c)
+ (names native)
+ (flags (:standard -std=gnu11 -Wall -Wextra -Werror)))
+ (c_library_flags -ldl))
A => lib/json.ml +36 -0
@@ 1,36 @@
+type t = Null | Bool of bool | Int of int | String of string | List of t list | Object of (string * t) list
+
+let string s = String s
+let hex x = String (Address.hex x)
+let option f = function None -> Null | Some x -> f x
+
+let rec output channel = function
+ | Null -> output_string channel "null"
+ | Bool b -> output_string channel (string_of_bool b)
+ | Int n -> output_string channel (string_of_int n)
+ | String s ->
+ output_char channel '"';
+ String.iter (function
+ | '"' -> output_string channel "\\\""
+ | '\\' -> output_string channel "\\\\"
+ | '\n' -> output_string channel "\\n"
+ | '\r' -> output_string channel "\\r"
+ | '\t' -> output_string channel "\\t"
+ | c when Char.code c < 32 || Char.code c > 126 ->
+ Printf.fprintf channel "\\u%04x" (Char.code c)
+ | c -> output_char channel c) s;
+ output_char channel '"'
+ | List values ->
+ output_char channel '[';
+ List.iteri (fun i value -> if i > 0 then output_char channel ','; output channel value) values;
+ output_char channel ']'
+ | Object fields ->
+ output_char channel '{';
+ List.iteri (fun i (key, value) ->
+ if i > 0 then output_char channel ',';
+ output channel (String key);
+ output_char channel ':';
+ output channel value) fields;
+ output_char channel '}'
+
+let print value = output stdout value; output_char stdout '\n'
A => lib/model.ml +101 -0
@@ 1,101 @@
+type features = { phys_bits : int; nx : bool; gb_pages : bool }
+
+type registers = {
+ cr0 : int64;
+ cr2 : int64;
+ cr3 : int64;
+ cr4 : int64;
+ efer : int64;
+ rflags : int64;
+ rip : int64;
+}
+
+type context = {
+ registers : registers;
+ root_override : int64 option;
+ features : features;
+ source : string;
+ consistency : string;
+ identity : string;
+ domid : int;
+ vcpu : int;
+}
+
+type permissions = { writable : bool; user : bool; executable : bool }
+type access = Read | Write | Execute
+type privilege = Supervisor | User
+type request = { access : access; privilege : privilege; ac : bool }
+
+type step = {
+ level : int;
+ table : Address.Physical.t;
+ index : int;
+ raw : int64;
+ effective : permissions;
+}
+
+type mapping = {
+ virtual_address : Address.Virtual.t;
+ physical_address : Address.Physical.t;
+ size : int64;
+ permissions : permissions;
+ leaf : int64;
+ trace : step list;
+}
+
+type fault = {
+ vector : int;
+ error_code : int;
+ reason : string;
+ level : int option;
+}
+
+type outcome = Mapped of mapping | Fault of fault | Incomplete of string
+type result = { trace : step list; outcome : outcome }
+type reader = Address.Physical.t -> (string, string) Stdlib.result
+
+exception Limit of string
+
+let unrestricted = { writable = true; user = true; executable = true }
+
+let narrow permissions raw = {
+ writable = permissions.writable && Address.bit raw 1;
+ user = permissions.user && Address.bit raw 2;
+ executable = permissions.executable && not (Address.bit raw 63);
+}
+
+let validate context =
+ let r = context.registers and f = context.features in
+ let require predicate reason = if not predicate then invalid_arg reason in
+ require (Sys.word_size = 64) "scope requires a 64-bit runtime";
+ require (f.phys_bits >= 32 && f.phys_bits <= 52) "physical width must be between 32 and 52";
+ require (Address.bit r.cr0 0 && Address.bit r.cr0 31) "protected paging must be enabled";
+ require (Address.bit r.cr4 5 && Address.bit r.efer 10) "only ia-32e paging is supported";
+ require (not (Address.bit r.cr4 12)) "five-level paging is unsupported";
+ require (not (Address.bit r.cr4 22 || Address.bit r.cr4 24)) "protection keys are unsupported";
+ require (not (Address.bit r.cr4 23)) "cet is unsupported";
+ require (not (Address.bit r.cr4 27)) "linear address space separation is unsupported";
+ require (not (Address.bit r.cr4 28)) "supervisor linear address masking is unsupported";
+ require (not (Address.bit r.efer 11) || f.nx) "nxe requires the guest nx feature";
+ let validate_root root =
+ require (Int64.logand root (Int64.lognot (Address.mask f.phys_bits)) = 0L)
+ "cr3 exceeds the physical width or uses unsupported address masking"
+ in
+ validate_root r.cr3;
+ Option.iter validate_root context.root_override;
+ require (context.domid >= 0 && context.vcpu >= 0) "negative domain or vcpu"
+
+let root context = Address.Physical.of_int64
+ (Address.align (Option.value context.root_override ~default:context.registers.cr3) 12)
+let access_name = function Read -> "read" | Write -> "write" | Execute -> "execute"
+let privilege_name = function Supervisor -> "supervisor" | User -> "user"
+
+let context_changes before after =
+ let a = before.registers and b = after.registers in
+ List.filter_map (fun (changed, field) -> if changed then Some field else None) [
+ (a.cr0 <> b.cr0, "cr0"); (a.cr3 <> b.cr3, "cr3"); (a.cr4 <> b.cr4, "cr4");
+ (root before <> root after, "root");
+ (a.efer <> b.efer, "efer"); (Address.bit a.rflags 18 <> Address.bit b.rflags 18, "ac");
+ (before.features.phys_bits <> after.features.phys_bits, "phys_bits");
+ (before.features.nx <> after.features.nx, "nx");
+ (before.features.gb_pages <> after.features.gb_pages, "gb_pages") ]
A => lib/native.c +273 -0
@@ 1,273 @@
+#define _GNU_SOURCE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <string.h>
+#include <stdio.h>
+
+#if defined(__has_include)
+#if __has_include(<xenctrl.h>) && __has_include(<xenforeignmemory.h>)
+#define SCOPE_XEN 1
+#endif
+#endif
+
+#ifdef SCOPE_XEN
+#include <dlfcn.h>
+#include <errno.h>
+#include <sys/mman.h>
+#include <xenctrl.h>
+#include <xenforeignmemory.h>
+#include <xentoollog.h>
+#include <xen/hvm/save.h>
+
+static void quiet_message(xentoollog_logger *logger, xentoollog_level level,
+ int error, const char *context, const char *format, va_list arguments) {
+ (void)logger; (void)level; (void)error; (void)context; (void)format; (void)arguments;
+}
+
+static void quiet_destroy(xentoollog_logger *logger) {
+ (void)logger;
+}
+
+static xentoollog_logger quiet_logger = {
+ .vmessage = quiet_message,
+ .progress = NULL,
+ .destroy = quiet_destroy
+};
+
+struct api {
+ void *control;
+ void *foreign;
+ __typeof__(&xc_interface_open) control_open;
+ __typeof__(&xc_interface_close) control_close;
+ __typeof__(&xc_domain_getinfolist) info;
+ __typeof__(&xc_domain_pause) pause;
+ __typeof__(&xc_domain_unpause) unpause;
+ __typeof__(&xc_domain_hvm_getcontext_partial) context;
+ __typeof__(&xenforeignmemory_open) foreign_open;
+ __typeof__(&xenforeignmemory_close) foreign_close;
+ __typeof__(&xenforeignmemory_map) map;
+ __typeof__(&xenforeignmemory_unmap) unmap;
+};
+
+static struct api api;
+
+static bool load_api(void) {
+ if (api.control && api.foreign) return true;
+ api.control = dlopen("libxenctrl.so", RTLD_NOW | RTLD_LOCAL);
+ api.foreign = dlopen("libxenforeignmemory.so", RTLD_NOW | RTLD_LOCAL);
+ if (!api.control || !api.foreign) goto failed;
+#define LOAD(member, library, symbol) \
+ do { *(void **)(&api.member) = dlsym(api.library, symbol); if (!api.member) goto failed; } while (0)
+ LOAD(control_open, control, "xc_interface_open");
+ LOAD(control_close, control, "xc_interface_close");
+ LOAD(info, control, "xc_domain_getinfolist");
+ LOAD(pause, control, "xc_domain_pause");
+ LOAD(unpause, control, "xc_domain_unpause");
+ LOAD(context, control, "xc_domain_hvm_getcontext_partial");
+ LOAD(foreign_open, foreign, "xenforeignmemory_open");
+ LOAD(foreign_close, foreign, "xenforeignmemory_close");
+ LOAD(map, foreign, "xenforeignmemory_map");
+ LOAD(unmap, foreign, "xenforeignmemory_unmap");
+#undef LOAD
+ return true;
+failed:
+ if (api.control) dlclose(api.control);
+ if (api.foreign) dlclose(api.foreign);
+ memset(&api, 0, sizeof(api));
+ return false;
+}
+
+struct session {
+ xc_interface *control;
+ xenforeignmemory_handle *foreign;
+ uint32_t domid;
+ uint16_t vcpu;
+ bool owned_pause;
+ void *mapping;
+ xen_domain_handle_t identity;
+};
+
+static bool inspect(struct session *s, xc_domaininfo_t *info) {
+ return api.info(s->control, s->domid, 1, info) == 1 && info->domain == s->domid &&
+ memcmp(info->handle, s->identity, sizeof(s->identity)) == 0;
+}
+
+static int release(struct session *s) {
+ int failed = 0;
+ if (s->mapping) {
+ if (api.unmap(s->foreign, s->mapping, 1) != 0) failed = 1;
+ s->mapping = NULL;
+ }
+ if (s->owned_pause) {
+ xc_domaininfo_t info;
+ if (!inspect(s, &info) || api.unpause(s->control, s->domid) != 0) failed = 1;
+ s->owned_pause = false;
+ }
+ if (s->foreign && api.foreign_close(s->foreign) != 0) failed = 1;
+ if (s->control && api.control_close(s->control) != 0) failed = 1;
+ s->foreign = NULL;
+ s->control = NULL;
+ return failed;
+}
+
+static void finalise(value block) {
+ struct session *s = Data_custom_val(block);
+ if (release(s)) fprintf(stderr, "scope: xen cleanup failed; inspect domain pause state\n");
+}
+
+static struct custom_operations operations = {
+ .identifier = "scope.xen.session.v1",
+ .finalize = finalise,
+ .compare = custom_compare_default,
+ .hash = custom_hash_default,
+ .serialize = custom_serialize_default,
+ .deserialize = custom_deserialize_default,
+ .compare_ext = custom_compare_ext_default,
+ .fixed_length = custom_fixed_length_default
+};
+
+static void check(struct session *s) {
+ xc_domaininfo_t info;
+ if (!s->control) caml_failwith("xen session is closed");
+ if (!inspect(s, &info)) caml_failwith("domain identity changed or domain disappeared");
+ if (!(info.flags & XEN_DOMINF_paused)) caml_failwith("domain is no longer paused");
+}
+
+CAMLprim value scope_xen_available(value unit) {
+ CAMLparam1(unit);
+ CAMLreturn(Val_bool(load_api()));
+}
+
+CAMLprim value scope_xen_open(value domain, value vcpu, value pause) {
+ CAMLparam3(domain, vcpu, pause);
+ CAMLlocal1(block);
+ if (!load_api()) caml_failwith("cannot load xen control and foreign memory libraries");
+ block = caml_alloc_custom(&operations, sizeof(struct session), 0, 1);
+ struct session *s = Data_custom_val(block);
+ memset(s, 0, sizeof(*s));
+ s->domid = Int_val(domain);
+ s->vcpu = Int_val(vcpu);
+ s->control = api.control_open(&quiet_logger, &quiet_logger, 0);
+ if (!s->control) caml_failwith("cannot open xen control interface");
+ xc_domaininfo_t info;
+ if (api.info(s->control, s->domid, 1, &info) != 1 || info.domain != s->domid ||
+ !(info.flags & XEN_DOMINF_hvm_guest) || s->vcpu > info.max_vcpu_id) {
+ release(s);
+ caml_failwith("domain absent, not hvm, or vcpu outside domain range");
+ }
+ memcpy(s->identity, info.handle, sizeof(s->identity));
+ if (Bool_val(pause)) {
+ if (api.pause(s->control, s->domid) != 0) {
+ release(s);
+ caml_failwith("cannot acquire xen controller pause");
+ }
+ /* pause -> capture -> unpause, release only the reference acquired here */
+ s->owned_pause = true;
+ } else if (!(info.flags & XEN_DOMINF_paused)) {
+ release(s);
+ caml_failwith("domain must already be paused or capture must use --pause");
+ }
+ s->foreign = api.foreign_open(&quiet_logger, 0);
+ if (!s->foreign) {
+ if (release(s)) caml_failwith("foreign memory open and pause cleanup failed; inspect domain");
+ caml_failwith("cannot open xen foreign memory interface");
+ }
+ CAMLreturn(block);
+}
+
+CAMLprim value scope_xen_registers(value block) {
+ CAMLparam1(block);
+ CAMLlocal4(array, number, identity, pair);
+ struct session *s = Data_custom_val(block);
+ check(s);
+ struct hvm_hw_cpu cpu;
+ if (api.context(s->control, s->domid, HVM_SAVE_CODE(CPU), s->vcpu, &cpu, sizeof(cpu)) != 0)
+ caml_failwith("cannot read hvm vcpu context");
+ uint64_t values[] = {cpu.cr0, cpu.cr2, cpu.cr3, cpu.cr4, cpu.msr_efer, cpu.rflags, cpu.rip};
+ char encoded[sizeof(s->identity) * 2 + 1];
+ for (size_t i = 0; i < sizeof(s->identity); i++) snprintf(encoded + i * 2, 3, "%02x", s->identity[i]);
+ array = caml_alloc(7, 0);
+ for (int i = 0; i < 7; i++) Store_field(array, i, Val_unit);
+ for (int i = 0; i < 7; i++) {
+ number = caml_copy_int64(values[i]);
+ Store_field(array, i, number);
+ }
+ identity = caml_copy_string(encoded);
+ pair = caml_alloc_tuple(2);
+ Store_field(pair, 0, array);
+ Store_field(pair, 1, identity);
+ CAMLreturn(pair);
+}
+
+CAMLprim value scope_xen_read(value block, value physical) {
+ CAMLparam2(block, physical);
+ CAMLlocal1(bytes);
+ struct session *s = Data_custom_val(block);
+ check(s);
+ if (s->mapping) caml_failwith("previous foreign unmap failed");
+ uint64_t address = Int64_val(physical);
+ if (address & 4095) caml_invalid_argument("unaligned guest physical frame");
+ xen_pfn_t frame = address >> 12;
+ int error = 0;
+ void *mapping = api.map(s->foreign, s->domid, PROT_READ, 1, &frame, &error);
+ if (mapping && mapping != MAP_FAILED) s->mapping = mapping;
+ if (!mapping || mapping == MAP_FAILED || error) {
+ int saved_error = error ? error : errno;
+ if (s->mapping && api.unmap(s->foreign, mapping, 1) == 0) s->mapping = NULL;
+ char reason[160];
+ snprintf(reason, sizeof(reason), "foreign map failed at 0x%016llx: errno=%d",
+ (unsigned long long)address, saved_error);
+ caml_failwith(reason);
+ }
+ char copy[4096];
+ memcpy(copy, mapping, sizeof(copy));
+ if (api.unmap(s->foreign, mapping, 1) != 0) caml_failwith("foreign unmap failed");
+ s->mapping = NULL;
+ bytes = caml_alloc_initialized_string(sizeof(copy), copy);
+ CAMLreturn(bytes);
+}
+
+CAMLprim value scope_xen_close(value block) {
+ CAMLparam1(block);
+ if (release(Data_custom_val(block))) caml_failwith("xen cleanup failed; inspect domain pause state");
+ CAMLreturn(Val_unit);
+}
+
+#else
+CAMLprim value scope_xen_available(value unit) {
+ (void)unit;
+ return Val_false;
+}
+
+static void unavailable(void) {
+ caml_failwith("xen capture unavailable; install xen development headers and rebuild scope");
+}
+
+CAMLprim value scope_xen_open(value domain, value vcpu, value pause) {
+ (void)domain; (void)vcpu; (void)pause;
+ unavailable();
+ return Val_unit;
+}
+
+CAMLprim value scope_xen_registers(value block) {
+ (void)block;
+ unavailable();
+ return Val_unit;
+}
+
+CAMLprim value scope_xen_read(value block, value address) {
+ (void)block; (void)address;
+ unavailable();
+ return Val_unit;
+}
+
+CAMLprim value scope_xen_close(value block) {
+ (void)block;
+ return Val_unit;
+}
+#endif
A => lib/paging.ml +140 -0
@@ 1,140 @@
+open Model
+
+type entry = Absent | Invalid of string | Table of Address.Physical.t | Leaf of int * Address.Physical.t
+
+let shift level = 12 + (9 * (level - 1))
+let span level = Int64.shift_left 1L (shift level)
+
+let decode features ~nxe ~level raw =
+ let open Address in
+ if not (bit raw 0) then Absent
+ else if bit raw 63 && not nxe then Invalid "nx bit with nxe disabled"
+ else if Int64.logand raw (Int64.logand (mask 52) (Int64.lognot (mask features.phys_bits))) <> 0L then
+ Invalid "physical address uses reserved high bits"
+ else if level = 4 && bit raw 7 then Invalid "page size bit in pml4 entry"
+ else if level = 3 && bit raw 7 && not features.gb_pages then Invalid "1 gib pages are not exposed to the guest"
+ else
+ let address = Int64.logand raw (Int64.logand (mask features.phys_bits) (Int64.lognot 0xfffL)) in
+ if level = 1 then Leaf (12, Physical.of_int64 address)
+ else if bit raw 7 then
+ let bits = shift level in
+ (* huge leaf: [ frame | reserved | pat | flags ], bit 12 stays out of the frame *)
+ if Int64.logand raw (Int64.logand (mask bits) (Int64.lognot 0x1fffL)) <> 0L then
+ Invalid "misaligned huge page uses reserved address bits"
+ else Leaf (bits, Physical.of_int64 (align address bits))
+ else Table (Physical.of_int64 address)
+
+let error_code context request ~present ~reserved =
+ (if present then 1 else 0)
+ lor (if request.access = Write then 2 else 0)
+ lor (if request.privilege = User then 4 else 0)
+ lor (if reserved then 8 else 0)
+ lor (if request.access = Execute &&
+ (Address.bit context.registers.efer 11 || Address.bit context.registers.cr4 20) then 16 else 0)
+
+let walk context read address =
+ validate context;
+ let virtual_raw = Address.Virtual.to_int64 address in
+ if not (Address.canonical virtual_raw) then
+ { trace = []; outcome = Fault { vector = 13; error_code = 0; reason = "noncanonical linear address"; level = None } }
+ else
+ let rec go level table permissions trace =
+ match read table with
+ | Error reason -> { trace = List.rev trace; outcome = Incomplete reason }
+ | Ok page when String.length page <> 4096 ->
+ { trace = List.rev trace; outcome = Incomplete "table read is not 4096 bytes" }
+ | Ok page ->
+ let index = Int64.(to_int (logand (shift_right_logical virtual_raw (shift level)) 511L)) in
+ let raw = String.get_int64_le page (index * 8) in
+ let effective = narrow permissions raw in
+ let step = { level; table; index; raw; effective } in
+ let trace = step :: trace in
+ match decode context.features ~nxe:(Address.bit context.registers.efer 11) ~level raw with
+ | Absent -> { trace = List.rev trace; outcome = Fault {
+ vector = 14; error_code = 0; reason = "entry not present"; level = Some level } }
+ | Invalid reason -> { trace = List.rev trace; outcome = Fault {
+ vector = 14; error_code = 9; reason; level = Some level } }
+ | Table next -> go (level - 1) next effective trace
+ | Leaf (bits, base) ->
+ let trace = List.rev trace in
+ let physical_address = Address.Physical.of_int64
+ Int64.(add (Address.Physical.to_int64 base) (logand virtual_raw (Address.mask bits))) in
+ { trace; outcome = Mapped { virtual_address = address; physical_address;
+ size = Int64.shift_left 1L bits; permissions = effective; leaf = raw; trace } }
+ in
+ go 4 (root context) unrestricted []
+
+let explain context read address request =
+ let result = walk context read address in
+ let fault reason level =
+ { result with outcome = Fault { vector = 14;
+ error_code = error_code context request ~present:true ~reserved:false;
+ reason; level } }
+ in
+ match result.outcome with
+ | Incomplete _ -> result
+ | Fault f when f.vector = 13 -> result
+ | Fault f -> { result with outcome = Fault { f with error_code =
+ error_code context request ~present:(f.error_code land 1 <> 0)
+ ~reserved:(f.error_code land 8 <> 0) } }
+ | Mapped mapping ->
+ let p = mapping.permissions and r = context.registers in
+ let first predicate =
+ List.find_opt predicate result.trace |> Option.map (fun (step : step) -> step.level)
+ in
+ if request.privilege = User && not p.user then
+ fault "supervisor mapping denies user access" (first (fun s -> not (Address.bit s.raw 2)))
+ else if request.access = Write && not p.writable &&
+ (request.privilege = User || Address.bit r.cr0 16) then
+ fault "read-only entry denies write" (first (fun s -> not (Address.bit s.raw 1)))
+ else if request.access = Execute && not p.executable then
+ fault "nx entry denies instruction fetch" (first (fun s -> Address.bit s.raw 63))
+ else if request.privilege = Supervisor && p.user && request.access = Execute && Address.bit r.cr4 20 then
+ fault "smep denies supervisor fetch from user mapping" None
+ else if request.privilege = Supervisor && p.user && request.access <> Execute &&
+ Address.bit r.cr4 21 && not request.ac then
+ fault "smap denies explicit supervisor data access with ac clear" None
+ else result
+
+type state = Present of mapping | Unknown of string | Broken of string
+type region = { start : int64; length : int64; state : state }
+
+let last region = Int64.pred (Int64.add region.start region.length)
+
+let enumerate ?(max_entries = 2_000_000) context read =
+ validate context;
+ let count = ref 0 and acc = ref [] in
+ let emit start length state = acc := { start; length; state } :: !acc in
+ let canonicalise x =
+ if Address.bit x 47 then Int64.logor x 0xffff000000000000L else x
+ in
+ let rec go level table prefix permissions trace =
+ match read table with
+ | Error reason ->
+ if level = 4 then begin
+ emit 0L 0x800000000000L (Unknown reason);
+ emit 0xffff800000000000L 0x800000000000L (Unknown reason)
+ end else emit (canonicalise prefix) (Int64.mul 512L (span level)) (Unknown reason)
+ | Ok page ->
+ if String.length page <> 4096 then invalid_arg "table read is not 4096 bytes";
+ for index = 0 to 511 do
+ incr count;
+ if !count > max_entries then raise (Limit "page-table traversal budget exceeded");
+ let raw = String.get_int64_le page (index * 8) in
+ let prefix = Int64.logor prefix (Int64.shift_left (Int64.of_int index) (shift level)) in
+ let start = canonicalise prefix in
+ let effective = narrow permissions raw in
+ let trace = { level; table; index; raw; effective } :: trace in
+ match decode context.features ~nxe:(Address.bit context.registers.efer 11) ~level raw with
+ | Absent -> ()
+ | Invalid reason -> emit start (span level) (Broken reason)
+ | Table next -> go (level - 1) next prefix effective trace
+ | Leaf (bits, physical_address) ->
+ let trace = List.rev trace in
+ let mapping = { virtual_address = Address.Virtual.of_int64 start; physical_address;
+ size = Int64.shift_left 1L bits; permissions = effective; leaf = raw; trace } in
+ emit start mapping.size (Present mapping)
+ done
+ in
+ go 4 (root context) 0L unrestricted [];
+ List.rev !acc
A => lib/report.ml +85 -0
@@ 1,85 @@
+open Model
+open Json
+
+let limitations = [
+ "guest first-stage table state only; tlb and second-stage permissions are not observed";
+ "ordinary explicit accesses only; implicit supervisor accesses and cross-page operations are not modelled";
+ "pausing vcpus does not quiesce dma, device models, or other memory writers";
+ "permissions describe architectural access, not speculative execution" ]
+
+let permissions p = Object ["writable", Bool p.writable; "user", Bool p.user; "executable", Bool p.executable]
+
+let context c =
+ let r = c.registers and f = c.features in
+ Object ["source", String c.source; "consistency", String c.consistency; "identity", String c.identity;
+ "domid", Int c.domid; "vcpu", Int c.vcpu;
+ "root", hex (Address.Physical.to_int64 (Model.root c)); "root_override", option hex c.root_override;
+ "features", Object ["phys_bits", Int f.phys_bits; "nx", Bool f.nx; "gb_pages", Bool f.gb_pages];
+ "registers", Object ["cr0", hex r.cr0; "cr2", hex r.cr2; "cr3", hex r.cr3; "cr4", hex r.cr4;
+ "efer", hex r.efer; "rflags", hex r.rflags; "rip", hex r.rip]]
+
+let step (s : step) = Object ["level", Int s.level; "table", hex (Address.Physical.to_int64 s.table);
+ "index", Int s.index; "entry_address", hex Int64.(add (Address.Physical.to_int64 s.table) (of_int (s.index * 8)));
+ "raw", hex s.raw; "effective", permissions s.effective]
+
+let mapping (m : mapping) = Object [
+ "virtual", hex (Address.Virtual.to_int64 m.virtual_address);
+ "physical", hex (Address.Physical.to_int64 m.physical_address);
+ "page_size", hex m.size; "permissions", permissions m.permissions; "leaf", hex m.leaf;
+ "trace", List (List.map step m.trace)]
+
+let fault f = Object ["vector", Int f.vector; "error_code", Int f.error_code;
+ "reason", String f.reason; "level", option (fun n -> Int n) f.level]
+
+let outcome = function
+ | Mapped m -> Object ["status", String "mapped"; "mapping", mapping m]
+ | Fault f -> Object ["status", String "fault"; "fault", fault f]
+ | Incomplete reason -> Object ["status", String "incomplete"; "reason", String reason]
+
+let state = function
+ | Paging.Present m -> Object ["status", String "mapped"; "mapping", mapping m]
+ | Paging.Unknown reason -> Object ["status", String "incomplete"; "reason", String reason]
+ | Paging.Broken reason -> Object ["status", String "invalid"; "reason", String reason]
+
+let region (r : Paging.region) = Object ["start", hex r.start; "length", hex r.length; "state", state r.state]
+
+let change (c : Analysis.change) = Object ["start", hex c.start; "length", hex c.length;
+ "kinds", List (List.map string c.kinds); "before", option state c.before; "after", option state c.after]
+
+let alias (a : Analysis.alias) = Object ["physical", hex a.physical; "length", hex a.length;
+ "writable", mapping a.writable; "executable", mapping a.executable]
+
+let envelope command c complete fields = Object (
+ ["schema", String "scope.report.v1"; "command", String command; "context", context c;
+ "complete", Bool complete; "limitations", List (List.map string limitations)] @ fields)
+
+let rights p = Printf.sprintf "r%c%c/%c" (if p.writable then 'w' else '-')
+ (if p.executable then 'x' else '-') (if p.user then 'u' else 's')
+
+let print_context c =
+ Printf.printf "source=%S identity=%S domid=%d vcpu=%d cr3=%s root=%s phys_bits=%d nx=%b gb_pages=%b\n"
+ c.source c.identity c.domid c.vcpu (Address.hex c.registers.cr3)
+ (Address.hex (Address.Physical.to_int64 (Model.root c))) c.features.phys_bits c.features.nx c.features.gb_pages;
+ Printf.printf "consistency=%S\n" c.consistency;
+ Printf.printf "scope=guest-table-state tlb=unobserved second-stage=unobserved\n"
+
+let print_step (s : step) =
+ Printf.printf "l%d table=%s index=%03x raw=%s effective=%s\n" s.level
+ (Address.hex (Address.Physical.to_int64 s.table)) s.index (Address.hex s.raw) (rights s.effective)
+
+let print_mapping m = Printf.printf "%s -> %s size=%s %s\n"
+ (Address.hex (Address.Virtual.to_int64 m.virtual_address))
+ (Address.hex (Address.Physical.to_int64 m.physical_address)) (Address.hex m.size) (rights m.permissions)
+
+let print_result result =
+ List.iter print_step result.trace;
+ match result.outcome with
+ | Mapped m -> print_mapping m
+ | Fault f -> Printf.printf "fault vector=%d error=0x%x level=%s reason=%s\n" f.vector f.error_code
+ (match f.level with None -> "-" | Some n -> string_of_int n) f.reason
+ | Incomplete reason -> Printf.printf "incomplete reason=%s\n" reason
+
+let print_region (r : Paging.region) = match r.state with
+ | Paging.Present m -> print_mapping m
+ | Paging.Unknown reason -> Printf.printf "%s length=%s incomplete=%s\n" (Address.hex r.start) (Address.hex r.length) reason
+ | Paging.Broken reason -> Printf.printf "%s length=%s invalid=%s\n" (Address.hex r.start) (Address.hex r.length) reason
A => lib/watch.ml +94 -0
@@ 1,94 @@
+open Model
+
+type event = {
+ sample : int;
+ time : float;
+ kind : string;
+ before : Capture.t option;
+ after : Capture.t;
+ changes : Analysis.change list;
+ context_changes : string list;
+ aliases : Analysis.alias list;
+ complete : bool;
+ directory : string;
+ mappings : int;
+ bytes : int64;
+ executable : int;
+ writable : int;
+ huge : int;
+}
+
+let run ~capture ~wait ~emit ~directory ~interval ~count ~retain ~max_entries ~max_pairs
+ ~include_ad ~scan_aliases ~selected () =
+ if count < 0 || retain < 1 || not (Float.is_finite interval) || interval <= 0. then
+ invalid_arg "invalid watch sampling or retention settings";
+ if Sys.file_exists directory then invalid_arg "watch output directory must not already exist";
+ Unix.mkdir directory 0o700;
+ let retained = Queue.create () in
+ let previous = ref None and identity = ref None in
+ let findings = ref false and incomplete = ref false in
+ let statistics = ref (0, 0L, 0, 0, 0) in
+ let notify sample kind before after changes context_changes aliases complete path =
+ let mappings, bytes, executable, writable, huge = !statistics in
+ emit { sample; time = Unix.gettimeofday (); kind; before; after; changes; context_changes;
+ aliases; complete; directory = path; mappings; bytes; executable; writable; huge }
+ in
+ let publish sample kind before after changes context_changes aliases complete =
+ let path = Filename.concat directory (Printf.sprintf "%08d" sample) in
+ Unix.mkdir path 0o700;
+ Option.iter (Capture.save (Filename.concat path "before")) before;
+ Capture.save (Filename.concat path "after") after;
+ Queue.add path retained;
+ while Queue.length retained > retain do
+ let oldest = Queue.take retained in
+ List.iter (fun name -> let file = Filename.concat oldest name in
+ if Sys.file_exists file then Unix.unlink file) ["before"; "after"];
+ Unix.rmdir oldest
+ done;
+ notify sample kind before after changes context_changes aliases complete path
+ in
+ let rec loop sample =
+ let after = capture () in
+ let context = Capture.context after in
+ (match !identity with
+ | None -> identity := Some context.identity
+ | Some expected when expected <> context.identity -> failwith "domain identity changed between watch samples"
+ | _ -> ());
+ let regions = Paging.enumerate ~max_entries context (Capture.read after) |> List.filter selected in
+ statistics := List.fold_left (fun (n, bytes, x, w, huge) region -> match region.Paging.state with
+ | Paging.Present m -> n + 1, Int64.add bytes m.size,
+ x + (if m.permissions.executable then 1 else 0), w + (if m.permissions.writable then 1 else 0),
+ huge + (if m.size > 4096L then 1 else 0)
+ | _ -> n, bytes, x, w, huge) (0, 0L, 0, 0, 0) regions;
+ let complete = List.for_all (fun r -> match r.Paging.state with Paging.Unknown _ -> false | _ -> true) regions in
+ let aliases = if scan_aliases then Analysis.aliases ~max_pairs regions else [] in
+ if aliases <> [] || List.exists (fun r -> match r.Paging.state with Paging.Broken _ -> true | _ -> false) regions then
+ findings := true;
+ if not complete then begin
+ incomplete := true;
+ publish sample "incomplete" !previous after [] [] aliases false
+ end else begin
+ (match !previous with
+ | None -> publish sample "baseline" None after [] [] aliases true
+ | Some before ->
+ let earlier = Capture.context before in
+ let context_changes = Model.context_changes earlier context in
+ if Model.root earlier <> Model.root context then
+ publish sample "address_space" (Some before) after [] context_changes aliases true
+ else begin
+ let before_regions = Paging.enumerate ~max_entries earlier (Capture.read before) in
+ let changes = Analysis.diff ~include_ad before_regions regions |> List.filter (fun (c : Analysis.change) ->
+ selected { Paging.start = c.start; length = c.length; state = Paging.Unknown "" }) in
+ if changes <> [] || context_changes <> [] then begin
+ findings := true;
+ publish sample "change" (Some before) after changes context_changes aliases true
+ end else notify sample "sample" (Some before) after [] [] aliases true ""
+ end);
+ previous := Some after
+ end;
+ if count = 0 || sample < count then begin wait interval; loop (sample + 1) end
+ in
+ (try loop 1 with exn ->
+ if Array.length (Sys.readdir directory) = 0 then Unix.rmdir directory;
+ raise exn);
+ if !incomplete then 2 else if !findings then 1 else 0
A => lib/xen.ml +37 -0
@@ 1,37 @@
+type session
+
+external available : unit -> bool = "scope_xen_available"
+external open_domain : int -> int -> bool -> session = "scope_xen_open"
+external registers : session -> int64 array * string = "scope_xen_registers"
+external read_page : session -> int64 -> string = "scope_xen_read"
+external close : session -> unit = "scope_xen_close"
+
+let capture ~domid ~vcpu ~pause ~features ~root:override_root ~max_pages =
+ if domid < 1 || domid >= 0x7ff0 then invalid_arg "capture requires an ordinary nonzero domain id";
+ if vcpu < 0 || vcpu > 65535 then invalid_arg "vcpu outside xen context range";
+ let signals = [Sys.sigint; Sys.sigterm] in
+ let original_mask = Unix.sigprocmask Unix.SIG_BLOCK signals in
+ let session = try open_domain domid vcpu pause with exn ->
+ ignore (Unix.sigprocmask Unix.SIG_SETMASK original_mask);
+ raise exn
+ in
+ let release () =
+ let mask = Unix.sigprocmask Unix.SIG_BLOCK signals in
+ Fun.protect ~finally:(fun () -> ignore (Unix.sigprocmask Unix.SIG_SETMASK mask)) (fun () -> close session)
+ in
+ Fun.protect ~finally:release (fun () ->
+ ignore (Unix.sigprocmask Unix.SIG_SETMASK original_mask);
+ let values, identity = registers session in
+ let open Model in
+ let registers = { cr0 = values.(0); cr2 = values.(1);
+ cr3 = values.(2);
+ cr4 = values.(3); efer = values.(4); rflags = values.(5); rip = values.(6) } in
+ let context = { registers; features; domid; vcpu; identity; root_override = override_root;
+ source = "xen hvm; operator-supplied guest cpuid profile";
+ consistency = (if pause then "controller pause held during table capture; external writers not quiesced"
+ else "observed paused on reads; no owned pause; external writers not quiesced") } in
+ let reader address =
+ try Ok (read_page session (Address.Physical.to_int64 address))
+ with Failure reason -> Error reason
+ in
+ Capture.collect ~max_pages context reader)
A => lib/xen.mli +3 -0
@@ 1,3 @@
+val available : unit -> bool
+val capture : domid:int -> vcpu:int -> pause:bool -> features:Model.features ->
+ root:int64 option -> max_pages:int -> Capture.t
A => meow.mp4 +0 -0
A => scope.opam +23 -0
@@ 1,23 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "0.1.0"
+synopsis: "Inspect and replay Xen guest page tables"
+depends: [
+ "ocaml" {>= "4.14"}
+ "dune" {>= "3.10"}
+ "odoc" {with-doc}
+]
+build: [
+ ["dune" "subst"] {dev}
+ [
+ "dune"
+ "build"
+ "-p"
+ name
+ "-j"
+ jobs
+ "@install"
+ "@runtest" {with-test}
+ "@doc" {with-doc}
+ ]
+]
A => test/check.ml +302 -0
@@ 1,302 @@
+open Scope
+open Model
+
+let count = ref 0
+let check condition message = incr count; if not condition then failwith message
+let virtual_address = Address.Virtual.of_int64
+let physical_address = Address.Physical.of_int64
+let supervisor access = { access; privilege = Supervisor; ac = false }
+let user access = { access; privilege = User; ac = false }
+
+let capture ?(context = Demo.context) pages =
+ Capture.make context (List.map (fun (address, page) -> physical_address address, Ok page) pages)
+
+let tables ?(upper = 7L) ?(middle = 7L) ?(parent = 7L) ?(leaf = 7L) () = [
+ 0x1000L, Demo.page [0, Int64.logor 0x2000L upper];
+ 0x2000L, Demo.page [0, Int64.logor 0x3000L middle];
+ 0x3000L, Demo.page [0, Int64.logor 0x4000L parent];
+ 0x4000L, Demo.page [0, Int64.logor 0x9000L leaf] ]
+
+let explain capture ?(address = 0L) request =
+ Paging.explain (Capture.context capture) (Capture.read capture) (virtual_address address) request
+
+let expect_fault ?level vector code result = match result.outcome with
+ | Fault f ->
+ check (f.vector = vector) "fault vector";
+ check (f.error_code = code) (Printf.sprintf "error code: expected %x got %x (%s)" code f.error_code f.reason);
+ Option.iter (fun level -> check (f.level = Some level) "fault level") level
+ | _ -> failwith "expected fault"
+
+let expect_mapped result = match result.outcome with
+ | Mapped m -> check true "mapped"; m
+ | Fault f -> failwith ("unexpected fault: " ^ f.reason)
+ | Incomplete reason -> failwith ("unexpected incomplete: " ^ reason)
+
+let rejects action =
+ check (try action (); false with Invalid_argument _ | Model.Limit _ -> true) "expected rejection"
+
+let permissions () =
+ for upper = 0 to 7 do
+ for middle = 0 to 7 do
+ for parent = 0 to 7 do
+ for leaf = 0 to 7 do
+ let flags x = Int64.of_int (1 lor ((x land 1) lsl 1) lor ((x land 2) lsl 1))
+ |> fun bits -> if x land 4 <> 0 then Int64.logor bits Int64.min_int else bits in
+ let capture = capture (tables ~upper:(flags upper) ~middle:(flags middle)
+ ~parent:(flags parent) ~leaf:(flags leaf) ()) in
+ let mapping = expect_mapped (Paging.walk (Capture.context capture) (Capture.read capture) (virtual_address 0L)) in
+ check (mapping.permissions.writable = (upper land middle land parent land leaf land 1 <> 0)) "write accumulation";
+ check (mapping.permissions.user = (upper land middle land parent land leaf land 2 <> 0)) "user accumulation";
+ check (mapping.permissions.executable = ((upper lor middle lor parent lor leaf) land 4 = 0)) "nx accumulation"
+ done
+ done
+ done
+ done;
+ let c = capture (tables ~parent:5L ()) in
+ expect_fault ~level:2 14 3 (explain c (supervisor Write));
+ expect_fault ~level:2 14 7 (explain c (user Write));
+ let context = { Demo.context with registers = { Demo.context.registers with cr0 = 0x80000001L } } in
+ ignore (expect_mapped (explain (capture ~context (tables ~parent:5L ())) (supervisor Write)));
+ expect_fault 14 5 (explain (capture (tables ~upper:3L ())) (user Read));
+ expect_fault 14 17 (explain (capture (tables ~parent:0x8000000000000007L ())) (supervisor Execute));
+ let context = { Demo.context with registers = { Demo.context.registers with cr4 = 0x100020L } } in
+ expect_fault 14 17 (explain (capture ~context (tables ())) (supervisor Execute));
+ let context = { Demo.context with registers = { Demo.context.registers with cr4 = 0x200020L } } in
+ let c = capture ~context (tables ()) in
+ expect_fault 14 1 (explain c (supervisor Read));
+ expect_fault 14 3 (explain c (supervisor Write));
+ ignore (expect_mapped (explain c { access = Write; privilege = Supervisor; ac = true }));
+ ignore (expect_mapped (explain c (supervisor Execute)))
+
+let translation () =
+ let c = capture (tables ()) in
+ let m = expect_mapped (explain c ~address:0xabcL (supervisor Read)) in
+ check (Address.Physical.to_int64 m.physical_address = 0x9abcL) "4k offset";
+ expect_fault 13 0 (explain c ~address:0x0000800000000000L (supervisor Read));
+ expect_fault 13 0 (explain c ~address:0xffff7fffffffffffL (supervisor Read));
+ let c = capture [0x1000L, Demo.page [511, 0x2007L]; 0x2000L, Demo.page [511, 0x3007L];
+ 0x3000L, Demo.page [511, 0x4007L]; 0x4000L, Demo.page [511, 0x9007L]] in
+ let m = expect_mapped (explain c ~address:(-1L) (supervisor Read)) in
+ check (Address.Physical.to_int64 m.physical_address = 0x9fffL) "upper canonical address";
+ let regions = Paging.enumerate (Capture.context c) (Capture.read c) in
+ check (List.length regions = 1 && (List.hd regions).start = 0xfffffffffffff000L) "upper enumeration";
+ let c = capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x3007L];
+ 0x3000L, Demo.page [0, 0x201087L]] in
+ let m = expect_mapped (explain c ~address:0x1fffffL (supervisor Read)) in
+ check (m.size = 0x200000L && Address.Physical.to_int64 m.physical_address = 0x3fffffL) "2m pat and offset";
+ let c = capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x40001087L]] in
+ let m = expect_mapped (explain c ~address:0x3fffffffL (supervisor Read)) in
+ check (m.size = 0x40000000L && Address.Physical.to_int64 m.physical_address = 0x7fffffffL) "1g pat and offset";
+ let c = capture (tables ~leaf:0x87L ()) in
+ ignore (expect_mapped (explain c (supervisor Read)));
+ let context = { Demo.context with registers = { Demo.context.registers with cr3 = 0x1abcL; cr4 = 0x20020L } } in
+ ignore (expect_mapped (explain (capture ~context (tables ())) (supervisor Read)))
+
+let invalid () =
+ expect_fault ~level:4 14 9 (explain (capture (tables ~upper:0x87L ())) (supervisor Read));
+ expect_fault ~level:1 14 9 (explain (capture (tables ~leaf:0x1000000000007L ())) (supervisor Read));
+ let context = { Demo.context with registers = { Demo.context.registers with efer = 0x500L } } in
+ expect_fault 14 9 (explain (capture ~context (tables ~leaf:0x8000000000000007L ())) (supervisor Read));
+ let context = { Demo.context with features = { Demo.context.features with gb_pages = false } } in
+ let c = capture ~context [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x87L]] in
+ expect_fault 14 9 (explain c (supervisor Read));
+ let c = capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x3007L]; 0x3000L, Demo.page [0, 0x2087L]] in
+ expect_fault 14 9 (explain c (supervisor Read));
+ let c = capture (tables ~parent:0L ()) in
+ expect_fault ~level:2 14 0 (explain c (supervisor Read));
+ let c = capture (tables ~parent:0L ~upper:1L ()) in
+ expect_fault ~level:2 14 6 (explain c (user Write));
+ List.iter (fun bit -> rejects (fun () ->
+ Model.validate { Demo.context with registers = { Demo.context.registers with cr4 = Int64.logor 0x20L (Int64.shift_left 1L bit) } })) [12; 22; 23; 24];
+ let context = { Demo.context with registers = { Demo.context.registers with cr3 = 0x1abcL } } in
+ ignore (expect_mapped (explain (capture ~context (tables ())) (supervisor Read)));
+ rejects (fun () -> ignore (Address.parse "-1"));
+ rejects (fun () -> ignore (Address.parse "18446744073709551616"));
+ check (Address.parse "18446744073709551615" = -1L) "unsigned decimal parsing"
+
+let incomplete () =
+ let c = capture [0x1000L, Demo.page [0, 0x2007L]] in
+ check (match (explain c (supervisor Read)).outcome with Incomplete _ -> true | _ -> false) "missing table is incomplete";
+ let regions = Paging.enumerate (Capture.context c) (Capture.read c) in
+ check (List.length regions = 1 && (List.hd regions).length = 0x8000000000L) "missing subtree range";
+ let c = Capture.make Demo.context [] in
+ let regions = Paging.enumerate Demo.context (Capture.read c) in
+ check (List.length regions = 2) "missing root covers both canonical halves";
+ let c = Demo.capture ~after:false in
+ rejects (fun () -> ignore (Paging.enumerate ~max_entries:1 Demo.context (Capture.read c)));
+ rejects (fun () -> ignore (Capture.collect ~max_pages:1 Demo.context (Capture.read c)));
+ let reads = ref 0 in
+ let collected = Capture.collect Demo.context (fun address -> incr reads; Capture.read c address) in
+ check (!reads = 5 && Capture.pages collected = 5) "capture memoises table frames"
+
+let regions capture = Paging.enumerate (Capture.context capture) (Capture.read capture)
+
+let diff () =
+ let a = Demo.capture ~after:false and b = Demo.capture ~after:true in
+ let changes = Analysis.diff (regions a) (regions b) in
+ check (List.length changes = 2) "demo diff count";
+ check ((List.hd changes).kinds = ["permissions"]) "parent permission diff";
+ check ((List.nth changes 1).kinds = ["backing"]) "backing diff";
+ check (Analysis.diff (regions a) (regions a) = []) "identity diff";
+ let a = capture (tables ()) in
+ let b = capture (tables ~leaf:0x67L ()) in
+ check (Analysis.diff (regions a) (regions b) = []) "ignore ad by default";
+ check ((List.hd (Analysis.diff ~include_ad:true (regions a) (regions b))).kinds = ["accessed_dirty"]) "include ad";
+ let huge = capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x3007L]; 0x3000L, Demo.page [0, 0x87L]] in
+ let small = capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x3007L];
+ 0x3000L, Demo.page [0, 0x4007L]; 0x4000L, Demo.page (List.init 512 (fun index -> index, Int64.logor 7L (Int64.of_int (index * 4096))))] in
+ let changes = Analysis.diff (regions huge) (regions small) in
+ check (List.length changes = 512 && List.for_all (fun (c : Analysis.change) -> c.kinds = ["page_size"]) changes) "huge split preserves backing";
+ let partial = Capture.make Demo.context [] in
+ let changes = Analysis.diff (regions partial) (regions a) in
+ check (List.for_all (fun (c : Analysis.change) -> c.kinds = ["incomplete"]) changes) "incomplete is not removal"
+
+let aliases () =
+ let pairs = Analysis.aliases (regions (Demo.capture ~after:false)) in
+ check (List.length pairs = 1) "demo alias";
+ let pair = List.hd pairs in
+ check (pair.physical = 0x9000L && pair.length = 4096L) "alias overlap";
+ check (Analysis.aliases (regions (Demo.capture ~after:true)) = []) "demo resolved alias";
+ let make_mapping va pa size permissions = {
+ virtual_address = virtual_address va; physical_address = physical_address pa;
+ size; permissions; leaf = 0L; trace = [] } in
+ let writable = { unrestricted with executable = false } in
+ let executable = { unrestricted with writable = false } in
+ let a = make_mapping 0L 0x200000L 0x200000L executable in
+ let b = make_mapping 0x800000L 0x201000L 4096L writable in
+ let pairs = Analysis.aliases [
+ { Paging.start = 0L; length = a.size; state = Paging.Present a };
+ { Paging.start = 0x800000L; length = b.size; state = Paging.Present b } ] in
+ check (List.length pairs = 1 && (List.hd pairs).physical = 0x201000L && (List.hd pairs).length = 4096L) "partial huge alias"
+
+let codec () =
+ let path = Filename.temp_file "scope" ".capture" in
+ Fun.protect ~finally:(fun () -> Sys.remove path) (fun () ->
+ let original = Demo.capture ~after:false in
+ Capture.save path original;
+ let loaded = Capture.load path in
+ check (Capture.context original = Capture.context loaded) "context roundtrip";
+ check (regions original = regions loaded) "table roundtrip";
+ let channel = open_out_gen [Open_wronly; Open_binary] 0o600 path in
+ seek_out channel 32;
+ output_char channel '\255';
+ close_out channel;
+ rejects (fun () -> ignore (Capture.load path)));
+ rejects (fun () -> ignore (Capture.make Demo.context [physical_address 0x1000L, Ok "short"]));
+ rejects (fun () -> ignore (Capture.make Demo.context [physical_address 0x1001L, Ok (Demo.page [])]));
+ rejects (fun () -> ignore (capture [0x1000L, Demo.page []; 0x1000L, Demo.page []]))
+
+let generated () =
+ let random = Random.State.make [|0x5c0; 0x2026|] in
+ let generate () =
+ let entries = List.init 64 (fun index ->
+ let frame = Random.State.int random 16 in
+ let flags = Int64.of_int (1 lor (Random.State.int random 4 lsl 1)) in
+ let flags = if Random.State.bool random then Int64.logor flags Int64.min_int else flags in
+ index, if Random.State.int random 4 = 0 then 0L else Int64.logor (Int64.of_int (frame * 4096)) flags) in
+ capture [0x1000L, Demo.page [0, 0x2007L]; 0x2000L, Demo.page [0, 0x3007L];
+ 0x3000L, Demo.page [0, 0x4007L]; 0x4000L, Demo.page entries]
+ in
+ for _ = 1 to 64 do
+ let a = generate () and b = generate () in
+ let changes = Analysis.diff (regions a) (regions b) in
+ for index = 0 to 63 do
+ let address = Int64.of_int (index * 4096) in
+ let state capture = match (explain capture ~address (supervisor Read)).outcome with
+ | Mapped m -> Some (Paging.Present m)
+ | Fault _ -> None
+ | Incomplete _ -> failwith "generated graph unexpectedly incomplete"
+ in
+ let expected = Analysis.differences ~include_ad:false (state a) (state b) in
+ let observed = List.find_opt (fun (c : Analysis.change) ->
+ Address.compare address c.start >= 0 && Address.compare address (Int64.pred (Int64.add c.start c.length)) <= 0) changes
+ |> Option.map (fun (c : Analysis.change) -> c.kinds) |> Option.value ~default:[] in
+ check (expected = observed) "interval diff agrees with point translations"
+ done;
+ let mappings = regions a |> List.filter_map (fun r -> match r.Paging.state with Paging.Present m -> Some m | _ -> None) in
+ let physical m = Address.Physical.to_int64 m.physical_address in
+ let virtual_raw m = Address.Virtual.to_int64 m.virtual_address in
+ let expected = List.concat_map (fun w -> List.filter_map (fun x ->
+ if w.permissions.writable && x.permissions.executable && virtual_raw w <> virtual_raw x && physical w = physical x then
+ Some (physical w, 4096L, virtual_raw w, virtual_raw x) else None) mappings) mappings |> List.sort compare in
+ let actual = Analysis.aliases (regions a) |> List.map (fun (a : Analysis.alias) ->
+ a.physical, a.length, virtual_raw a.writable, virtual_raw a.executable) |> List.sort compare in
+ check (expected = actual) "alias sweep agrees with pairwise overlap oracle"
+ done;
+ let self = capture [0x1000L, Demo.page [0, 0x1007L]] in
+ let reads = ref 0 in
+ let closed = Capture.collect Demo.context (fun address -> incr reads; Capture.read self address) in
+ check (!reads = 1 && Capture.pages closed = 1) "recursive mapping is read once across levels";
+ ignore (expect_mapped (explain closed (supervisor Read)));
+ let context = { Demo.context with registers = { Demo.context.registers with cr3 = 0x1000L } } in
+ let exploding = capture ~context [0x1000L, Demo.page (List.init 512 (fun index -> index, 0x1007L))] in
+ rejects (fun () -> ignore (Paging.enumerate ~max_entries:4096 context (Capture.read exploding)))
+
+let imports () =
+ let path = Filename.temp_file "scopeimport" "" in
+ Fun.protect ~finally:(fun () -> Sys.remove path) (fun () ->
+ let context = "context 0x80010001 0 0x1000 0x20 0xd00 2 0 48 1 1" in
+ let write text =
+ let channel = open_out_bin path in
+ Fun.protect ~finally:(fun () -> close_out_noerr channel) (fun () -> output_string channel text)
+ in
+ List.iter (fun ending ->
+ write (context ^ ending);
+ let imported = Capture.import ~source:"test" path in
+ check (Capture.pages imported = 0) "import accepts context at eof") [""; "\n"];
+ List.iter (fun ending ->
+ write (context ^ "\n" ^ String.make 16384 ' ' ^ ending);
+ check (Capture.pages (Capture.import ~source:"test" path) = 0)
+ "import accepts maximum line length") [""; "\n"];
+ List.iter (fun ending ->
+ write (context ^ "\n" ^ String.make 16385 ' ' ^ ending);
+ rejects (fun () -> ignore (Capture.import ~source:"test" path))) [""; "\n"];
+ write (context ^ "\n" ^ String.make (2 * 1024 * 1024) 'x');
+ let allocated = Gc.allocated_bytes () in
+ let rejected = try ignore (Capture.import ~source:"test" path); false with
+ Invalid_argument reason -> reason = "import line exceeds 16384 bytes"
+ in
+ let allocated = Gc.allocated_bytes () -. allocated in
+ check rejected "import rejects oversized record before parsing";
+ check (allocated < 1048576.) "import rejects oversized line with bounded allocation")
+
+let watch () =
+ let base = Filename.temp_file "scopewatch" "" in
+ Sys.remove base;
+ let a = Demo.capture ~after:false and b = Demo.capture ~after:true in
+ let switched = capture ~context:{ Demo.context with registers = { Demo.context.registers with cr3 = 0x6000L } }
+ ((0x6000L, Demo.page [0, 0x2007L]) :: Demo.frames ~after:true) in
+ let samples = ref [a; b; b; Capture.make Demo.context []; b; switched] in
+ let events = ref [] in
+ let capture () = match !samples with x :: xs -> samples := xs; x | [] -> failwith "sample exhaustion" in
+ let status = Watch.run ~capture ~wait:(fun _ -> ()) ~emit:(fun event -> events := event :: !events)
+ ~directory:base ~interval:0.1 ~count:6 ~retain:2 ~max_entries:10000 ~max_pairs:100
+ ~include_ad:false ~scan_aliases:true ~selected:(fun _ -> true) () in
+ check (status = 2) "watch remembers incomplete samples";
+ let events = List.rev !events in
+ check (List.map (fun (e : Watch.event) -> e.kind) events =
+ ["baseline"; "change"; "sample"; "incomplete"; "sample"; "address_space"]) "watch transitions";
+ check (List.length (List.nth events 1).changes = 2) "watch semantic changes";
+ check ((List.hd events).mappings = 2 && (List.hd events).bytes = 8192L) "watch statistics";
+ check (List.length (List.hd events).aliases = 1) "watch alias baseline";
+ check (Array.length (Sys.readdir base) = 2) "watch bounded retention";
+ let pair = Filename.concat base "00000006" in
+ check (Capture.context (Capture.load (Filename.concat pair "before")) = Capture.context b) "watch preserves last complete baseline";
+ check ((List.nth events 5).changes = []) "watch does not diff unrelated roots";
+ Array.iter (fun name -> let path = Filename.concat base name in
+ Array.iter (fun child -> Sys.remove (Filename.concat path child)) (Sys.readdir path);
+ Unix.rmdir path) (Sys.readdir base);
+ Unix.rmdir base
+
+let () =
+ permissions ();
+ translation ();
+ invalid ();
+ incomplete ();
+ diff ();
+ aliases ();
+ codec ();
+ generated ();
+ imports ();
+ watch ();
+ Printf.printf "%d checks passed\n" !count
A => test/cli.py +75 -0
@@ 1,75 @@
+import json
+from pathlib import Path
+import subprocess
+import sys
+import tempfile
+
+
+executable = str(Path(sys.argv[1]).resolve())
+checks = 0
+
+
+def run(*args, status=0, structured=True):
+ global checks
+ command = [executable, *map(str, args)]
+ if structured:
+ command.append("--json")
+ result = subprocess.run(command, capture_output=True, text=True, timeout=10)
+ assert result.returncode == status, (command, result.returncode, result.stdout, result.stderr)
+ checks += 1
+ if structured:
+ value = json.loads(result.stdout if result.stdout else result.stderr)
+ assert value["schema"] == "scope.report.v1"
+ return value
+ return result.stdout
+
+
+with tempfile.TemporaryDirectory(prefix="scope") as directory:
+ root = Path(directory)
+ run("demo", root)
+ before, after = root / "before", root / "after"
+ assert run("info", before)["pages"] == 5
+ result = run("walk", before, "0x400abc")
+ assert result["result"]["mapping"]["physical"] == "0x0000000000009abc"
+ result = run("explain", before, "0x400000", "--access", "write", "--privilege", "supervisor", status=1)
+ assert result["result"]["fault"]["level"] == 2
+ assert result["result"]["fault"]["error_code"] == 3
+ assert len(run("aliases", before, status=1)["aliases"]) == 1
+ assert run("aliases", after)["aliases"] == []
+ assert len(run("diff", before, after, status=1)["changes"]) == 2
+ assert run("diff", before, before)["changes"] == []
+ assert len(run("mappings", before, "--start", "0x800000")["regions"]) == 1
+ assert run("walk", before, "0x800000000000", status=1)["result"]["fault"]["vector"] == 13
+ overridden = run("walk", before, "0x400000", "--root", "0x6000", status=2)
+ assert overridden["complete"] is False
+ assert overridden["context"]["registers"]["cr3"] == "0x0000000000001000"
+ assert overridden["context"]["root"] == "0x0000000000006000"
+ run("explain", before, "0x400000", status=64)
+ run("walk", before, "0x400000", "--include-ad", status=64)
+ run("walk", before, "0x400000", "--root", "0x1000", "--root", "0x2000", status=64)
+ run("mappings", before, "--max-entries", "1", status=2)
+ run("capture", "0", root / "capture", "--vcpu", "0", "--phys-bits", "48", "--nx", "on", "--gb-pages", "on", status=2)
+ run("walk", before, "-1", status=64)
+ run("unknown", status=64)
+ run("watch", "7", root / "history", "--interval", "nan", status=64)
+ run("watch", "7", root / "history", "--retain", "0", status=64)
+ run("walk", before, "0x400000", "--count", "2", status=64)
+ run("info", root / "missing", status=2)
+ text = run("explain", before, "0x400000", "--access", "write", "--privilege", "supervisor", status=1, structured=False)
+ assert "level=2" in text and "error=0x3" in text
+ damaged = root / "damaged"
+ damaged.write_bytes(before.read_bytes()[:-1])
+ run("info", damaged, status=2)
+ transcript = root / "transcript"
+ transcript.write_text("context 0x80010001 0x0 0x1000 0x20 0xd00 0x2 0x0 48 1 1\nmissing 0x1000 permission denied\n")
+ run("import", transcript, root / "partial", "--source", 'quote" and newline\n', status=2)
+ assert run("walk", root / "partial", "0x0", status=2)["result"]["reason"] == "permission denied"
+ partial = run("diff", before, root / "partial", status=2)
+ assert all(change["kinds"] == ["incomplete"] for change in partial["changes"])
+ page = (0x83).to_bytes(8, "little") + bytes(4088)
+ transcript.write_text("context 0x80010001 0x0 0x1000 0x20 0xd00 0x2 0x0 48 1 1\npage 0x1000 " + page.hex() + "\n")
+ run("import", transcript, root / "invalid")
+ assert run("mappings", root / "invalid", status=1)["regions"][0]["state"]["status"] == "invalid"
+ assert run("aliases", root / "invalid", status=1)["aliases"] == []
+
+print(f"{checks} cli checks passed")
A => test/dune +8 -0
@@ 1,8 @@
+(test
+ (name check)
+ (libraries scope unix))
+
+(rule
+ (alias runtest)
+ (deps cli.py)
+ (action (run python3 %{dep:cli.py} %{exe:../bin/main.exe})))
A => test/native.c +138 -0
@@ 1,138 @@
+#include <xenctrl.h>
+#include <xenforeignmemory.h>
+#include <xentoollog.h>
+#include <xen/hvm/save.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <signal.h>
+
+static int references;
+static int calls;
+static int samples;
+
+static int failing(const char *name) {
+ const char *failure = getenv("SCOPE_TEST_FAILURE");
+ return failure && strcmp(failure, name) == 0;
+}
+
+static void record(const char *name) {
+ const char *path = getenv("SCOPE_TEST_LOG");
+ if (!path) abort();
+ FILE *stream = fopen(path, "a");
+ if (!stream) abort();
+ fprintf(stream, "%s %d\n", name, references);
+ if (fclose(stream)) abort();
+}
+
+static void diagnostic(xentoollog_logger *logger, const char *format, ...) {
+ va_list arguments;
+ va_start(arguments, format);
+ if (logger) logger->vmessage(logger, XTL_ERROR, EACCES, "mock", format, arguments);
+ else vfprintf(stderr, format, arguments);
+ va_end(arguments);
+}
+
+xc_interface *xc_interface_open(xentoollog_logger *logger, xentoollog_logger *builder, unsigned flags) {
+ (void)logger; (void)builder; (void)flags;
+ references = getenv("SCOPE_TEST_PAUSED") ? 1 : 0;
+ calls = 0;
+ samples++;
+ record("open");
+ if (failing("logged")) { diagnostic(logger, "mock diagnostic\n"); return NULL; }
+ return failing("open") ? NULL : (xc_interface *)1;
+}
+
+int xc_interface_close(xc_interface *control) {
+ (void)control;
+ record("close");
+ return 0;
+}
+
+int xc_domain_getinfolist(xc_interface *control, uint32_t domain, unsigned count, xc_domaininfo_t *info) {
+ (void)control; (void)count;
+ calls++;
+ if (failing("info")) return -1;
+ memset(info, 0, sizeof(*info));
+ info->domain = domain;
+ info->max_vcpu_id = 3;
+ info->flags = XEN_DOMINF_hvm_guest | (references ? XEN_DOMINF_paused : 0);
+ if (failing("identity") && calls > 2) info->handle[0] = 1;
+ return 1;
+}
+
+int xc_domain_pause(xc_interface *control, uint32_t domain) {
+ (void)control; (void)domain;
+ if (failing("pause")) return -1;
+ references++;
+ record("pause");
+ if (failing("opensignal")) raise(SIGTERM);
+ return 0;
+}
+
+int xc_domain_unpause(xc_interface *control, uint32_t domain) {
+ (void)control; (void)domain;
+ if (failing("unpause")) { record("unpausefailed"); return -1; }
+ references--;
+ record("unpause");
+ return references < 0 ? -1 : 0;
+}
+
+int xc_domain_hvm_getcontext_partial(xc_interface *control, uint32_t domain, uint16_t type,
+ uint16_t instance, void *buffer, uint32_t size) {
+ (void)control; (void)domain; (void)type; (void)instance;
+ record("registers");
+ if (failing("signal")) raise(SIGTERM);
+ if (failing("registers")) return -1;
+ if (size < sizeof(struct hvm_hw_cpu)) abort();
+ struct hvm_hw_cpu *cpu = buffer;
+ memset(cpu, 0, sizeof(*cpu));
+ cpu->cr0 = 0x80010001;
+ cpu->cr3 = 0x1000;
+ if (getenv("SCOPE_TEST_WATCH") && samples >= 4) cpu->cr3 = 0x6000;
+ cpu->cr4 = 0x20;
+ cpu->msr_efer = 0xd00;
+ cpu->rflags = 2;
+ return 0;
+}
+
+xenforeignmemory_handle *xenforeignmemory_open(struct xentoollog_logger *logger, unsigned flags) {
+ (void)logger; (void)flags;
+ record("foreignopen");
+ return failing("foreignopen") ? NULL : (xenforeignmemory_handle *)2;
+}
+
+int xenforeignmemory_close(xenforeignmemory_handle *memory) {
+ (void)memory;
+ record("foreignclose");
+ return 0;
+}
+
+void *xenforeignmemory_map(xenforeignmemory_handle *memory, uint32_t domain, int protection,
+ size_t count, const xen_pfn_t *frames, int *errors) {
+ (void)memory; (void)domain; (void)protection;
+ record("map");
+ if (count != 1) abort();
+ if (failing("map")) { errno = EACCES; return NULL; }
+ uint64_t *page = calloc(512, sizeof(*page));
+ if (!page) abort();
+ *errors = failing("page") ? EACCES : 0;
+ switch (frames[0]) {
+ case 1: case 6: page[0] = 0x2007; break;
+ case 2: page[0] = 0x3007; break;
+ case 3: page[2] = 0x4001; page[4] = 0x5003; break;
+ case 4: page[0] = 0x9003; break;
+ case 5: page[0] = getenv("SCOPE_TEST_WATCH") && samples >= 2 ? 0x800000000000a003ull : 0x8000000000009003ull; break;
+ default: free(page); errno = ENOENT; return NULL;
+ }
+ return page;
+}
+
+int xenforeignmemory_unmap(xenforeignmemory_handle *memory, void *address, size_t count) {
+ (void)memory; (void)count;
+ record("unmap");
+ if (failing("unmap")) return -1;
+ free(address);
+ return 0;
+}
A => test/xen.py +81 -0
@@ 1,81 @@
+import json
+import os
+from pathlib import Path
+import subprocess
+import sys
+import tempfile
+
+
+project = Path(__file__).resolve().parent.parent
+headers = Path(sys.argv[1] if len(sys.argv) > 1 else "/usr/include").resolve()
+if not (headers / "xenctrl.h").exists():
+ raise SystemExit("xen headers missing; pass their include directory")
+
+with tempfile.TemporaryDirectory(prefix="scopexen") as directory:
+ root = Path(directory)
+ environment = dict(os.environ)
+ environment["C_INCLUDE_PATH"] = str(headers)
+ build = root / "build"
+ subprocess.run(["dune", "build", "--build-dir", str(build), "bin/main.exe"], cwd=project, env=environment, check=True)
+ subprocess.run(["cc", "-std=gnu11", "-Wall", "-Wextra", "-Werror", "-shared", "-fPIC", "-I", str(headers),
+ str(project / "test/native.c"), "-o", str(root / "libxenctrl.so")], check=True)
+ (root / "libxenforeignmemory.so").symlink_to(root / "libxenctrl.so")
+ environment["LD_LIBRARY_PATH"] = str(root)
+ environment["SCOPE_TEST_LOG"] = str(root / "log")
+ environment["OCAMLRUNPARAM"] = "s=4k"
+ scope = build / "default/bin/main.exe"
+ checks = 0
+
+ def run(failure=None, paused=False, pause=True, status=0):
+ global checks
+ env = dict(environment)
+ if failure:
+ env["SCOPE_TEST_FAILURE"] = failure
+ if paused:
+ env["SCOPE_TEST_PAUSED"] = "1"
+ log = root / "log"
+ log.unlink(missing_ok=True)
+ command = [str(scope), "capture", "7", str(root / "capture"), "--vcpu", "0", "--phys-bits", "48",
+ "--nx", "on", "--gb-pages", "on", "--json"]
+ if pause:
+ command.append("--pause")
+ result = subprocess.run(command, env=env, text=True, capture_output=True, timeout=10)
+ assert result.returncode == status, (failure, result.stdout, result.stderr)
+ records = log.read_text().splitlines()
+ if failure not in ("open", "logged"):
+ assert records[-1].startswith("close ")
+ if pause and failure not in ("open", "logged", "info", "pause", "identity", "unpause"):
+ assert f"unpause {int(paused)}" in records, records
+ assert f"close {int(paused)}" == records[-1], records
+ if not pause:
+ assert not any(line.startswith("unpause ") for line in records), records
+ if failure is None:
+ assert sum(line.startswith("map ") for line in records) == sum(line.startswith("unmap ") for line in records)
+ if failure == "page":
+ assert sum(line.startswith("map ") for line in records) == sum(line.startswith("unmap ") for line in records) == 1
+ if failure == "unmap":
+ assert sum(line.startswith("unmap ") for line in records) == 2
+ checks += 1
+ return json.loads(result.stdout or result.stderr), records
+
+ run()
+ run(paused=True)
+ run(paused=True, pause=False)
+ run(pause=False, status=2)
+ for failure in ("logged", "info", "pause", "foreignopen", "registers", "map", "page", "unmap", "unpause", "identity", "signal", "opensignal"):
+ run(failure=failure, status=2)
+ environment["SCOPE_TEST_WATCH"] = "1"
+ log = root / "log"
+ log.unlink()
+ result = subprocess.run([str(scope), "watch", "7", str(root / "history"), "--vcpu", "0", "--phys-bits", "48",
+ "--nx", "on", "--gb-pages", "on", "--pause", "--interval", "0.001", "--count", "4",
+ "--retain", "2", "--aliases", "--json"], env=environment, text=True, capture_output=True, timeout=10)
+ assert result.returncode == 1, (result.stdout, result.stderr)
+ events = [json.loads(line) for line in result.stdout.splitlines()]
+ assert [event["event"] for event in events] == ["baseline", "change", "sample", "address_space"]
+ assert events[0]["summary"]["mappings"] == 2
+ assert events[1]["changes"][0]["kinds"] == ["backing"]
+ assert len(list((root / "history").iterdir())) == 2
+ records = log.read_text().splitlines()
+ assert records.count("pause 1") == records.count("unpause 0") == 4
+ print(f"{checks} xen api fault-injection checks and a four-sample watch passed; no hypervisor was used")