From cbfec0e29ee36254a23b24e5fd4daa42e997d931 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Mon, 26 Apr 2021 09:52:08 +0100 Subject: [PATCH 1/3] Do not fail due to races when deleting directories Signed-off-by: Andrey Mokhov --- otherlibs/stdune-unstable/fpath.ml | 17 +++++++++++++---- otherlibs/stdune-unstable/fpath.mli | 7 ++++++- otherlibs/stdune-unstable/path.mli | 5 +++-- otherlibs/stdune-unstable/temp.ml | 7 ++++++- 4 files changed, 28 insertions(+), 8 deletions(-) diff --git a/otherlibs/stdune-unstable/fpath.ml b/otherlibs/stdune-unstable/fpath.ml index 48fba799874..19a65eb1f33 100644 --- a/otherlibs/stdune-unstable/fpath.ml +++ b/otherlibs/stdune-unstable/fpath.ml @@ -91,9 +91,13 @@ let unlink_no_err t = try unlink t with | _ -> () +type clear_dir_result = + | Cleared + | Does_not_exist + let rec clear_dir dir = match Dune_filesystem_stubs.read_directory_with_kinds dir with - | Error ENOENT -> () + | Error ENOENT -> Does_not_exist | Error error -> raise (Unix.Unix_error @@ -101,13 +105,18 @@ let rec clear_dir dir = | 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 + | Does_not_exist -> () let rm_rf ?(allow_external = false) fn = if (not allow_external) && not (Filename.is_relative fn) then diff --git a/otherlibs/stdune-unstable/fpath.mli b/otherlibs/stdune-unstable/fpath.mli index e59a47ad578..fed55caf4fe 100644 --- a/otherlibs/stdune-unstable/fpath.mli +++ b/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 + | Does_not_exist +val clear_dir : string -> clear_dir_result + +(** If the directory does not exist, this function is a no-op. *) val rm_rf : ?allow_external:bool -> string -> unit diff --git a/otherlibs/stdune-unstable/path.mli b/otherlibs/stdune-unstable/path.mli index 93d05f62456..df2c5547af6 100644 --- a/otherlibs/stdune-unstable/path.mli +++ b/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 diff --git a/otherlibs/stdune-unstable/temp.ml b/otherlibs/stdune-unstable/temp.ml index 4c6a74384f5..7eddbb0019d 100644 --- a/otherlibs/stdune-unstable/temp.ml +++ b/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 -> () + | Does_not_exist -> + (* We can end up here if nested temporary directories are cleared starting + from the outermost directory. It's OK to do nothing in this case. *) + ()); let remove_from_set ~set = set := Path.Set.filter !set ~f:(fun f -> From 953cf4ee6679cad9c5122d90c771dbab615beeeb Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Mon, 26 Apr 2021 09:57:00 +0100 Subject: [PATCH 2/3] Update CHANGES Signed-off-by: Andrey Mokhov --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 4d71c81c0e8..553fc6f7480 100644 --- a/CHANGES.md +++ b/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) ------------------ From 9fe9f5b10518dc6095b9024665bfda25d7a2dd74 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Mon, 26 Apr 2021 10:00:30 +0100 Subject: [PATCH 3/3] Minor tweaks Signed-off-by: Andrey Mokhov --- otherlibs/stdune-unstable/fpath.ml | 6 +++--- otherlibs/stdune-unstable/fpath.mli | 4 ++-- otherlibs/stdune-unstable/temp.ml | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/otherlibs/stdune-unstable/fpath.ml b/otherlibs/stdune-unstable/fpath.ml index 19a65eb1f33..fa8a22330d6 100644 --- a/otherlibs/stdune-unstable/fpath.ml +++ b/otherlibs/stdune-unstable/fpath.ml @@ -93,11 +93,11 @@ let unlink_no_err t = type clear_dir_result = | Cleared - | Does_not_exist + | Directory_does_not_exist let rec clear_dir dir = match Dune_filesystem_stubs.read_directory_with_kinds dir with - | Error ENOENT -> Does_not_exist + | Error ENOENT -> Directory_does_not_exist | Error error -> raise (Unix.Unix_error @@ -116,7 +116,7 @@ let rec clear_dir dir = and rm_rf_dir path = match clear_dir path with | Cleared -> Unix.rmdir path - | Does_not_exist -> () + | Directory_does_not_exist -> () let rm_rf ?(allow_external = false) fn = if (not allow_external) && not (Filename.is_relative fn) then diff --git a/otherlibs/stdune-unstable/fpath.mli b/otherlibs/stdune-unstable/fpath.mli index fed55caf4fe..2f273fc0e22 100644 --- a/otherlibs/stdune-unstable/fpath.mli +++ b/otherlibs/stdune-unstable/fpath.mli @@ -29,9 +29,9 @@ val initial_cwd : string type clear_dir_result = | Cleared - | Does_not_exist + | Directory_does_not_exist val clear_dir : string -> clear_dir_result -(** If the directory does not exist, this function is a no-op. *) +(** If the path does not exist, this function is a no-op. *) val rm_rf : ?allow_external:bool -> string -> unit diff --git a/otherlibs/stdune-unstable/temp.ml b/otherlibs/stdune-unstable/temp.ml index 7eddbb0019d..e46cca6d9b0 100644 --- a/otherlibs/stdune-unstable/temp.ml +++ b/otherlibs/stdune-unstable/temp.ml @@ -90,9 +90,9 @@ let destroy what fn = let clear_dir dir = (match Path.clear_dir dir with | Cleared -> () - | Does_not_exist -> - (* We can end up here if nested temporary directories are cleared starting - from the outermost directory. It's OK to do nothing in this case. *) + | 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 :=