Merge pull request #322 from ocsigen/lwt_unix+4.05-compat

Use conditional compilation for Lwt_unix + OCaml 4.05 compat (O_KEEPEXEC)

.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

_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:

_tags

@@ -1,6 +1,10 @@
 # -*- conf -*-
 not <src/ssl/*>: 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.
 <src/camlp4/*.ml> or <src/ppx/*.ml>: warn(-4)

lwt.opam

@@ -35,10 +35,11 @@ depends: [
   "ocamlfind" {build & >= "1.5.0"}
   "ocamlbuild" {build}
   "result"
+  "cppo" {build}
   # 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"

myocamlbuild.ml

@@ -91,6 +91,8 @@ let () = dispatch begin fun hook ->
       ()
   in
 
+  Ocamlbuild_cppo.dispatcher hook;
+
   dispatch_default hook;
 
   match hook with

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"

src/unix/lwt_unix.ml → 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)
 

src/unix/lwt_unix.mli → 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]. *)

src/unix/lwt_unix_unix.c

@@ -26,6 +26,8 @@
 
 #define ARGS(args...) args
 
+#include <caml/version.h>
+#include <caml/unixsupport.h>
 #include <sys/uio.h>
 #include <sys/un.h>
 #include <sys/time.h>
@@ -1124,28 +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, /* O_CLOEXEC, treated specially */
+  0  /* O_KEEPEXEC, treated specially */
 };
 
-#ifdef NEED_CLOEXEC_EMULATION
-static int open_cloexec_table[14] = {
+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
+  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;
@@ -1155,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(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 (fd >= 0 && job->fd) {
+#if !defined(O_CLOEXEC) && defined(FD_CLOEXEC)
+  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;
@@ -1193,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));

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

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;
+  ]

tests/unix/test_lwt_unix.ml → tests/unix/test_lwt_unix.cppo.ml

@@ -22,6 +22,47 @@
 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
+            | _, (Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
+                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 +679,8 @@ let bind_tests = [
 
 let suite =
   suite "lwt_unix"
-    (utimes_tests @
+    (openfile_tests @
+     utimes_tests @
      readdir_tests @
      readv_tests @
      writev_tests @