irmin-pack.unix: Use asynchronous unlink when cleaning up chunks in Gc.

src/irmin-pack/unix/gc.ml

@@ -1,5 +1,5 @@
 (*
- * Copyright (c) 2022-2022 Tarides <contact@tarides.com>
+ * Copyright (c) 2022-2023 Tarides <contact@tarides.com>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -66,14 +66,13 @@ module Make (Args : Gc_args.S) = struct
     in
     let unlink_result_file () =
       let result_file = Irmin_pack.Layout.V4.gc_result ~root ~generation in
-      match Io.unlink result_file with
-      | Ok () -> ()
-      | Error (`Sys_error msg as err) ->
-          if msg <> Fmt.str "%s: No such file or directory" result_file then
-            [%log.warn
-              "Unlinking temporary files from previous failed gc. Failed with \
-               error %a"
-              (Irmin.Type.pp Errs.t) err]
+      Io.unlink_dont_wait
+        ~on_exn:(fun exn ->
+          [%log.warn
+            "Unlinking temporary files from previous failed gc. Failed with \
+             error %s"
+            (Printexc.to_string exn)])
+        result_file
     in
     (* Unlink next gc's result file, in case it is on disk, for instance
        after a failed gc. *)
@@ -131,40 +130,49 @@ module Make (Args : Gc_args.S) = struct
       ~suffix_dead_bytes ~latest_gc_target_offset ~volume_root:modified_volume
 
   let unlink_all { root; generation; _ } removable_chunk_idxs =
-    let result =
-      let open Result_syntax in
-      (* Unlink suffix chunks *)
-      let* () =
-        removable_chunk_idxs
-        |> List.iter_result @@ fun chunk_idx ->
-           let path = Irmin_pack.Layout.V4.suffix_chunk ~root ~chunk_idx in
-           Io.unlink path
+    (* Unlink suffix chunks *)
+    let () =
+      removable_chunk_idxs
+      |> List.iter (fun chunk_idx ->
+             let path = Irmin_pack.Layout.V4.suffix_chunk ~root ~chunk_idx in
+             Io.unlink_dont_wait
+               ~on_exn:(fun exn ->
+                 [%log.warn
+                   "Unlinking chunk_idxs files after gc, failed with error %s"
+                     (Printexc.to_string exn)])
+               path)
+    in
+    if generation >= 2 then (
+      (* Unlink previous prefix. *)
+      let prefix =
+        Irmin_pack.Layout.V4.prefix ~root ~generation:(generation - 1)
       in
-      let* () =
-        if generation >= 2 then
-          (* Unlink previous prefix. *)
-          let prefix =
-            Irmin_pack.Layout.V4.prefix ~root ~generation:(generation - 1)
-          in
-          let* () = Io.unlink prefix in
-          (* Unlink previous mapping. *)
-          let mapping =
-            Irmin_pack.Layout.V4.mapping ~root ~generation:(generation - 1)
-          in
-          let* () = Io.unlink mapping in
-          Ok ()
-        else Ok ()
+      Io.unlink_dont_wait
+        ~on_exn:(fun exn ->
+          [%log.warn
+            "Unlinking previous prefix after gc, failed with error %s"
+              (Printexc.to_string exn)])
+        prefix;
+
+      (* Unlink previous mapping. *)
+      let mapping =
+        Irmin_pack.Layout.V4.mapping ~root ~generation:(generation - 1)
       in
-      (* Unlink current gc's result.*)
-      let result = Irmin_pack.Layout.V4.gc_result ~root ~generation in
-      Io.unlink result
-    in
-    match result with
-    | Error e ->
+      Io.unlink_dont_wait
+        ~on_exn:(fun exn ->
+          [%log.warn
+            "Unlinking previous mapping after gc, failed with error %s"
+              (Printexc.to_string exn)])
+        mapping);
+
+    (* Unlink current gc's result.*)
+    let result = Irmin_pack.Layout.V4.gc_result ~root ~generation in
+    Io.unlink_dont_wait
+      ~on_exn:(fun exn ->
         [%log.warn
-          "Unlinking temporary files after gc, failed with error %a"
-            (Irmin.Type.pp Errs.t) e]
-    | Ok () -> ()
+          "Unlinking current gc's result after gc, failed with error %s"
+            (Printexc.to_string exn)])
+      result
 
   let gc_errors status gc_output =
     let extend_error s = function

src/irmin-pack/unix/io.ml

@@ -1,5 +1,5 @@
 (*
- * Copyright (c) 2022-2022 Tarides <contact@tarides.com>
+ * Copyright (c) 2022-2023 Tarides <contact@tarides.com>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -292,4 +292,7 @@ module Unix = struct
       Sys.remove path;
       Ok ()
     with Sys_error msg -> Error (`Sys_error msg)
+
+  let unlink_dont_wait ~on_exn path =
+    Lwt.dont_wait (fun () -> Lwt_unix.unlink path) on_exn
 end

src/irmin-pack/unix/io_intf.ml

@@ -1,5 +1,5 @@
 (*
- * Copyright (c) 2022-2022 Tarides <contact@tarides.com>
+ * Copyright (c) 2022-2023 Tarides <contact@tarides.com>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -86,6 +86,12 @@ module type S = sig
   val mkdir : string -> (unit, [> mkdir_error ]) result
   val unlink : string -> (unit, [> `Sys_error of string ]) result
 
+  val unlink_dont_wait : on_exn:(exn -> unit) -> string -> unit
+  (** [unlink_dont_wait file] attempts to unlink the named file but doesn't wait
+      for the completion of the unlink operation.
+
+      If unlink raises an exception it is passed to [on_exn]. *)
+
   (** {2 Read Functions} *)
 
   val read_to_string :