Do not fail due to races when deleting directories (#4529)

I came across a crash similar to #4489. I think both crashes are caused by a race, where a concurrent
process deletes an entry after we saw it in the listing of a directory in [clear_dir] but before we managed
to delete it ourselves.

Signed-off-by: Andrey Mokhov <[email protected]>

CHANGES.md

@@ -118,6 +118,8 @@ Unreleased
 - Fixed a bug where a sandboxed action would fail if it declares no dependencies in
   its initial working directory or any directory it `chdir`s into. (#4509, @aalekseyev)
 
+- Fix a crash when clearing temporary directories (#4489, #4529, Andrey Mokhov)
+
 2.9.0 (unreleased)
 ------------------
 

otherlibs/stdune-unstable/fpath.ml

@@ -91,23 +91,32 @@ let unlink_no_err t =
   try unlink t with
   | _ -> ()
 
+type clear_dir_result =
+  | Cleared
+  | Directory_does_not_exist
+
 let rec clear_dir dir =
   match Dune_filesystem_stubs.read_directory_with_kinds dir with
-  | Error ENOENT -> ()
+  | Error ENOENT -> Directory_does_not_exist
   | Error error ->
     raise
       (Unix.Unix_error
          (error, dir, "Stdune.Path.rm_rf: read_directory_with_kinds"))
   | Ok listing ->
     List.iter listing ~f:(fun (fn, kind) ->
         let fn = Filename.concat dir fn in
+        (* Note that by the time we reach this point, [fn] might have been
+           deleted by a concurrent process. Both [rm_rf_dir] and [unlink_no_err]
+           will tolerate such phantom paths and succeed. *)
         match kind with
         | Unix.S_DIR -> rm_rf_dir fn
-        | _ -> unlink fn)
+        | _ -> unlink_no_err fn);
+    Cleared
 
 and rm_rf_dir path =
-  clear_dir path;
-  Unix.rmdir path
+  match clear_dir path with
+  | Cleared -> Unix.rmdir path
+  | Directory_does_not_exist -> ()
 
 let rm_rf ?(allow_external = false) fn =
   if (not allow_external) && not (Filename.is_relative fn) then

otherlibs/stdune-unstable/fpath.mli

@@ -27,6 +27,11 @@ val unlink_no_err : string -> unit
 
 val initial_cwd : string
 
-val clear_dir : string -> unit
+type clear_dir_result =
+  | Cleared
+  | Directory_does_not_exist
 
+val clear_dir : string -> clear_dir_result
+
+(** If the path does not exist, this function is a no-op. *)
 val rm_rf : ?allow_external:bool -> string -> unit

otherlibs/stdune-unstable/path.mli

@@ -334,11 +334,12 @@ val unlink_no_err : t -> unit
 
 val link : t -> t -> unit
 
+(** If the path does not exist, this function is a no-op. *)
 val rm_rf : ?allow_external:bool -> t -> unit
 
 (** [clear_dir t] deletes all the contents of directory [t] without removing [t]
-    itself *)
-val clear_dir : t -> unit
+    itself. *)
+val clear_dir : t -> Fpath.clear_dir_result
 
 val mkdir_p : ?perms:int -> t -> unit
 

otherlibs/stdune-unstable/temp.ml

@@ -88,7 +88,12 @@ let destroy what fn =
   set := Path.Set.remove !set fn
 
 let clear_dir dir =
-  Path.clear_dir dir;
+  (match Path.clear_dir dir with
+  | Cleared -> ()
+  | Directory_does_not_exist ->
+    (* We can end up here if the temporary directory has already been cleared,
+       e.g. manually by the caller of [create Dir]. *)
+    ());
   let remove_from_set ~set =
     set :=
       Path.Set.filter !set ~f:(fun f ->