From 2f10fdb009fc075e5fea10ee865d0c371e5af8f3 Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Tue, 28 Feb 2017 18:54:09 +0100 Subject: [PATCH 01/10] Use conditional compilation for Lwt_unix + OCaml 4.05 compat (O_KEEPEXEC). --- _oasis | 3 ++- _tags | 4 ++++ lwt.opam | 1 + myocamlbuild.ml | 2 ++ src/unix/{lwt_unix.ml => lwt_unix.cppo.ml} | 9 +++++++++ src/unix/{lwt_unix.mli => lwt_unix.cppo.mli} | 3 +++ 6 files changed, 21 insertions(+), 1 deletion(-) rename src/unix/{lwt_unix.ml => lwt_unix.cppo.ml} (99%) rename src/unix/{lwt_unix.mli => lwt_unix.cppo.mli} (99%) diff --git a/_oasis b/_oasis index 9ce8cc8831..0797216465 100644 --- a/_oasis +++ b/_oasis @@ -31,7 +31,8 @@ XDevFilesEnableMakefile: false PostConfCommand: ocaml src/util/discover.ml -ext-obj $ext_obj -exec-name $default_executable_name -use-libev $libev -os-type $os_type -use-glib $glib -ccomp-type $ccomp_type -use-pthread $pthread -use-unix $unix -android-target $android_target -libev_default $libev_default PostDistCleanCommand: $rm src/unix/lwt_config.h src/unix/lwt_config.ml src/unix/lwt_unix_jobs_generated.ml src/unix/jobs-unix/* -AlphaFeatures: pure_interface +AlphaFeatures: pure_interface, ocamlbuild_more_args +XOCamlbuildPluginTags: package(cppo_ocamlbuild) Synopsis: Monadic promises and concurrent I/O Description: diff --git a/_tags b/_tags index 931c779916..6f37a509a9 100644 --- a/_tags +++ b/_tags @@ -1,6 +1,10 @@ # -*- conf -*- not : safe_string +# cppo pre-processing for OCaml (compiler/stdlib) compatibility workarounds +<**/*.ml>: cppo_V_OCAML +<**/*.mli>: cppo_V_OCAML + # Warnings. The order is important. This is not fully legitimate as it appears # to depend on how Ocamlbuild internally handles lists of warn() tags. or : warn(-4) diff --git a/lwt.opam b/lwt.opam index 09e53af19c..215238383a 100644 --- a/lwt.opam +++ b/lwt.opam @@ -35,6 +35,7 @@ depends: [ "ocamlfind" {build & >= "1.5.0"} "ocamlbuild" {build} "result" + "cppo" # See https://github.com/ocsigen/lwt/issues/266 ( "base-no-ppx" | "ppx_tools" {build} ) ## OASIS is not required in released version diff --git a/myocamlbuild.ml b/myocamlbuild.ml index d867139dae..d29f43a6b0 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -91,6 +91,8 @@ let () = dispatch begin fun hook -> () in + Ocamlbuild_cppo.dispatcher hook; + dispatch_default hook; match hook with diff --git a/src/unix/lwt_unix.ml b/src/unix/lwt_unix.cppo.ml similarity index 99% rename from src/unix/lwt_unix.ml rename to src/unix/lwt_unix.cppo.ml index 9a25906d2d..b668a88874 100644 --- a/src/unix/lwt_unix.ml +++ b/src/unix/lwt_unix.cppo.ml @@ -594,6 +594,9 @@ type open_flag = | O_RSYNC | O_SHARE_DELETE | O_CLOEXEC +#if OCAML_VERSION >= (4, 05, 0) + | O_KEEPEXEC +#endif external open_job : string -> Unix.open_flag list -> int -> (Unix.file_descr * bool) job = "lwt_unix_open_job" @@ -1516,7 +1519,13 @@ let shutdown ch shutdown_command = external stub_socketpair : socket_domain -> socket_type -> int -> Unix.file_descr * Unix.file_descr = "lwt_unix_socketpair_stub" let socketpair dom typ proto = +#if OCAML_VERSION >= (4, 05, 0) + let do_socketpair = + if Sys.win32 then stub_socketpair + else Unix.socketpair ?cloexec:None in +#else let do_socketpair = if Sys.win32 then stub_socketpair else Unix.socketpair in +#endif let (s1, s2) = do_socketpair dom typ proto in (mk_ch ~blocking:false s1, mk_ch ~blocking:false s2) diff --git a/src/unix/lwt_unix.mli b/src/unix/lwt_unix.cppo.mli similarity index 99% rename from src/unix/lwt_unix.mli rename to src/unix/lwt_unix.cppo.mli index cbfa23595f..337c1a7b1b 100644 --- a/src/unix/lwt_unix.mli +++ b/src/unix/lwt_unix.cppo.mli @@ -338,6 +338,9 @@ type open_flag = | O_RSYNC | O_SHARE_DELETE | O_CLOEXEC +#if OCAML_VERSION >= (4, 05, 0) + | O_KEEPEXEC +#endif val openfile : string -> open_flag list -> file_perm -> file_descr Lwt.t (** Wrapper for [Unix.openfile]. *) From b5ea8dbf5b6c2629bfb6b4e0fdfe5aac3675f33f Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Tue, 28 Feb 2017 21:01:16 +0100 Subject: [PATCH 02/10] Fix cppo dependency (build predicate). --- lwt.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lwt.opam b/lwt.opam index 215238383a..b7a99524c3 100644 --- a/lwt.opam +++ b/lwt.opam @@ -35,7 +35,7 @@ depends: [ "ocamlfind" {build & >= "1.5.0"} "ocamlbuild" {build} "result" - "cppo" + "cppo" {build} # See https://github.com/ocsigen/lwt/issues/266 ( "base-no-ppx" | "ppx_tools" {build} ) ## OASIS is not required in released version From b3edc4dd761d5b470fec8da968e45a71b44452f4 Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Tue, 28 Feb 2017 21:02:52 +0100 Subject: [PATCH 03/10] Fix oasis build dependency: >= 0.4.8 required. Refer to https://github.com/ocsigen/lwt/pull/322#issuecomment-283141496 --- lwt.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lwt.opam b/lwt.opam index b7a99524c3..8ad7bba451 100644 --- a/lwt.opam +++ b/lwt.opam @@ -39,7 +39,7 @@ depends: [ # See https://github.com/ocsigen/lwt/issues/266 ( "base-no-ppx" | "ppx_tools" {build} ) ## OASIS is not required in released version - "oasis" {build & >= "0.4.7"} + "oasis" {build & >= "0.4.8"} ] depopts: [ "base-threads" From cafaf8ed53cfa1db12a857c2eaa8128ddbad4bc4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 2 Mar 2017 19:04:30 -0600 Subject: [PATCH 04/10] Suppress deprecation warning on Array1.map_file See comment included in the diff for details. --- src/unix/lwt_bytes.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/unix/lwt_bytes.ml b/src/unix/lwt_bytes.ml index 551e0ab4c7..082febb765 100644 --- a/src/unix/lwt_bytes.ml +++ b/src/unix/lwt_bytes.ml @@ -224,6 +224,11 @@ let sendto fd buf pos len flags addr = let map_file ~fd ?pos ~shared ?(size=(-1)) () = Array1.map_file fd ?pos char c_layout shared size + [@@ocaml.warning "-3"] + (* BigArray.Array1.map_file is deprecated in OCaml 4.05; however, the + suggested replacement requires 4.05 (Lwt still supports 4.02). The + replacement also has slighty different exception semantics; see + deprecation warning on BigArray.Array1.map_file. *) [@@@ocaml.warning "-3"] external mapped : t -> bool = "lwt_unix_mapped" "noalloc" From 361fcaae2d37c7dc6ed888e89a996c9152b60584 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Tue, 28 Feb 2017 15:36:21 -0500 Subject: [PATCH 05/10] Travis: test on OCaml 4.05+beta2 [skip appveyor] --- .travis.yml | 2 ++ src/util/travis.sh | 2 ++ 2 files changed, 4 insertions(+) diff --git a/.travis.yml b/.travis.yml index b83b7d2631..12e24bf5d0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,6 +6,8 @@ matrix: env: COMPILER=4.03 - os: linux env: COMPILER=4.04 + - os: linux + env: COMPILER=4.05 - os: linux env: COMPILER=4.04 FLAMBDA=yes - os: linux diff --git a/src/util/travis.sh b/src/util/travis.sh index 3a2202e9a9..3bb4df290f 100644 --- a/src/util/travis.sh +++ b/src/util/travis.sh @@ -9,6 +9,7 @@ packages_apt () { 4.02) PPA=avsm/ocaml42+opam12;; 4.03) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; 4.04) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; + 4.05) PPA=avsm/ocaml42+opam12; DO_SWITCH=yes;; *) echo Unsupported compiler $COMPILER; exit 1;; esac @@ -85,6 +86,7 @@ case $COMPILER in 4.02) OCAML_VERSION=4.02.3;; 4.03) OCAML_VERSION=4.03.0;; 4.04) OCAML_VERSION=4.04.0;; + 4.05) OCAML_VERSION=4.05.0+beta2;; system) OCAML_VERSION=`ocamlc -version`;; *) echo Unsupported compiler $COMPILER; exit 1;; esac From 522e166d1adbe0db03c2f2c8cc2f238aeb5d805a Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Sat, 25 Mar 2017 22:27:00 +0100 Subject: [PATCH 06/10] Ensure Lwt_unix.openfile's flag tables have defined values for O_KEEPEXEC. --- src/unix/lwt_unix_unix.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c index d2ba916f96..c45959d59e 100644 --- a/src/unix/lwt_unix_unix.c +++ b/src/unix/lwt_unix_unix.c @@ -1125,19 +1125,20 @@ static int open_flag_table[] = { O_RSYNC, 0, #ifdef O_CLOEXEC - O_CLOEXEC + O_CLOEXEC, #else #define NEED_CLOEXEC_EMULATION - 0 + 0, #endif + 0 }; #ifdef NEED_CLOEXEC_EMULATION -static int open_cloexec_table[14] = { +static int open_cloexec_table[15] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 + 1, 0 }; #endif From 3999fb8a01f9af3ac8e5548bce90657d5646c038 Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Sat, 25 Mar 2017 22:42:40 +0100 Subject: [PATCH 07/10] Make Lwt_unix.openfile's O_CLOEXEC/O_KEEPEXEC more future-proof. The default close-on-exec behavior for Unix.openfile might change in future OCaml releases, refer to https://github.com/ocaml/ocaml/pull/650 This patch ensures Lwt_unix.openfile's default behavior will match Unix.openfile (and also keep consistency w.r.t. it between Win32 and other platforms). --- src/unix/lwt_unix_unix.c | 43 ++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c index c45959d59e..c6a925998b 100644 --- a/src/unix/lwt_unix_unix.c +++ b/src/unix/lwt_unix_unix.c @@ -26,6 +26,8 @@ #define ARGS(args...) args +#include +#include #include #include #include @@ -1124,29 +1126,24 @@ static int open_flag_table[] = { O_SYNC, O_RSYNC, 0, -#ifdef O_CLOEXEC - O_CLOEXEC, -#else -#define NEED_CLOEXEC_EMULATION - 0, -#endif - 0 + 0, /* O_CLOEXEC, treated specially */ + 0 /* O_KEEPEXEC, treated specially */ }; -#ifdef NEED_CLOEXEC_EMULATION +enum { CLOEXEC = 1, KEEPEXEC = 2 }; + static int open_cloexec_table[15] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1, 0 + CLOEXEC, KEEPEXEC }; -#endif struct job_open { struct lwt_unix_job job; int flags; int perms; - int fd; + int fd; /* will have value CLOEXEC or KEEPEXEC on entry to worker_open */ int blocking; int error_code; char *name; @@ -1156,10 +1153,28 @@ struct job_open { static void worker_open(struct job_open *job) { int fd; + int cloexec; + + if (job->fd & CLOEXEC) + cloexec = 1; + else if (job->fd & KEEPEXEC) + cloexec = 0; + else +#if OCAML_VERSION_MAJOR >= 4 && OCAML_VERSION_MINOR >= 5 + cloexec = unix_cloexec_default; +#else + cloexec = 0; +#endif + +#if !defined(NEED_CLOEXEC_EMULATION) + if (cloexec) job->flags |= O_CLOEXEC; +#endif + fd = open(job->name, job->flags, job->perms); #if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC) - if (fd >= 0 && job->fd) { + if (fd >= 0 && cloexec) { int flags = fcntl(fd, F_GETFD, 0); + if (flags == -1 || fcntl(fd, F_SETFD, flags | FD_CLOEXEC) == -1) { int serrno = errno; @@ -1194,9 +1209,7 @@ static value result_open(struct job_open *job) CAMLprim value lwt_unix_open_job(value name, value flags, value perms) { LWT_UNIX_INIT_JOB_STRING(job, open, 0, name); -#ifdef NEED_CLOEXEC_EMULATION - job->fd = caml_convert_flag_list(flags, open_cloexec_table) != 0; -#endif + job->fd = caml_convert_flag_list(flags, open_cloexec_table); job->flags = caml_convert_flag_list(flags, open_flag_table); job->perms = Int_val(perms); return lwt_unix_alloc_job(&(job->job)); From 70889cff23935d3dcf644aba8730386aa940145d Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Mon, 3 Apr 2017 23:02:45 +0200 Subject: [PATCH 08/10] Unit test Lwt_unix.openfile behavior wrt. O_CLOEXEC and O_KEEPEXEC. --- tests/unix/main.ml | 38 ++++++++++++---- ...test_lwt_unix.ml => test_lwt_unix.cppo.ml} | 43 ++++++++++++++++++- 2 files changed, 72 insertions(+), 9 deletions(-) rename tests/unix/{test_lwt_unix.ml => test_lwt_unix.cppo.ml} (93%) diff --git a/tests/unix/main.ml b/tests/unix/main.ml index 5550dc739b..c648d14011 100644 --- a/tests/unix/main.ml +++ b/tests/unix/main.ml @@ -20,11 +20,33 @@ * 02111-1307, USA. *) -Test.run "unix" [ - Test_lwt_unix.suite; - Test_lwt_io.suite; - Test_lwt_io_non_block.suite; - Test_lwt_process.suite; - Test_lwt_engine.suite; - Test_mcast.suite; -] +let is_fd_open fd_ = + let fd = (Obj.magic (int_of_string fd_) : Unix.file_descr) in + let buf = Bytes.create 42 in + try + ignore (Unix.read fd buf 0 42); + true + with Unix.Unix_error(Unix.EBADF, _, _) -> + false + +let () = + try + assert (not @@ is_fd_open @@ Unix.getenv Test_lwt_unix.assert_fd_closed); + exit 0 + with Not_found -> () + +let () = + try + assert (is_fd_open @@ Unix.getenv Test_lwt_unix.assert_fd_open); + exit 0 + with Not_found -> () + +let () = + Test.run "unix" [ + Test_lwt_unix.suite; + Test_lwt_io.suite; + Test_lwt_io_non_block.suite; + Test_lwt_process.suite; + Test_lwt_engine.suite; + Test_mcast.suite; + ] diff --git a/tests/unix/test_lwt_unix.ml b/tests/unix/test_lwt_unix.cppo.ml similarity index 93% rename from tests/unix/test_lwt_unix.ml rename to tests/unix/test_lwt_unix.cppo.ml index 066b597f54..7b30a08b0b 100644 --- a/tests/unix/test_lwt_unix.ml +++ b/tests/unix/test_lwt_unix.cppo.ml @@ -22,6 +22,46 @@ open Test open Lwt.Infix +let assert_fd_closed = "ASSERT_FD_CLOSED" +let assert_fd_open = "ASSERT_FD_OPEN" + +let test_cloexec assertion flags = + if Sys.win32 then Lwt.return true + else + Lwt_unix.openfile "/dev/zero" (Unix.O_RDONLY :: flags) 0o644 >>= fun fd -> + let fd_ = Lwt_unix.unix_file_descr fd in + match Lwt_unix.fork () with + | 0 -> + Unix.putenv assertion (string_of_int @@ Obj.magic fd_); + (* There's no portable way to obtain the executable name (which + * may even no longer exist at this point), but argv[0] fortunately + * has the right value when the tests are run with "make test". *) + Unix.execv Sys.argv.(0) [||] + | n -> + Lwt_unix.close fd >>= fun () -> + Lwt_unix.waitpid [] n >>= function + | _, Unix.WEXITED 0 -> Lwt.return_true + | _ -> Lwt.return_false + +let openfile_tests = [ + test "openfile: O_CLOEXEC" + (fun () -> test_cloexec assert_fd_closed [Unix.O_CLOEXEC]); + + test "openfile: O_CLOEXEC not given" + (fun () -> test_cloexec assert_fd_open []); + +#if OCAML_VERSION >= (4, 05, 0) + test "openfile: O_KEEPEXEC" + (fun () -> test_cloexec assert_fd_open [Unix.O_KEEPEXEC]); + + test "openfile: O_CLOEXEC, O_KEEPEXEC" + (fun () -> test_cloexec assert_fd_closed [Unix.O_CLOEXEC; Unix.O_KEEPEXEC]); + + test "openfile: O_KEEPEXEC, O_CLOEXEC" + (fun () -> test_cloexec assert_fd_closed [Unix.O_KEEPEXEC; Unix.O_CLOEXEC]); +#endif +] + let utimes_tests = [ test "utimes: basic" (fun () -> @@ -638,7 +678,8 @@ let bind_tests = [ let suite = suite "lwt_unix" - (utimes_tests @ + (openfile_tests @ + utimes_tests @ readdir_tests @ readv_tests @ writev_tests @ From 44ca04bbcb371b018a88c3fd62c8d427edf84077 Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Mon, 3 Apr 2017 23:11:43 +0200 Subject: [PATCH 09/10] Fix O_CLOEXEC emulation in Lwt_unix.openfile. --- src/unix/lwt_unix_unix.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/unix/lwt_unix_unix.c b/src/unix/lwt_unix_unix.c index c6a925998b..6590a82e6f 100644 --- a/src/unix/lwt_unix_unix.c +++ b/src/unix/lwt_unix_unix.c @@ -1166,12 +1166,12 @@ static void worker_open(struct job_open *job) cloexec = 0; #endif -#if !defined(NEED_CLOEXEC_EMULATION) +#if defined(O_CLOEXEC) if (cloexec) job->flags |= O_CLOEXEC; #endif fd = open(job->name, job->flags, job->perms); -#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC) +#if !defined(O_CLOEXEC) && defined(FD_CLOEXEC) if (fd >= 0 && cloexec) { int flags = fcntl(fd, F_GETFD, 0); From c7bc81325c1f2b01aefe72d36b0b93ba2c76fa8e Mon Sep 17 00:00:00 2001 From: Mauricio Fernandez Date: Tue, 4 Apr 2017 00:00:34 +0200 Subject: [PATCH 10/10] Prevent warning 4 in Lwt_unix.openfile tests. --- tests/unix/test_lwt_unix.cppo.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/unix/test_lwt_unix.cppo.ml b/tests/unix/test_lwt_unix.cppo.ml index 7b30a08b0b..48d1f0d97e 100644 --- a/tests/unix/test_lwt_unix.cppo.ml +++ b/tests/unix/test_lwt_unix.cppo.ml @@ -41,7 +41,8 @@ let test_cloexec assertion flags = Lwt_unix.close fd >>= fun () -> Lwt_unix.waitpid [] n >>= function | _, Unix.WEXITED 0 -> Lwt.return_true - | _ -> Lwt.return_false + | _, (Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _) -> + Lwt.return_false let openfile_tests = [ test "openfile: O_CLOEXEC"