cherry-pick the fix for MPR#7557 from 4.04

Changes

@@ -846,6 +846,20 @@ The complete list of changes is listed below.
 
 Next minor version (4.04.1):
 ----------------------------
+OCaml 4.04.2 (23 Jun 2017):
+---------------------------
+
+### Security fix:
+
+- PR#7557: Local privilege escalation issue with ocaml binaries.
+  (Damien Doligez, report by Eric Milliken, review by Xavier Leroy)
+
+OCaml 4.04.1 (14 Apr 2017):
+---------------------------
+
+- PR#7501, GPR#1089: Consider arrays of length zero as constants
+  when using Flambda.
+  (Pierre Chambart, review by Mark Shinwell and Leo White)
 
 ### Standard library:
 

VERSION

@@ -1,4 +1,4 @@
-4.06.0+dev0-2017-02-15
+4.06.0+dev1-2017-06-23
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli

asmrun/spacetime.c

@@ -38,6 +38,7 @@
 #include "caml/minor_gc.h"
 #include "caml/misc.h"
 #include "caml/mlvalues.h"
+#include "caml/osdeps.h"
 #include "caml/roots.h"
 #include "caml/signals.h"
 #include "caml/stack.h"
@@ -221,7 +222,7 @@ void caml_spacetime_initialize(void)
       int dir_ok = 1;
 
       user_specified_automatic_snapshot_dir =
