diff --git a/.travis.yml b/.travis.yml index aae9bc66..fbe3589f 100644 --- a/.travis.yml +++ b/.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 diff --git a/lib/xapi-stdext-unix/unixext.ml b/lib/xapi-stdext-unix/unixext.ml index eeb526d9..fd931e6d 100644 --- a/lib/xapi-stdext-unix/unixext.ml +++ b/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 *) diff --git a/lib/xapi-stdext-unix/unixext.mli b/lib/xapi-stdext-unix/unixext.mli index 3464a720..d65047a9 100644 --- a/lib/xapi-stdext-unix/unixext.mli +++ b/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 diff --git a/lib/xapi-stdext-unix/unixext_open_stubs.c b/lib/xapi-stdext-unix/unixext_open_stubs.c index 35b58713..af1f967f 100644 --- a/lib/xapi-stdext-unix/unixext_open_stubs.c +++ b/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)); }