fsync when flushing

src/unix/dune

@@ -1,5 +1,5 @@
 (library
  (public_name index.unix)
  (name index_unix)
- (c_names pread pwrite)
+ (c_names fsync pread pwrite)
  (libraries index logs logs.threaded threads unix))

src/unix/fsync.c

@@ -0,0 +1,40 @@
+/**************************************************************************/
+/*                                                                        */
+/*                                 OCaml                                  */
+/*                                                                        */
+/*             Francois Berenger, Kyushu Institute of Technology          */
+/*                                                                        */
+/*   Copyright 2018 Institut National de Recherche en Informatique et     */
+/*     en Automatique.                                                    */
+/*                                                                        */
+/*   All rights reserved.  This file is distributed under the terms of    */
+/*   the GNU Lesser General Public License version 2.1, with the          */
+/*   special exception on linking described in the file LICENSE.          */
+/*                                                                        */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+#include "caml/unixsupport.h"
+
+#ifdef _WIN32
+#include <io.h>
+#define fsync(fd) _commit(fd)
+#else
+#define fsync(fd) fsync(fd)
+#endif
+
+CAMLprim value unix_fsync(value v)
+{
+  int ret;
+#ifdef _WIN32
+  int fd = win_CRT_fd_of_filedescr(v);
+#else
+  int fd = Int_val(v);
+#endif
+  caml_enter_blocking_section();
+  ret = fsync(fd);
+  caml_leave_blocking_section();
+  if (ret == -1) uerror("fsync", Nothing);
+  return Val_unit;
+}

src/unix/index_unix.ml

@@ -81,6 +81,8 @@ module IO : Index.IO = struct
     external pwrite : Unix.file_descr -> int64 -> bytes -> int -> int -> int
       = "caml_pwrite"
 
+    external unix_fsync : Unix.file_descr -> unit = "unix_fsync"
+
     let really_write fd off buf =
       let rec aux fd_off buf_off len =
         let w = pwrite fd fd_off buf buf_off len in
@@ -100,6 +102,8 @@ module IO : Index.IO = struct
       in
       (aux [@tailcall]) off 0 len
 
+    let fsync t = unix_fsync t.fd
+
     let unsafe_write t ~off buf =
       let buf = Bytes.unsafe_of_string buf in
       really_write t.fd off buf;
@@ -199,7 +203,8 @@ module IO : Index.IO = struct
       Raw.Offset.set t.raw offset;
       assert (
         t.flushed ++ Int64.of_int (String.length buf) = t.header ++ offset );
-      t.flushed <- offset ++ t.header )
+      t.flushed <- offset ++ t.header );
+    Raw.fsync t.raw
 
   let name t = t.file