Fix Unix.create_process in the case where the same descriptor is used several times

As reported in GPR#1105, the current implementation (from commit ab4e3be) fails if the same descriptor is passed several times to Unix.create_process, e.g. as the new stdout and the new stderr (a la 2>&1 shell redirection).

This is a tentative, simple fix, lighter than the 4.04 implementation and the GPR#1105 proposed implementation.  A test was added.

1 files changed, 14 insertions, 3 deletions

diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index add8d95505..28345b3234 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -874,11 +874,18 @@ let system cmd =
           end
   | id -> snd(waitpid_non_intr id)
 
+let safe_close fd =
+  try close fd with Unix_error(_,_,_) -> ()
+
 (* Make sure [fd] is not one of the standard descriptors 0, 1, 2,
    by duplicating it if needed. *)
 
 let rec file_descr_not_standard fd =
   if fd >= 3 then fd else begin
+    (* In [dup] below the "cloexec" mode doesn't matter, because
+       the descriptor returned by [dup] will be closed before the [exec],
+       and because no other thread is running concurrently
+       (we are in the child process of a fork).  *)
     let res = file_descr_not_standard (dup fd) in
     close fd;
     res
@@ -888,9 +895,13 @@ let perform_redirections new_stdin new_stdout new_stderr =
   let new_stdin = file_descr_not_standard new_stdin in
   let new_stdout = file_descr_not_standard new_stdout in
   let new_stderr = file_descr_not_standard new_stderr in
-  dup2 ~cloexec:false new_stdin stdin; close new_stdin;
-  dup2 ~cloexec:false new_stdout stdout; close new_stdout;
-  dup2 ~cloexec:false new_stderr stderr; close new_stderr
+  dup2 ~cloexec:false new_stdin stdin;
+  dup2 ~cloexec:false new_stdout stdout;
+  dup2 ~cloexec:false new_stderr stderr;
+  (* GPR#1105: close after the three dup2, and safe_close instead of close,
+     because several of new_stdin, new_stdout and new_stderr
+     can be the same descriptor. *)
+  safe_close new_stdin; safe_close new_stdout; safe_close new_stderr
 
 let create_process cmd args new_stdin new_stdout new_stderr =
   match fork() with