feat: update prepare function for atomic lock (ocaml#10852)

* feat: update prepare function for atomic lock Signed-off-by: Etienne Marais <[email protected]> * Minor fixes to atomic locking Signed-off-by: Stephen Sherratt <[email protected]> Signed-off-by: Etienne Marais <[email protected]> * fix: turn into a closure to avoid build leak Signed-off-by: Etienne Marais <[email protected]> * fix: make errors more readable Signed-off-by: Etienne Marais <[email protected]> * fix: rename at the last moment and derive lock dir path Signed-off-by: Etienne Marais <[email protected]> --------- Signed-off-by: Etienne Marais <[email protected]> Signed-off-by: Stephen Sherratt <[email protected]> Co-authored-by: Stephen Sherratt <[email protected]>
maiste · Aug 30, 2024 · 4403e9f · 4403e9f
1 parent 4472318
commit 4403e9f
Show file tree

Hide file tree

Showing 2 changed files with 77 additions and 26 deletions.
diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml
@@ -498,6 +498,36 @@ module Write_disk = struct
     | Ok _ -> Error `Not_directory
   ;;
 
+  let raise_user_error_on_check_existance path e =
+    let error_reason =
+      match e with
+      | `Unreadable ->
+        Pp.textf "Unable to read lock directory (%s)" (Path.to_string_maybe_quoted path)
+      | `Not_directory ->
+        Pp.textf
+          "Specified lock dir path (%s) is not a directory"
+          (Path.to_string_maybe_quoted path)
+      | `No_metadata_file ->
+        Pp.textf "Specified lock dir lacks metadata file (%s)" metadata_filename
+      | `Failed_to_parse_metadata (path, exn) ->
+        Pp.concat
+          ~sep:Pp.cut
+          [ Pp.textf
+              "Unable to parse lock directory metadata file (%s):"
+              (Path.to_string_maybe_quoted path)
+            |> Pp.hovbox
+          ; Exn.pp exn |> Pp.hovbox
+          ]
+        |> Pp.vbox
+    in
+    User_error.raise
+      [ Pp.textf
+          "Refusing to regenerate lock directory %s"
+          (Path.to_string_maybe_quoted path)
+      ; error_reason
+      ]
+  ;;
+
   (* Removes the existing lock directory at the specified path if it exists and
      is a valid lock directory. Checks the validity of the existing lockdir (if
      any) and raises if it's invalid before constructing the returned thunk, so
@@ -507,40 +537,51 @@ module Write_disk = struct
     match check_existing_lock_dir path with
     | Ok `Non_existant -> Fun.const ()
     | Ok `Is_existing_lock_dir -> fun () -> Path.rm_rf path
-    | Error e ->
+    | Error e -> raise_user_error_on_check_existance path e
+  ;;
+
+  (* Does the same checks as [safely_remove_lock_dir_if_exists_thunk] but it raises an
+     error if the lock dir already exists. [dst] is the new file name *)
+  let safely_rename_lock_dir_thunk ~dst src =
+    match check_existing_lock_dir src, check_existing_lock_dir dst with
+    | Ok `Is_existing_lock_dir, Ok `Non_existant -> fun () -> Path.rename src dst
+    | Ok `Non_existant, Ok `Non_existant -> Fun.const ()
+    | _, Ok `Is_existing_lock_dir ->
       let error_reason_pp =
-        match e with
-        | `Unreadable -> Pp.text "Unable to read lock directory"
-        | `Not_directory -> Pp.text "Specified lock dir path is not a directory"
-        | `No_metadata_file ->
-          Pp.textf "Specified lock dir lacks metadata file (%s)" metadata_filename
-        | `Failed_to_parse_metadata (path, exn) ->
-          Pp.concat
-            ~sep:Pp.cut
-            [ Pp.textf
-                "Unable to parse lock directory metadata file (%s):"
-                (Path.to_string_maybe_quoted path)
-              |> Pp.hovbox
-            ; Exn.pp exn |> Pp.hovbox
-            ]
-          |> Pp.vbox
+        Pp.textf
+          "Directory %s already exists: can't rename safely"
+          (Path.to_string_maybe_quoted src)
       in
       User_error.raise
         [ Pp.textf
             "Refusing to regenerate lock directory %s"
-            (Path.to_string_maybe_quoted path)
+            (Path.to_string_maybe_quoted src)
         ; error_reason_pp
         ]
+    | Error e, _ -> raise_user_error_on_check_existance src e
+    | _, Error e -> raise_user_error_on_check_existance dst e
   ;;
 
   type t = unit -> unit
 
-  let prepare ~lock_dir_path:lock_dir_path_src ~files lock_dir =
-    let lock_dir_path = Path.source lock_dir_path_src in
-    let remove_dir_if_exists = safely_remove_lock_dir_if_exists_thunk lock_dir_path in
-    fun () ->
-      remove_dir_if_exists ();
-      Path.mkdir_p lock_dir_path;
+  let prepare
+    ~lock_dir_path:lock_dir_path_src
+    ~(files : File_entry.t Package_name.Map.Multi.t)
+    lock_dir
+    =
+    let lock_dir_hidden_src =
+      lock_dir_path_src |> Path.Source.to_string |> sprintf ".%s" |> Path.Source.of_string
+    in
+    let lock_dir_hidden_src = Path.source lock_dir_hidden_src in
+    let lock_dir_path_external = Path.source lock_dir_path_src in
+    let remove_hidden_dir_if_exists () =
+      safely_remove_lock_dir_if_exists_thunk lock_dir_hidden_src ()
+    in
+    let rename_old_lock_dir_to_hidden =
+      safely_rename_lock_dir_thunk ~dst:lock_dir_hidden_src lock_dir_path_external
+    in
+    let build lock_dir_path =
+      let lock_dir_path = Result.ok_exn lock_dir_path in
       file_contents_by_path lock_dir
       |> List.iter ~f:(fun (path_within_lock_dir, contents) ->
         let path = Path.relative lock_dir_path path_within_lock_dir in
@@ -555,15 +596,25 @@ module Write_disk = struct
         Format.asprintf "%a" Pp.to_fmt pp |> Io.write_file path;
         Package_name.Map.iteri files ~f:(fun package_name files ->
           let files_dir =
-            Pkg.files_dir package_name ~lock_dir:lock_dir_path_src |> Path.source
+            Path.relative lock_dir_path (Package_name.to_string package_name ^ ".files")
           in
           Path.mkdir_p files_dir;
           List.iter files ~f:(fun { File_entry.original; local_file } ->
             let dst = Path.append_local files_dir local_file in
             Path.mkdir_p (Path.parent_exn dst);
             match original with
             | Path src -> Io.copy_file ~src ~dst ()
-            | Content content -> Io.write_file dst content)))
+            | Content content -> Io.write_file dst content)));
+      rename_old_lock_dir_to_hidden ();
+      safely_rename_lock_dir_thunk ~dst:lock_dir_path_external lock_dir_path ();
+      remove_hidden_dir_if_exists ()
+    in
+    match Path.(parent (source lock_dir_path_src)) with
+    | Some parent_dir ->
+      fun () -> Temp.with_temp_dir ~parent_dir ~prefix:"dune" ~suffix:"lock" ~f:build
+    | None ->
+      User_error.raise
+        [ Pp.textf "Temporary directory can't be created by deriving the lock dir path" ]
   ;;
 
   let commit t = t ()

diff --git a/test/blackbox-tests/test-cases/pkg/lock-directory-regeneration-safety.t/run.t b/test/blackbox-tests/test-cases/pkg/lock-directory-regeneration-safety.t/run.t
@@ -53,5 +53,5 @@ Attempt to create a lock directory with the same name as an existing regular fil
   $ touch dune.lock
   $ dune pkg lock
   Error: Refusing to regenerate lock directory dune.lock
-  Specified lock dir path is not a directory
+  Specified lock dir path (dune.lock) is not a directory
   [1]