Fsync files at the end of snapshot export

src/irmin-pack/atomic_write.ml

@@ -34,4 +34,5 @@ module Closeable (AW : S) = struct
   include Irmin.Atomic_write.Check_closed_store (AW)
 
   let flush t = get_if_open_exn t |> AW.flush
+  let fsync t = get_if_open_exn t |> AW.fsync
 end

src/irmin-pack/atomic_write_intf.ml

@@ -18,6 +18,7 @@ module type S = sig
   include Irmin.Atomic_write.S
 
   val flush : t -> unit
+  val fsync : t -> unit
 end
 
 module type Persistent = sig

src/irmin-pack/mem/irmin_pack_mem.ml

@@ -22,6 +22,7 @@ module Atomic_write (K : Irmin.Type.S) (V : Irmin.Hash.S) = struct
 
   let v () = AW.v (Irmin_mem.config ())
   let flush _t = ()
+  let fsync _t = ()
 end
 
 module Indexable_mem

src/irmin-pack/unix/atomic_write.ml

@@ -192,4 +192,5 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct
 
   let close t = unsafe_close t
   let flush t = Io_legacy.flush t.block
+  let fsync t = Io_legacy.fsync t.block
 end

src/irmin-pack/unix/ext.ml

@@ -376,7 +376,13 @@ module Maker (Config : Conf.S) = struct
             let* branch_store =
               Branch.v ~fresh:true ~readonly:false branch_path
             in
+            (* Gc worker always fsyncs prefix and mapping files. File_manager
+               fsyncs dict, control, suffix and index. Fsync branch file here. Then
+               fsync directory. *)
+            let use_fsync = Irmin_pack.Conf.use_fsync t.config in
+            let () = if use_fsync then Branch.fsync branch_store in
             let* () = Branch.close branch_store in
+            let () = Io.fsync_dir path |> Errs.raise_if_error in
             Lwt.return_unit
         end
 

src/irmin-pack/unix/file_manager.ml

@@ -813,18 +813,17 @@ struct
           (* The caller of this function lifted the key to a direct one. *)
           assert false
     in
-    (* Step 1. Copy the dict *)
+    (* Step 1. Copy the dict. *)
     let src_dict = Irmin_pack.Layout.V4.dict ~root in
     let dst_dict = Irmin_pack.Layout.V4.dict ~root:new_store_root in
     let* () = Io.cp_file ~src:src_dict ~dst:dst_dict in
-    (* Step 2. Create an empty suffix and close it. *)
+    (* Step 2. Create an empty suffix. *)
     let* suffix =
       Suffix.create_rw ~root:new_store_root ~overwrite:false
         ~auto_flush_threshold:1_000_000 ~auto_flush_procedure:`Internal
         ~start_idx:1
     in
-    let* () = Suffix.close suffix in
-    (* Step 3. Create the control file and close it. *)
+    (* Step 3. Create the control file. *)
     let status =
       Payload.Gced
         {
@@ -848,7 +847,6 @@ struct
     in
     let path = Irmin_pack.Layout.V4.control ~root:new_store_root in
     let* control = Control.create_rw ~path ~overwrite:false pl in
-    let* () = Control.close control in
     (* Step 4. Create the index. *)
     let* index =
       let log_size = Conf.index_log_size config in
@@ -863,6 +861,17 @@ struct
           Index.add index hash (offset, length, Pack_value.Kind.Commit_v2)
       | Indexed _ -> assert false
     in
+    (* Step 6. Fsync and close files. *)
+    let use_fsync = Irmin_pack.Conf.use_fsync config in
+    let* () =
+      if use_fsync then
+        let* _ = Suffix.fsync suffix in
+        let* _ = Control.fsync control in
+        Index.flush ~with_fsync:true index
+      else Ok ()
+    in
+    let* () = Suffix.close suffix in
+    let* () = Control.close control in
     let* () = Index.close index in
     Ok ()
 end

src/irmin-pack/unix/io_legacy.ml

@@ -203,4 +203,5 @@ module Unix : S = struct
   let close t = Raw.close t.raw
   let exists file = Sys.file_exists file
   let size { raw; _ } = (Raw.fstat raw).st_size
+  let fsync t = Raw.fsync t.raw
 end

src/irmin-pack/unix/io_legacy_intf.ml

@@ -34,6 +34,7 @@ module type S = sig
   val exists : string -> bool
   val size : t -> int
   val mkdir : string -> unit
+  val fsync : t -> unit
 
   (* {2 Versioning} *)
 

src/irmin-pack/unix/s.ml

@@ -58,6 +58,9 @@ module type S = sig
       the existing one, containing only one commit, specified by the [key]. Note
       that this operation is blocking.
 
+      If [repo] is opened with the flag [use_fsync] set, then [path] is flushed
+      to disk.
+
       It requires that the files existing on disk when the operation is
       launched, remain on disk until the operation completes. In particular, a
       Gc running in a different process could remove files from disk. *)