Use fcntl(F_FULLFSYNC) on OSX

_oasis

@@ -13,7 +13,8 @@ Library mirage_block_unix
   Findlibname:        mirage-block-unix
   Modules:            Block
   BuildDepends:       cstruct (>= 1.3.0), cstruct.lwt, lwt, lwt.unix, mirage-types, logs
-  CSources:           odirect_stubs.c, blkgetsize_stubs.c, lseekhole_stubs.c
+  CSources:           odirect_stubs.c, blkgetsize_stubs.c, lseekhole_stubs.c, flush_stubs.c
+  CCOpt:              -I $(pkg_lwt)
 
 Executable test
   Build$:             flag(tests)

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 20b3e491575421526a838c26f9aa4bd8)
+# DO NOT EDIT (digest: 2523786f1804452927ad7ed0a182fe0f)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -16,6 +16,11 @@ true: annot, bin_annot
 "_darcs": not_hygienic
 # Library mirage_block_unix
 "lib/mirage_block_unix.cmxs": use_mirage_block_unix
+<lib/*.ml{,i,y}>: oasis_library_mirage_block_unix_ccopt
+"lib/odirect_stubs.c": oasis_library_mirage_block_unix_ccopt
+"lib/blkgetsize_stubs.c": oasis_library_mirage_block_unix_ccopt
+"lib/lseekhole_stubs.c": oasis_library_mirage_block_unix_ccopt
+"lib/flush_stubs.c": oasis_library_mirage_block_unix_ccopt
 <lib/mirage_block_unix.{cma,cmxa}>: use_libmirage_block_unix_stubs
 <lib/*.ml{,i,y}>: pkg_cstruct
 <lib/*.ml{,i,y}>: pkg_cstruct.lwt
@@ -41,6 +46,12 @@ true: annot, bin_annot
 "lib/lseekhole_stubs.c": pkg_lwt
 "lib/lseekhole_stubs.c": pkg_lwt.unix
 "lib/lseekhole_stubs.c": pkg_mirage-types
+"lib/flush_stubs.c": pkg_cstruct
+"lib/flush_stubs.c": pkg_cstruct.lwt
+"lib/flush_stubs.c": pkg_logs
+"lib/flush_stubs.c": pkg_lwt
+"lib/flush_stubs.c": pkg_lwt.unix
+"lib/flush_stubs.c": pkg_mirage-types
 # Executable test
 <lib_test/test.{native,byte}>: pkg_cstruct
 <lib_test/test.{native,byte}>: pkg_cstruct.lwt

lib/block.ml

@@ -264,13 +264,15 @@ let resize t new_size_sectors =
              )
         )
 
+external flush_job: Unix.file_descr -> unit Lwt_unix.job = "mirage_block_unix_flush_job"
+
 let flush t =
   match t.fd with
   | None -> return (`Error `Disconnected)
   | Some fd ->
     lwt_wrap_exn t "fsync" 0L
       (fun () ->
-         Lwt_unix.fsync fd
+         Lwt_unix.run_job (flush_job (Lwt_unix.unix_file_descr fd))
          >>= fun () ->
          return (`Ok ())
       )

lib/flush_stubs.c

@@ -0,0 +1,97 @@
+/*
+ * Copyright (c) 2016 Docker Inc
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#include <stdint.h>
+#include <string.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <errno.h>
+
+#ifdef WIN32
+#include <winsock2.h>
+#include <wtypes.h>
+#include <winbase.h>
+#include <tchar.h>
+#else
+#define HANDLE int
+#define DWORD int
+#define Handle_val(x) Int_val(x)
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/bigarray.h>
+#include <caml/threads.h>
+#include <caml/unixsupport.h>
+#include <caml/callback.h>
+
+#include "lwt_unix.h"
+
+struct job_flush {
+  struct lwt_unix_job job;
+  HANDLE fd;
+  DWORD errno_copy;
+};
+
+static void worker_flush(struct job_flush *job)
+{
+  int result = 0;
+#ifdef WIN32
+  if (!FlushFileBuffers(job->fd)) {
+    job->errno_copy = GetLastError();
+  }
+#else
+  #if defined(__APPLE__)
+    result = fcntl(job->fd, F_FULLFSYNC);
+  #else
+    result = fsync(job->fd);
+  #endif
+    if (result == -1) {
+      job->errno_copy = errno;
+    }
+#endif
+}
+
+static value result_flush(struct job_flush *job)
+{
+  CAMLparam0 ();
+  int errno_copy = job->errno_copy;
+  lwt_unix_free_job(&job->job);
+  if (errno_copy != 0) {
+#ifdef WIN32
+  win32_maperr(errno_copy);
+  unix_error(errno_copy, "FlushFileBuffers", Nothing);
+#else
+  #if defined(__APPLE__)
+      unix_error(errno_copy, "fcntl", Nothing);
+  #else
+      unix_error(errno_copy, "fsync", Nothing);
+  #endif
+#endif
+  }
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim
+value mirage_block_unix_flush_job(value handle)
+{
+  CAMLparam1(handle);
+  LWT_UNIX_INIT_JOB(job, flush, 0);
+  job->fd = (HANDLE)Handle_val(handle);
+  job->errno_copy = 0;
+  CAMLreturn(lwt_unix_alloc_job(&(job->job)));
+}

lib/libmirage_block_unix_stubs.clib

@@ -1,6 +1,7 @@
 # OASIS_START
-# DO NOT EDIT (digest: b668f9216e9c571614f025452abff2ec)
+# DO NOT EDIT (digest: 51b18f9c3d31dfc97ba94ea12beaa69f)
 odirect_stubs.o
 blkgetsize_stubs.o
 lseekhole_stubs.o
+flush_stubs.o
 # OASIS_STOP