Merge pull request #957 from MisterDA/cloexec-proc-dev-null-fixes

Fix null file descriptor being closed when used as redirection for standard fd of child processes

CHANGES

@@ -1,5 +1,9 @@
 ===== dev =====
 
+====== Fixes ======
+
+  *  Fix null file descriptor being closed when used as redirection for standard fd of child processes. (#957, Antonin Décimo) 
+
 ===== 5.6.0 =====
 
 ====== Installability ======

src/unix/lwt_process.cppo.ml

@@ -36,7 +36,7 @@ let win32_get_fd fd redirection =
   | `Keep ->
     Some fd
   | `Dev_null ->
-    Some (Unix.openfile "nul" [Unix.O_RDWR; Unix.O_CLOEXEC] 0o666)
+    Some (Unix.openfile "nul" [Unix.O_RDWR; Unix.O_KEEPEXEC] 0o666)
   | `Close ->
     None
   | `FD_copy fd' ->
@@ -122,18 +122,15 @@ let unix_redirect fd redirection = match redirection with
   | `Keep ->
     ()
   | `Dev_null ->
-    Unix.close fd;
-    let dev_null = Unix.openfile "/dev/null" [Unix.O_RDWR; Unix.O_CLOEXEC] 0o666 in
-    if fd <> dev_null then begin
-      Unix.dup2 dev_null fd;
-      Unix.close dev_null
-    end
+    let dev_null = Unix.openfile "/dev/null" [Unix.O_RDWR; Unix.O_KEEPEXEC] 0o666 in
+    Unix.dup2 ~cloexec:false dev_null fd;
+    Unix.close dev_null
   | `Close ->
     Unix.close fd
   | `FD_copy fd' ->
-    Unix.dup2 fd' fd
+    Unix.dup2 ~cloexec:false fd' fd
   | `FD_move fd' ->
-    Unix.dup2 fd' fd;
+    Unix.dup2 ~cloexec:false fd' fd;
     Unix.close fd'
 
 #if OCAML_VERSION >= (5, 0, 0)

test/unix/dummy.ml

@@ -1,6 +1,31 @@
+(* This file is part of Lwt, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
+
+
+
+let test_input_str = "the quick brown fox jumps over the lazy dog"
+let test_input = Bytes.of_string test_input_str
+let test_input_len = Bytes.length test_input
+
+let read () =
+  let buf = Bytes.create test_input_len in
+  let rec aux n =
+    let i = Unix.read Unix.stdin buf n (Bytes.length buf - n) in
+    if i = 0 || n + i = test_input_len then
+      Bytes.equal buf test_input
+    else aux (n + i)
+  in
+  if aux 0 then
+    (* make sure there's nothing more to read *)
+    0 = Unix.read Unix.stdin buf 0 1
+  else false
+
+let write fd =
+  assert (test_input_len = Unix.write fd test_input 0 test_input_len)
+
 let () =
-  let str = "the quick brown fox jumps over the lazy dog" in
   match Sys.argv.(1) with
-  | "read" -> if read_line () <> str then exit 1
-  | "write" -> print_string str
+  | "read" -> exit @@ if read () then 0 else 1
+  | "write" -> write Unix.stdout
+  | "errwrite" -> write Unix.stderr
   | _ -> invalid_arg "Sys.argv"

test/unix/dune

@@ -5,7 +5,8 @@
 
 (executable
  (name dummy)
- (modules dummy))
+ (modules dummy)
+ (libraries unix))
 
 (executable
  (name main)

test/unix/test_lwt_process.ml

@@ -6,7 +6,52 @@
 open Test
 open Lwt.Infix
 
-let expected = "the quick brown fox jumps over the lazy dog"
+let expected_str = "the quick brown fox jumps over the lazy dog"
+let expected = Bytes.of_string expected_str
+let expected_len = Bytes.length expected
+
+let check_status ?(status=(=) 0) = function
+  | Unix.WEXITED n when status n -> Lwt.return_true
+  | Unix.WEXITED n ->
+    Printf.eprintf "exited with code %d" n;
+    Lwt.return_false
+  | Unix.WSIGNALED x ->
+    Printf.eprintf "failed with signal %d" x;
+    Lwt.return_false
+  | Unix.WSTOPPED x ->
+    Printf.eprintf "stopped with signal %d" x;
+    Lwt.return_false
+
+let pwrite ~stdin pout =
+  let args = [|"dummy.exe"; "read"|] in
+  let proc = Lwt_process.exec ~stdin ("./dummy.exe", args) in
+  let write = Lwt.finalize
+                (fun () -> Lwt_unix.write pout expected 0 expected_len)
+                (fun () -> Lwt_unix.close pout) in
+  proc >>= fun r ->
+  write >>= fun n ->
+  assert (n = expected_len);
+  check_status r
+
+let pread ?stdout ?stderr pin =
+  let buf = Bytes.create expected_len in
+  let proc = match stdout, stderr with
+    | Some stdout, None ->
+       let args = [|"dummy.exe"; "write"|] in
+       Lwt_process.exec ~stdout ("./dummy.exe", args)
+    | None, Some stderr ->
+       let args = [|"dummy.exe"; "errwrite"|] in
+       Lwt_process.exec ~stderr ("./dummy.exe", args)
+    | _ -> assert false
+  in
+  let read = Lwt_unix.read pin buf 0 expected_len in
+  proc >>= fun r ->
+  read >>= fun n ->
+  assert (n = expected_len);
+  assert (Bytes.equal buf expected);
+  Lwt_unix.read pin buf 0 1 >>= fun n ->
+  assert (n = 0);
+  check_status r
 
 let suite = suite "lwt_process" [
   (* The sleep command is not available on Win32. *)
@@ -20,42 +65,43 @@ let suite = suite "lwt_process" [
               (fun _ -> Lwt.return ""))
         >>= fun _ -> Lwt.return_true);
 
-  test "pread"
+  test "subproc stdout can be redirected to null"
     (fun () ->
       let args = [|"dummy.exe"; "write"|] in
-      Lwt_process.pread ~stdin:`Close ~stderr:`Close ("./dummy.exe", args)
-      >|= fun actual ->
-      actual = expected);
+      Lwt_process.exec ~stdout:`Dev_null ("./dummy.exe", args)
+      >>= check_status);
 
