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.

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)
 

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

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

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

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
+

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

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

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

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

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

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:  $*"
+

testsuite/tests/lib-unix/unix-execvpe/subdir/nonexec

@@ -0,0 +1,2 @@
+echo "This script lacks the x bit and should not run!"
+

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:  $*"

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:  $*"