-        getenv("OCAML_SPACETIME_SNAPSHOT_DIR");
+        caml_secure_getenv("OCAML_SPACETIME_SNAPSHOT_DIR");
 
       if (user_specified_automatic_snapshot_dir == NULL) {
 #ifdef HAS_GETCWD

byterun/caml/osdeps.h

@@ -86,6 +86,11 @@ extern int caml_read_directory(char * dirname, struct ext_table * contents);
    string allocated with [caml_stat_alloc] on success. */
 extern char * caml_executable_name(void);
 
+/* Secure version of [getenv]: returns NULL if the process has special
+   privileges (setuid bit or capabilities).
+*/
+extern char *caml_secure_getenv(char const *var);
+
 #endif /* CAML_INTERNALS */
 
 #endif /* CAML_OSDEPS_H */

byterun/debugger.c

@@ -27,6 +27,7 @@
 #include "caml/config.h"
 #include "caml/debugger.h"
 #include "caml/misc.h"
+#include "caml/osdeps.h"
 
 int caml_debugger_in_use = 0;
 uintnat caml_event_count;
@@ -172,7 +173,7 @@ void caml_debugger_init(void)
   Store_field(marshal_flags, 0, Val_int(1)); /* Marshal.Closures */
   Store_field(marshal_flags, 1, Val_emptylist);
 
-  address = getenv("CAML_DEBUG_SOCKET");
+  address = caml_secure_getenv("CAML_DEBUG_SOCKET");
   if (address == NULL) return;
   dbg_addr = address;
 

byterun/dynlink.c

@@ -81,8 +81,8 @@ static char * parse_ld_conf(void)
   struct stat st;
   int ldconf, nread;
 
-  stdlib = getenv("OCAMLLIB");
-  if (stdlib == NULL) stdlib = getenv("CAMLLIB");
+  stdlib = caml_secure_getenv("OCAMLLIB");
+  if (stdlib == NULL) stdlib = caml_secure_getenv("CAMLLIB");
   if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
   ldconfname = caml_stat_strconcat(3, stdlib, "/", LD_CONF_NAME);
   if (stat(ldconfname, &st) == -1) {
@@ -150,7 +150,7 @@ void caml_build_primitive_table(char * lib_path,
      - directories specified in the executable
      - directories specified in the file <stdlib>/ld.conf */
   tofree1 = caml_decompose_path(&caml_shared_libs_path,
-                                getenv("CAML_LD_LIBRARY_PATH"));
+                                caml_secure_getenv("CAML_LD_LIBRARY_PATH"));
   if (lib_path != NULL)
     for (p = lib_path; *p != 0; p += strlen(p) + 1)
       caml_ext_table_add(&caml_shared_libs_path, p);

byterun/misc.c

@@ -20,6 +20,7 @@
 #include "caml/config.h"
 #include "caml/misc.h"
 #include "caml/memory.h"
+#include "caml/osdeps.h"
 #include "caml/version.h"
 
 caml_timing_hook caml_major_slice_begin_hook = NULL;
@@ -223,7 +224,7 @@ void CAML_INSTR_ATEXIT (void)
   FILE *f = NULL;
   char *fname;
 
-  fname = getenv ("OCAML_INSTR_FILE");
+  fname = caml_secure_getenv ("OCAML_INSTR_FILE");
   if (fname != NULL){
     char *mode = "a";
     char buf [1000];

byterun/startup.c

@@ -381,7 +381,7 @@ CAMLexport void caml_main(char **argv)
   caml_sys_init(exe_name, argv + pos);
 #ifdef _WIN32
   /* Start a thread to handle signals */
-  if (getenv("CAMLSIGPIPE"))
+  if (caml_secure_getenv("CAMLSIGPIPE"))
     _beginthread(caml_signal_thread, 4096, NULL);
 #endif
   /* Execute the program */
@@ -428,7 +428,7 @@ CAMLexport value caml_startup_code_exn(
   caml_install_invalid_parameter_handler();
 #endif
   caml_init_custom_operations();
-  cds_file = getenv("CAML_DEBUG_FILE");
+  cds_file = caml_secure_getenv("CAML_DEBUG_FILE");
   if (cds_file != NULL) {
     caml_cds_file = caml_stat_strdup(cds_file);
   }

byterun/startup_aux.c

@@ -26,6 +26,7 @@
 #ifndef NATIVE_CODE
 #include "caml/dynlink.h"
 #endif
+#include "caml/osdeps.h"
 #include "caml/startup_aux.h"
 
 
@@ -79,10 +80,10 @@ static void scanmult (char *opt, uintnat *var)
 
 void caml_parse_ocamlrunparam(void)
 {
-  char *opt = getenv ("OCAMLRUNPARAM");
+  char *opt = caml_secure_getenv ("OCAMLRUNPARAM");
   uintnat p;
 
-  if (opt == NULL) opt = getenv ("CAMLRUNPARAM");
+  if (opt == NULL) opt = caml_secure_getenv ("CAMLRUNPARAM");
 
   if (opt != NULL){
     while (*opt != '\0'){

byterun/sys.c

@@ -26,7 +26,7 @@
 #include <time.h>
 #include <sys/types.h>
 #include <sys/stat.h>
-#if _WIN32
+#ifdef _WIN32
 #include <io.h> /* for isatty */
 #else
 #include <sys/wait.h>
@@ -318,7 +318,7 @@ CAMLprim value caml_sys_getcwd(value unit)
   return caml_copy_string(buff);
 }
 
-CAMLprim value caml_sys_getenv(value var)
+CAMLprim value caml_sys_unsafe_getenv(value var)
 {
   char * res;
 
@@ -328,6 +328,16 @@ CAMLprim value caml_sys_getenv(value var)
   return caml_copy_string(res);
 }
 
+CAMLprim value caml_sys_getenv(value var)
+{
+  char * res;
+
+  if (! caml_string_is_c_safe(var)) caml_raise_not_found();
+  res = caml_secure_getenv(String_val(var));
+  if (res == 0) caml_raise_not_found();
+  return caml_copy_string(res);
+}
+
 char * caml_exe_name;
 char ** caml_main_argv;
 
@@ -630,7 +640,7 @@ void caml_load_plugin(char *plugin)
 
 void caml_cplugins_load(char *env_variable)
 {
-  char *plugins = getenv(env_variable);
+  char *plugins = caml_secure_getenv(env_variable);
   if(plugins != NULL){
     char* curs = plugins;
     while(*curs != 0){

byterun/unix.c

@@ -19,6 +19,7 @@
 
 #define _GNU_SOURCE
            /* Helps finding RTLD_DEFAULT in glibc */
+           /* also secure_getenv */
 
 #include <stddef.h>
 #include <stdlib.h>
@@ -402,3 +403,20 @@ char * caml_executable_name(void)
 
 #endif
 }
+
+char *caml_secure_getenv (char const *var)
+{
+#ifdef HAS_SECURE_GETENV
+  return secure_getenv (var);
+#elif defined(HAS_ISSETUGID)
+  if (!issetugid ())
+    return CAML_SYS_GETENV (var);
+  else
+    return NULL;
+#else
+  if (geteuid () == getuid () && getegid () == getgid ())
+    return CAML_SYS_GETENV (var);
+  else
+    return NULL;
+#endif
+}

byterun/win32.c

@@ -442,7 +442,8 @@ void caml_signal_thread(void * lpParam)
   char *endptr;
   HANDLE h;
   /* Get an hexa-code raw handle through the environment */
-  h = (HANDLE) (uintptr_t) strtol(getenv("CAMLSIGPIPE"), &endptr, 16);
+  h = (HANDLE) (uintptr_t)
+    strtol(caml_secure_getenv("CAMLSIGPIPE"), &endptr, 16);
   while (1) {
     DWORD numread;
     BOOL ret;
@@ -713,3 +714,9 @@ int caml_snprintf(char * buf, size_t size, const char * format, ...)
   return len;
 }
 #endif
+
+char *caml_secure_getenv (char const *var)
+{
+  /* Win32 doesn't have a notion of setuid bit, so getenv is safe. */
+  return CAML_SYS_GETENV (var);
+}

configure

@@ -1112,6 +1112,16 @@ if sh ./hasgot times; then
   echo "#define HAS_TIMES" >> s.h
 fi
 
+if sh ./hasgot2 -D_GNU_SOURCE -i stdlib.h secure_getenv; then
+  inf "secure_getenv() found."
+  echo "#define HAS_SECURE_GETENV" >> s.h
+fi
+
+if sh ./hasgot -i unistd.h issetugid; then
+  inf "issetugid() found."
+  echo "#define HAS_ISSETUGID" >> s.h
+fi
+
 # For the terminfo module
 
 if test "$with_curses" = "yes"; then

otherlibs/unix/unix.ml

@@ -187,6 +187,7 @@ let handle_unix_error f arg =
 
 external environment : unit -> string array = "unix_environment"
 external getenv: string -> string = "caml_sys_getenv"
+(* external unsafe_getenv: string -> string = "caml_sys_unsafe_getenv" *)
 external putenv: string -> string -> unit = "unix_putenv"
 
 type process_status =

otherlibs/unix/unix.mli

@@ -125,10 +125,25 @@ val environment : unit -> string array
 
 val getenv : string -> string
 (** Return the value associated to a variable in the process
-   environment.
-   @raise Not_found if the variable is unbound.
+   environment, unless the process has special privileges.
+   @raise Not_found if the variable is unbound or the process has
+   special privileges.
 
-   (This function is identical to {!Sys.getenv}.) *)
+   (This function is identical to {!Sys.getenv}. *)
+
+(*
+val unsafe_getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment.
+
+   Unlike {!getenv}, this function returns the value even if the
+   process has special privileges. It is considered unsafe because the
+   programmer of a setuid program must be careful to prevent execution
+   of arbitrary commands through manipulation of the environment
+   variables.
+
+   @raise Not_found if the variable is unbound.  *)
+*)
 
 val putenv : string -> string -> unit
 (** [Unix.putenv name value] sets the value associated to a

otherlibs/unix/unixLabels.mli

@@ -126,6 +126,20 @@ val getenv : string -> string
    environment. Raise [Not_found] if the variable is unbound.
    (This function is identical to [Sys.getenv].) *)
 
+(*
+val unsafe_getenv : string -> string
+(** Return the value associated to a variable in the process
+   environment.
+
+   Unlike {!getenv}, this function returns the value even if the
+   process has special privileges. It is considered unsafe because the
+   programmer of a setuid program must be careful to prevent execution
+   of arbitrary commands through manipulation of the environment
+   variables.
+
+   @raise Not_found if the variable is unbound.  *)
+*)
+
 val putenv : string -> string -> unit
 (** [Unix.putenv name value] sets the value associated to a
    variable in the process environment.

otherlibs/win32unix/unix.ml

@@ -122,6 +122,7 @@ let handle_unix_error f arg =
 
 external environment : unit -> string array = "unix_environment"
 external getenv: string -> string = "caml_sys_getenv"
+(* external unsafe_getenv: string -> string = "caml_sys_unsafe_getenv" *)
 external putenv: string -> string -> unit = "unix_putenv"
 
 type process_status =