MPR#7640: reimplementation of Unix.execvpe (#1414)

Use the system-provided execvpe() if possible.  Otherwise, use
a serious reimplementation written in OCaml and patterned after
the Glibc execvpe() implementation.

Added a test in tests/lib-unix/unix-execvpe.

Don't test Unix.execvpe if we are using the system-provided implementation.
The execvpe() functions provided by Win32 and Cygwin aren't quite to
our specs.  At any rate, the test is there to find bugs in our
implementation of execvpe(), not in others's.

14 files changed, 203 insertions, 7 deletions

diff --git a/Changes b/Changes
index d097956952..5c62522e0f 100644
--- a/Changes
+++ b/Changes
@@ -686,6 +686,13 @@ Release branch for 4.06:
   This looks like a Mingw64 issue, which we work around with GCC builtins.
   (Xavier Leroy)
 
+* MPR#7640, GPR#1414: reimplementation of Unix.execvpe to fix issues
+  with the 4.05 implementation.  The main issue is that the current
+  directory was always searched (last), even if the current directory
+  is not listed in the PATH.
+  (Xavier Leroy, report by Mantis users 'AltGr' and 'aalekseyev',
+   review by Ivan Gotovchits)
+
 - GPR#1155: Fix a race condition with WAIT_NOHANG on Windows
   (Jérémie Dimino and David Allsopp)
 
diff --git a/byterun/caml/misc.h b/byterun/caml/misc.h
index 5666f93345..7b2179debc 100644
--- a/byterun/caml/misc.h
+++ b/byterun/caml/misc.h
@@ -188,6 +188,7 @@ typedef wchar_t char_os;
 #define execv_os _wexecv
 #define execve_os _wexecve
 #define execvp_os _wexecvp
+#define execvpe_os _wexecvpe
 #define strcmp_os wcscmp
 #define strlen_os wcslen
 #define sscanf_os swscanf
@@ -220,6 +221,7 @@ typedef char char_os;
 #define execv_os execv
 #define execve_os execve
 #define execvp_os execvp
+#define execvpe_os execvpe
 #define strcmp_os strcmp
 #define strlen_os strlen
 #define sscanf_os sscanf
diff --git a/config/s-nt.h b/config/s-nt.h
index 8c28dc5ef3..c8de2cabec 100644
--- a/config/s-nt.h
+++ b/config/s-nt.h
@@ -34,6 +34,7 @@
 #define HAS_IPV6
 #define HAS_NICE
 #define SUPPORT_DYNAMIC_LINKING
+#define HAS_EXECVPE
 #if defined(_MSC_VER) && _MSC_VER < 1300
 #define LACKS_SANE_NAN
 #define LACKS_VSCPRINTF
diff --git a/configure b/configure
index abfd1bbc4b..ebc71ed329 100755
--- a/configure
+++ b/configure
@@ -1576,6 +1576,11 @@ if sh ./hasgot -i sys/shm.h; then
   echo "#define HAS_SYS_SHM_H" >> s.h
 fi
 
+if sh ./hasgot execvpe; then
+  inf "execvpe() found."
+  echo "#define HAS_EXECVPE" >> s.h
+fi
+
 # Determine if the debugger is supported
 
 if test -n "$with_debugger"; then
diff --git a/otherlibs/unix/execvp.c b/otherlibs/unix/execvp.c
index e751f176ab..1eb4316498 100644
--- a/otherlibs/unix/execvp.c
+++ b/otherlibs/unix/execvp.c
@@ -13,11 +13,13 @@
 /*                                                                        */
 /**************************************************************************/
 
+#define _GNU_SOURCE  /* helps to find execvpe() */
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
 #define CAML_INTERNALS
 #include <caml/osdeps.h>
 #include "unixsupport.h"
+#include "errno.h"
 
 CAMLprim value unix_execvp(value path, value args)
 {
@@ -34,22 +36,33 @@ CAMLprim value unix_execvp(value path, value args)
                                     /* from smart compilers */
 }
 
+#ifdef HAS_EXECVPE
+
 CAMLprim value unix_execvpe(value path, value args, value env)
 {
-  char_os * exefile, * wpath;
   char_os ** argv;
   char_os ** envp;
+  char_os * wpath;
   caml_unix_check_path(path, "execvpe");
-  wpath = caml_stat_strdup_to_os(String_val(path));
-  exefile = caml_search_exe_in_path(wpath);
-  caml_stat_free(wpath);
   argv = cstringvect(args, "execvpe");
   envp = cstringvect(env, "execvpe");
-  (void) execve_os((const char_os *)exefile, EXECV_CAST argv, EXECV_CAST envp);
-  caml_stat_free(exefile);
+  wpath = caml_stat_strdup_to_os(String_val(path));
+  (void) execvpe_os((const char_os *)wpath, EXECV_CAST argv, EXECV_CAST envp);
+  caml_stat_free(wpath);
   cstringvect_free(argv);
   cstringvect_free(envp);
   uerror("execvpe", path);
   return Val_unit;                  /* never reached, but suppress warnings */
                                     /* from smart compilers */
 }