-  test "pread keep"
+  test "subproc stderr can be redirected to null"
     (fun () ->
-      let args = [|"dummy.exe"; "write"|] in
-      Lwt_process.pread ~stdin:`Keep ~stderr:`Keep ("./dummy.exe", args)
-      >|= fun actual ->
-      actual = expected);
+      let args = [|"dummy.exe"; "errwrite"|] in
+      Lwt_process.exec ~stderr:`Dev_null ("./dummy.exe", args)
+      >>= check_status);
 
-  test "pread nul"
+  test "subproc cannot write on closed stdout"
     (fun () ->
       let args = [|"dummy.exe"; "write"|] in
-      Lwt_process.pread ~stdin:`Dev_null ~stderr:`Dev_null ("./dummy.exe", args)
-      >|= fun actual ->
-      actual = expected);
+      let stderr = `Dev_null    (* mask subproc stderr *) in
+      Lwt_process.exec ~stdout:`Close ~stderr ("./dummy.exe", args)
+      >>= check_status ~status:((<>) 0));
+
+  test "subproc cannot write on closed stderr"
+    (fun () ->
+      let args = [|"dummy.exe"; "errwrite"|] in
+      Lwt_process.exec ~stderr:`Close ("./dummy.exe", args)
+      >>= check_status ~status:((<>) 0));
 
-  test "pwrite"
+  test "can write to subproc stdin"
     (fun () ->
-      let args = [|"dummy.exe"; "read"|] in
-      Lwt_process.pwrite ~stdout:`Close ~stderr:`Close ("./dummy.exe", args) expected
-      >>= fun () -> Lwt.return_true);
+      let pin, pout = Lwt_unix.pipe_out ~cloexec:true () in
+      pwrite ~stdin:(`FD_move pin) pout);
 
-  test "pwrite keep"
+  test "can read from subproc stdout"
     (fun () ->
-      let args = [|"dummy.exe"; "read"|] in
-      Lwt_process.pwrite ~stdout:`Keep ~stderr:`Keep ("./dummy.exe", args) expected
-      >>= fun () -> Lwt.return_true);
+      let pin, pout = Lwt_unix.pipe_in ~cloexec:true () in
+      pread ~stdout:(`FD_move pout) pin);
 
-  test "pwrite nul"
+  test "can read from subproc stderr"
     (fun () ->
-      let args = [|"dummy.exe"; "read"|] in
-      Lwt_process.pwrite ~stdout:`Dev_null ~stderr:`Dev_null ("./dummy.exe", args) expected
-      >>= fun () -> Lwt.return_true);
+      let pin, perr = Lwt_unix.pipe_in ~cloexec:true () in
+      pread ~stderr:(`FD_move perr) pin);
 ]