feat(watch): retain changed captures and reset baselines on root changes

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