From 0e0f0109b7beb6d8a82cea041a5ab5e43be746ba Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Wed, 25 Apr 2018 09:47:39 +0100 Subject: [PATCH 1/4] really_write: remove deprecation and make robust against EINTR See discussion in https://ocaml.github.io/ocamlunix/ocamlunix.html#sec118 and https://github.com/xapi-project/xen-api/pull/3570 Signed-off-by: Marcello Seri --- lib/xapi-stdext-unix/unixext.ml | 28 ++++++++++++++++++++++++---- lib/xapi-stdext-unix/unixext.mli | 7 ++++--- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/lib/xapi-stdext-unix/unixext.ml b/lib/xapi-stdext-unix/unixext.ml index eeb526d9..0e6f7a08 100644 --- a/lib/xapi-stdext-unix/unixext.ml +++ b/lib/xapi-stdext-unix/unixext.ml @@ -444,14 +444,34 @@ 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 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 payload 0 (Bytes.length payload) (* --------------------------------------------------------------------------------------- *) (* 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..8752c375 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 -> bytes -> int -> int -> unit val really_write_string : Unix.file_descr -> string -> unit val try_read_string : ?limit: int -> Unix.file_descr -> string exception Timeout From b98891ac316fcd41242a1a76a624f2dd9b00dad6 Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Wed, 25 Apr 2018 09:48:27 +0100 Subject: [PATCH 2/4] unixext_open_stubs: fix use of uninitialised variable Signed-off-by: Marcello Seri --- lib/xapi-stdext-unix/unixext_open_stubs.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) 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)); } From 85f5556a328af9aa124d6902a8124c344a0593f4 Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Wed, 25 Apr 2018 11:45:49 +0100 Subject: [PATCH 3/4] really_write: use single_write_substring and avoid an unsafe coercion Signed-off-by: Marcello Seri --- lib/xapi-stdext-unix/unixext.ml | 5 ++--- lib/xapi-stdext-unix/unixext.mli | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/xapi-stdext-unix/unixext.ml b/lib/xapi-stdext-unix/unixext.ml index 0e6f7a08..fd931e6d 100644 --- a/lib/xapi-stdext-unix/unixext.ml +++ b/lib/xapi-stdext-unix/unixext.ml @@ -465,13 +465,12 @@ 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 fd buffer offset) len in + 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 - really_write fd payload 0 (Bytes.length payload) + 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 8752c375..d65047a9 100644 --- a/lib/xapi-stdext-unix/unixext.mli +++ b/lib/xapi-stdext-unix/unixext.mli @@ -102,7 +102,7 @@ val really_read_string : Unix.file_descr -> int -> string * 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 -> bytes -> int -> int -> unit +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 From 6fe6bef630b166a385d3959ec22ea3bb0f833cfa Mon Sep 17 00:00:00 2001 From: Marcello Seri Date: Wed, 25 Apr 2018 13:09:24 +0100 Subject: [PATCH 4/4] .travis.yml: don't run revdeps on the coverage build Signed-off-by: Marcello Seri --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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