Repositories / agent-snapshot.git

agent-snapshot.git

Clone (read-only): git clone http://git.guha-anderson.com/git/agent-snapshot.git

Branch

Use fileutils for mkdir, rm, cp, pwd, chmod, and touch

Co-authored-by: Cursor <cursoragent@cursor.com>
Author
Arjun Guha <a.guha@northeastern.edu>
Date
2026-05-03 04:03:17 -0400
Commit
e5835d53e28cdf8411a6ff2028b62d15efff8265
dune-project
index 70d57d2..fcbb783 100644
--- a/dune-project
+++ b/dune-project
@@ -10,4 +10,5 @@
   yojson
   camomile
   ocaml-git
-  fpath))
+  fpath
+  fileutils))
src/ocaml/agent_snapshot.ml
index 5f075e1..3492f63 100644
--- a/src/ocaml/agent_snapshot.ml
+++ b/src/ocaml/agent_snapshot.ml
@@ -138,11 +138,9 @@ let dirname (path : string) : string =
   if path = "" then "."
   else Fpath.to_string (Fpath.parent (Fpath.normalize (Fpath.v path)))
 
-let rec mkdir_p (path : string) : unit =
-  if path = "" || path = "/" || Sys.file_exists path then ()
-  else (
-    mkdir_p (dirname path);
-    try Unix.mkdir path 0o777 with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
+let mkdir_p (path : string) : unit =
+  if path = "" || path = "/" || FileUtil.test FileUtil.Exists path then ()
+  else FileUtil.mkdir ~parent:true ~mode:(`Octal 0o777) path
 
 let is_absolute (path : string) : bool = path <> "" && Fpath.is_abs (Fpath.v path)
 
@@ -153,7 +151,7 @@ let best_effort_canonical (path : string) : string =
   match realpath_opt path with
   | Some path -> normalize_path path
   | None when is_absolute path -> normalize_path path
-  | None -> concat_path (Sys.getcwd ()) path
+  | None -> concat_path (FileUtil.pwd ()) path
 
 let path_is_at_or_under (path : string) (root : string) : bool =
   path = root ||
@@ -253,7 +251,7 @@ let writable_by_current_user (meta : metadata) : bool =
 let existing_anchor (path : string) : string option =
   let rec loop path =
     if path = "" || path = "." then None
-    else if Sys.file_exists path then Some path
+    else if FileUtil.test FileUtil.Exists path then Some path
     else
       let parent = dirname path in
       if parent = path then None else loop parent
@@ -334,28 +332,12 @@ let fnv1a_file_digest (path : string) : string =
        with End_of_file -> ());
       Printf.sprintf "%016Lx" !hash)
 
-let copy_file (src : string) (dst : string) : unit =
-  let ic = open_in_bin src in
-  Fun.protect
-    ~finally:(fun () -> close_in_noerr ic)
-    (fun () ->
-      let oc = open_out_bin dst in
-      Fun.protect
-        ~finally:(fun () -> close_out_noerr oc)
-        (fun () ->
-          let bytes = Bytes.create 65536 in
-          let rec loop () =
-            let n = input ic bytes 0 (Bytes.length bytes) in
-            if n > 0 then (
-              output oc bytes 0 n;
-              loop ())
-          in
-          loop ()))
+let copy_file (src : string) (dst : string) : unit = FileUtil.cp [ src ] dst
 
 let store_blob (path : string) : string =
   let digest = fnv1a_file_digest path in
   let out = concat_path !blob_dir digest in
-  if not (Sys.file_exists out) then copy_file path out;
+  if not (FileUtil.test FileUtil.Exists out) then copy_file path out;
   digest
 
 let should_capture_content (path : string) (meta : metadata) (git : git_info) : bool =
@@ -456,7 +438,7 @@ let write_manifest (out : string) (command : string list) (exit_status : int) : 
         ("format_version", `Int 1);
         ("command", `List (List.map jstr command));
         ("exit_status", `Int exit_status);
-        ("start_cwd", jstr (Sys.getcwd ()));
+        ("start_cwd", jstr (FileUtil.pwd ()));
         ("uid", `Int tracer_uid);
         ("gid", `Int tracer_gid);
         ("git_repositories", `List repo_items);
@@ -605,7 +587,7 @@ let trace_command (command : string list) : unit =
         let state =
           match Hashtbl.find_opt processes parent with
           | Some state -> clone_proc_state state
-          | None -> { cwd = Sys.getcwd (); fds = Hashtbl.create 8; pending = None }
+          | None -> { cwd = FileUtil.pwd (); fds = Hashtbl.create 8; pending = None }
         in
         Hashtbl.replace processes child state
     | Ptrace.Process_exit pid -> Hashtbl.remove processes pid
@@ -614,7 +596,7 @@ let trace_command (command : string list) : unit =
           match Hashtbl.find_opt processes pid with
           | Some state -> state
           | None ->
-              let state = { cwd = Sys.getcwd (); fds = Hashtbl.create 8; pending = None } in
+              let state = { cwd = FileUtil.pwd (); fds = Hashtbl.create 8; pending = None } in
               refresh_proc_cwd pid state;
               Hashtbl.add processes pid state;
               state
@@ -624,16 +606,12 @@ let trace_command (command : string list) : unit =
         Option.iter (fun state -> handle_syscall_exit pid state regs) (Hashtbl.find_opt processes pid)
     | Ptrace.Exec pid | Ptrace.Exit pid | Ptrace.Signal (pid, _) ->
         if not (Hashtbl.mem processes pid) then (
-          let state = { cwd = Sys.getcwd (); fds = Hashtbl.create 8; pending = None } in
+          let state = { cwd = FileUtil.pwd (); fds = Hashtbl.create 8; pending = None } in
           refresh_proc_cwd pid state;
           Hashtbl.add processes pid state))
 
-let rec remove_all (path : string) : unit =
-  if Sys.file_exists path then
-    if Sys.is_directory path then (
-      Array.iter (fun name -> if name <> "." && name <> ".." then remove_all (concat_path path name)) (Sys.readdir path);
-      Unix.rmdir path)
-    else Unix.unlink path
+let remove_all (path : string) : unit =
+  if FileUtil.test FileUtil.Exists path then FileUtil.rm ~recurse:true ~force:FileUtil.Force [ path ]
 
 (** Restore only blobbed final states and tombstones; Git-reconstructable files remain manifest references. *)
 let restore_snapshot (dir : string) : unit =
@@ -652,24 +630,29 @@ let restore_snapshot (dir : string) : unit =
               let exists = match List.assoc_opt "exists" after with Some (`Bool b) -> b | _ -> false in
               if not exists then (
                 let tombstone = match List.assoc_opt "tombstone" after with Some (`Bool b) -> b | _ -> false in
-                if tombstone then try Unix.unlink path with Unix.Unix_error _ -> ())
+                if tombstone then
+                  try FileUtil.rm ~force:FileUtil.Force [ path ]
+                  with FileUtil.RmError _ | Unix.Unix_error (_, _, _) -> ())
               else (
                 match List.assoc_opt "blob" after with
                 | None -> ()
                 | Some (`String digest) ->
                     mkdir_p (dirname path);
                     let same =
-                      Sys.file_exists path && not (Sys.is_directory path) && fnv1a_file_digest path = digest
+                      FileUtil.test (FileUtil.And (FileUtil.Exists, FileUtil.Not FileUtil.Is_dir)) path
+                      && fnv1a_file_digest path = digest
                     in
                     if not same then (
                       let tmp = path ^ ".agent-snapshot.tmp" in
                       copy_file (concat_path (concat_path dir "blobs") digest) tmp;
                       Unix.rename tmp path);
                     (match List.assoc_opt "mode" after with
-                    | Some (`Int mode) -> Unix.chmod path (mode land 0o7777)
+                    | Some (`Int mode) ->
+                        FileUtil.chmod (`Octal (mode land 0o7777)) [ path ]
                     | _ -> ());
                     (match List.assoc_opt "mtime" after with
-                    | Some (`Int mtime) -> Unix.utimes path (float_of_int mtime) (float_of_int mtime)
+                    | Some (`Int mtime) ->
+                        FileUtil.touch ~time:(FileUtil.Touch_timestamp (float_of_int mtime)) path
                     | _ -> ())
                 | _ -> ())
           | _ -> ())
src/ocaml/dune
index a1286d8..cf8401b 100644
--- a/src/ocaml/dune
+++ b/src/ocaml/dune
@@ -4,4 +4,4 @@
  (foreign_stubs
   (language c)
   (names ptrace_stubs))
- (libraries unix yojson camomile ocaml-git fpath))
+ (libraries unix yojson camomile ocaml-git fpath fileutils))