+
+#else
+
+CAMLprim value unix_execvpe(value path, value args, value env)
+{
+  unix_error(ENOSYS, "execvpe", path);
+  return Val_unit;
+}
+
+#endif
+
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml
index 9d7e00ca00..77a48d1f8b 100644
--- a/otherlibs/unix/unix.ml
+++ b/otherlibs/unix/unix.ml
@@ -203,7 +203,68 @@ type wait_flag =
 external execv : string -> string array -> 'a = "unix_execv"
 external execve : string -> string array -> string array -> 'a = "unix_execve"
 external execvp : string -> string array -> 'a = "unix_execvp"
-external execvpe : string -> string array -> string array -> 'a = "unix_execvpe"
+external execvpe_c :
+            string -> string array -> string array -> 'a = "unix_execvpe"
+
+let execvpe_ml name args env =
+  (* Try to execute the given file *)
+  let exec file =
+    try
+      execve file args env
+    with Unix_error(ENOEXEC, _, _) ->
+      (* Assume this is a script and try to execute through the shell *)
+      let argc = Array.length args in
+      (* Drop the original args.(0) if it is there *)
+      let new_args = Array.append
+        [| "/bin/sh"; file |]
+        (if argc = 0 then args else Array.sub args 1 (argc - 1)) in
+      execve new_args.(0) new_args env in
+  (* Try each path element in turn *)
+  let rec scan_dir eacces = function
+  | [] ->
+      (* No matching file was found (if [eacces = false]) or
+         a matching file was found but we got a "permission denied"
+         error while trying to execute it (if [eacces = true]).
+         Raise the error appropriate to each case. *)
+      raise (Unix_error((if eacces then EACCES else ENOENT),
+                        "execvpe", name))
+  | dir :: rem ->
+      let dir =  (* an empty path element means the current directory *)
+        if dir = "" then Filename.current_dir_name else dir in
+      try
+        exec (Filename.concat dir name)
+      with Unix_error(err, _, _) as exn ->
+        match err with
+        (* The following errors are treated as nonfatal, meaning that
+           we will ignore them and continue searching in the path.
+           Among those errors, EACCES is recorded specially so as
+           to produce the correct exception in the end.
+           To determine which errors are nonfatal, we looked at the
+           execvpe() sources in Glibc and in OpenBSD. *)
+        | EACCES ->
+            scan_dir true rem
+        | EISDIR|ELOOP|ENAMETOOLONG|ENODEV|ENOENT|ENOTDIR|ETIMEDOUT ->
+            scan_dir eacces rem
+        (* Other errors, e.g. E2BIG, are fatal and abort the search. *)
+        | _ ->
+            raise exn in
+  if String.contains name '/' then
+    (* If the command name contains "/" characters, don't search in path *)
+    exec name
+  else
+    (* Split path into elements and search in these elements *)
+    (try unsafe_getenv "PATH" with Not_found -> "/bin:/usr/bin")
+    |> String.split_on_char ':'
+    |> scan_dir false
+      (* [unsafe_getenv] and not [getenv] to be consistent with [execvp],
+         which looks up the PATH environment variable whether SUID or not. *)
+
+let execvpe name args env =
+  try  
+    execvpe_c name args env
+  with Unix_error(ENOSYS, _, _) ->
+    execvpe_ml name args env
+
 external fork : unit -> int = "unix_fork"
 external wait : unit -> int * process_status = "unix_wait"
 external waitpid : wait_flag list -> int -> int * process_status
diff --git a/testsuite/tests/lib-unix/unix-execvpe/Makefile b/testsuite/tests/lib-unix/unix-execvpe/Makefile
new file mode 100644
index 0000000000..91fbaa83c3
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/Makefile
@@ -0,0 +1,32 @@
+BASEDIR=../../..
+LIBRARIES=unix
+ADD_COMPFLAGS=-I $(OTOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+LD_PATH=$(TOPDIR)/otherlibs/$(UNIXLIBVAR)unix
+MAIN_MODULE=exec
+
+test:
+	@if grep -q HAS_EXECVPE $(OTOPDIR)/byterun/caml/s.h; \
+        then echo " ... testing => skipped (using the system-provided execvpe())"; \
+        else $(MAKE) compile && $(SET_LD_PATH) $(MAKE) myrun; \
+        fi
+
+myrun:
+	@printf " ... testing with"
+	@if $(NATIVECODE_ONLY); then : ; else \
+	   printf " ocamlc"; \
+	   ./exec.run "$(MYRUNTIME) ./program.byte$(EXE)" $(EXEC_ARGS) \
+	                >$(MAIN_MODULE).result \
+	   && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \
+	      >/dev/null; \
+	 fi \
+	&& if $(BYTECODE_ONLY); then : ; else \
+	     printf " ocamlopt"; \
+	     ./exec.run ./program.native$(EXE) $(EXEC_ARGS) \
+	                             > $(MAIN_MODULE).result \
+	     && $(DIFF) $(MAIN_MODULE).reference $(MAIN_MODULE).result \
+	                >/dev/null; \
+	   fi \
+	&& echo " => passed" || echo " => failed"
+
+include $(BASEDIR)/makefiles/Makefile.one
+include $(BASEDIR)/makefiles/Makefile.common
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.ml b/testsuite/tests/lib-unix/unix-execvpe/exec.ml
new file mode 100644
index 0000000000..8eb623201a
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.ml
@@ -0,0 +1,15 @@
+open Printf
+
+let _ =
+  let arg = Array.sub Sys.argv 1 (Array.length Sys.argv - 1) in
+  let env = Array.append [|"FOO=foo"|] (Unix.environment()) in
+  try
+    Unix.execvpe arg.(0) arg env
+  with
+  | Unix.Unix_error(Unix.ENOENT, _, arg) ->
+      eprintf "No such file %s\n" arg; exit 2
+  | Unix.Unix_error(Unix.EACCES, _, arg) ->
+      eprintf "Permission denied %s\n" arg; exit 2
+  | Unix.Unix_error(err, fn, arg) ->
+      eprintf "Other error %s - %s - %s\n" (Unix.error_message err) fn arg;
+      exit 4
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.reference b/testsuite/tests/lib-unix/unix-execvpe/exec.reference
new file mode 100644
index 0000000000..b8c8bb4b2c
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.reference
@@ -0,0 +1,19 @@
+## Test 1: a binary program in the path
+## Test 2: a #! script in the path
+--- subdir/script1
+FOO is foo, BAR is bar, BUZ is 
+3 arguments:  2 3 4
+## Test 3: a script without #! in the path
+--- subdir/script2
+FOO is foo, BAR is bar, BUZ is 
+3 arguments:  5 6 7
+## Test 4: a script in the current directory
+--- ./script3
+FOO is foo, BAR is bar, BUZ is 
+2 arguments:  8 9
+## Test 5: a non-existent program
+No such file nosuchprogram
+## Test 6: a non-executable program
+Permission denied nonexec
+## Test 7: a script in the current directory
+No such file script3
diff --git a/testsuite/tests/lib-unix/unix-execvpe/exec.run b/testsuite/tests/lib-unix/unix-execvpe/exec.run
new file mode 100755
index 0000000000..86f8eb8608
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/exec.run
@@ -0,0 +1,27 @@
+#!/bin/sh
+
+program=$1
+if test -z "$program"; then echo "Usage: exec.run <program>" 1&>2; exit 2; fi
+
+exec 2>&1
+
+export PATH="/bin:/usr/bin:./subdir:"
+export BAR=bar
+
+echo "## Test 1: a binary program in the path"
+$program ls / > /dev/null || echo "ls failed"
+echo "## Test 2: a #! script in the path"
+$program script1 2 3 4 || echo "script1 failed"
+echo "## Test 3: a script without #! in the path"
+$program script2 5 6 7 || echo "script2 failed"
+echo "## Test 4: a script in the current directory"
+$program script3 8 9 || echo "script3 failed"
+echo "## Test 5: a non-existent program"
+$program nosuchprogram
+echo "## Test 6: a non-executable program"
+$program nonexec
+
+export PATH="/bin:/usr/bin:./subdir"
+echo "## Test 7: a script in the current directory"
+$program script3 9 && echo "script3 should have failed"
+exit 0
diff --git a/testsuite/tests/lib-unix/unix-execvpe/script3 b/testsuite/tests/lib-unix/unix-execvpe/script3
new file mode 100755
index 0000000000..931aac385f
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/script3
@@ -0,0 +1,5 @@
+#!/bin/sh
+echo "--- ./script3"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"
+
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec b/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec
new file mode 100644
index 0000000000..b76ada7b15
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec
@@ -0,0 +1,2 @@
+echo "This script lacks the x bit and should not run!"
+
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/script1 b/testsuite/tests/lib-unix/unix-execvpe/subdir/script1
new file mode 100755
index 0000000000..e59ab0aea4
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/script1
@@ -0,0 +1,4 @@
+#!/bin/sh
+echo "--- subdir/script1"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"
diff --git a/testsuite/tests/lib-unix/unix-execvpe/subdir/script2 b/testsuite/tests/lib-unix/unix-execvpe/subdir/script2
new file mode 100755
index 0000000000..8345744984
--- /dev/null
+++ b/testsuite/tests/lib-unix/unix-execvpe/subdir/script2
@@ -0,0 +1,3 @@
+echo "--- subdir/script2"
+echo "FOO is $FOO, BAR is $BAR, BUZ is $BUZ"
+echo "$# arguments:  $*"