really_write: remove deprecation and make robust against EINTR

.travis.yml

@@ -13,7 +13,7 @@ env:
     - TEST=false
     - BASE_REMOTE="https://github.com/xapi-project/xs-opam"
   matrix:
-    - PACKAGE=xapi-stdext OCAML_VERSION=4.04.2 REVDEPS=true \
+    - PACKAGE=xapi-stdext OCAML_VERSION=4.04.2 \
       POST_INSTALL_HOOK="opam install alcotest; env TRAVIS=$TRAVIS TRAVIS_JOB_ID=$TRAVIS_JOB_ID bash -ex coverage.sh"
     - PACKAGE=stdext OCAML_VERSION=4.04.2 REVDEPS=true
     - PACKAGE=xapi-stdext OCAML_VERSION=4.06.0

lib/xapi-stdext-unix/unixext.ml

@@ -444,14 +444,33 @@ let try_read_string ?limit fd =
   done;
   Buffer.contents buf
 
-(* This was equivalent to Unix.write - deprecating *)
-let really_write fd string off n =
-  Unix.write fd string off n |> ignore
+(* From https://ocaml.github.io/ocamlunix/ocamlunix.html#sec118
+The function write of the Unix module iterates the system call write until
+all the requested bytes are effectively written.
+val write : file_descr -> string -> int -> int -> int
+However, when the descriptor is a pipe (or a socket, see chapter 6), writes
+may block and the system call write may be interrupted by a signal. In this
+case the OCaml call to Unix.write is interrupted and the error EINTR is raised.
+The problem is that some of the data may already have been written by a
+previous system call to write but the actual size that was transferred is
+unknown and lost. This renders the function write of the Unix module useless
+in the presence of signals.
+
+To address this problem, the Unix module also provides the “raw” system call
+write under the name single_write.
+
+We can use multiple single_write calls to write exactly the requested
+amount of data (but not atomically!).
+*)
+let rec restart_on_EINTR f x =
+  try f x with Unix.Unix_error (Unix.EINTR, _, _) -> restart_on_EINTR f x
+and really_write fd buffer offset len =
+  let n = restart_on_EINTR (Unix.single_write_substring fd buffer offset) len in
+  if n < len then really_write fd buffer (offset + n) (len - n);;
 
 (* Ideally, really_write would be implemented with optional arguments ?(off=0) ?(len=String.length string) *)
 let really_write_string fd string =
-  let payload = Bytes.unsafe_of_string string in
-  Unix.write fd payload 0 (Bytes.length payload) |> ignore
+  really_write fd string 0 (String.length string)
 
 (* --------------------------------------------------------------------------------------- *)
 (* Functions to read and write to/from a file descriptor with a given latest response time *)

lib/xapi-stdext-unix/unixext.mli

@@ -99,9 +99,10 @@ val proxy : Unix.file_descr -> Unix.file_descr -> unit
 val really_read : Unix.file_descr -> bytes -> int -> int -> unit
 val really_read_string : Unix.file_descr -> int -> string
 (** [really_write] keeps repeating the write operation until all bytes
- * have been written or an error occurs. This is the same behaviour of
- * [Unix.write] that should be preferred instead. *)
-val really_write : Unix.file_descr -> bytes -> int -> int -> unit [@@ocaml.deprecated]
+ * have been written or an error occurs. This is not atomic but is
+ * robust against EINTR errors. 
+ * See: https://ocaml.github.io/ocamlunix/ocamlunix.html#sec118 *)
+val really_write : Unix.file_descr -> string -> int -> int -> unit
 val really_write_string : Unix.file_descr -> string -> unit
 val try_read_string : ?limit: int -> Unix.file_descr -> string
 exception Timeout

lib/xapi-stdext-unix/unixext_open_stubs.c

@@ -44,7 +44,10 @@ static int open_flag_table[] = {
 CAMLprim value stub_stdext_unix_open_direct(value path, value flags, value perm)
 {
   CAMLparam3(path, flags, perm);
-  int fd, ret, cv_flags;
+  int fd, cv_flags;
+#ifndef O_DIRECT
+  int ret;
+#endif
   char * p;
 
   cv_flags = convert_flag_list(flags, open_flag_table);
@@ -60,11 +63,13 @@ CAMLprim value stub_stdext_unix_open_direct(value path, value flags, value perm)
 #ifndef O_DIRECT
   if (fd != -1)
     ret = fcntl(fd, F_NOCACHE);
-#endif  
+#endif
   leave_blocking_section();
   stat_free(p);
   if (fd == -1) uerror("open", path);
+#ifndef O_DIRECT
   if (ret == -1) uerror("fcntl", path);
+#endif
 
   CAMLreturn (Val_int(fd));
 }