master 95334ee: Allocate environment block before forking.

[Philipp Stephani]

branch: master
commit 95334ee79ab60c0910a5528e586a24d11f91743b
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>

    Allocate environment block before forking.
    
    While 'child_setup' carefully avoids calls to async-signal-unsafe
    functions like 'malloc', it seems simpler and less brittle to use
    normal allocation outside the critical section between 'fork' and
    'exec'.
    
    * src/callproc.c (make_environment_block): New function to create the
    environment block for subprocesses.  Code largely extracted from
    'child_setup' and adapted to use 'xmalloc' instead of 'alloca'.
    (child_setup): Remove environment block allocation in favor of
    passing the environment block as command-line argument.
    (call_process): Adapt to new calling convention.
    
    * src/process.c (create_process): Adapt to new calling convention.
---
 src/callproc.c | 240 ++++++++++++++++++++++++++++++---------------------------
 src/lisp.h     |   4 +-
 src/process.c  |  12 ++-
 3 files changed, 138 insertions(+), 118 deletions(-)

diff --git a/src/callproc.c b/src/callproc.c
index 5c5a2bb..93a8bb8 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -541,8 +541,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int 
filefd,
       callproc_fd[CALLPROC_STDERR] = fd_error;
     }
 
+  char *const *env = make_environment_block (current_dir);
+
 #ifdef MSDOS /* MW, July 1993 */
-  status = child_setup (filefd, fd_output, fd_error, new_argv, current_dir);
+  status
+    = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir);
 
   if (status < 0)
     {
@@ -589,7 +592,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int 
filefd,
   block_child_signal (&oldset);
 
 #ifdef WINDOWSNT
-  pid = child_setup (filefd, fd_output, fd_error, new_argv, current_dir);
+  pid = child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir);
 #else  /* not WINDOWSNT */
 
   /* vfork, and prevent local vars from being clobbered by the vfork.  */
@@ -604,6 +607,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int 
filefd,
     ptrdiff_t volatile sa_avail_volatile = sa_avail;
     ptrdiff_t volatile sa_count_volatile = sa_count;
     char **volatile new_argv_volatile = new_argv;
+    char *const *volatile env_volatile = env;
     int volatile callproc_fd_volatile[CALLPROC_FDS];
     for (i = 0; i < CALLPROC_FDS; i++)
       callproc_fd_volatile[i] = callproc_fd[i];
@@ -620,6 +624,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int 
filefd,
     sa_avail = sa_avail_volatile;
     sa_count = sa_count_volatile;
     new_argv = new_argv_volatile;
+    env = env_volatile;
 
     for (i = 0; i < CALLPROC_FDS; i++)
       callproc_fd[i] = callproc_fd_volatile[i];
@@ -646,7 +651,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int 
filefd,
       signal (SIGPROF, SIG_DFL);
 #endif
 
-      child_setup (filefd, fd_output, fd_error, new_argv, current_dir);
+      child_setup (filefd, fd_output, fd_error, new_argv, env, current_dir);
     }
 
 #endif /* not WINDOWSNT */
@@ -1215,11 +1220,9 @@ exec_failed (char const *name, int err)
    On MS-DOS, either return an exit status or signal an error.  */
 
 CHILD_SETUP_TYPE
-child_setup (int in, int out, int err, char **new_argv,
-            Lisp_Object current_dir)
+child_setup (int in, int out, int err, char **new_argv, char *const *env,
+             Lisp_Object current_dir)
 {
-  char **env;
-  char *pwd_var;
 #ifdef WINDOWSNT
   int cpid;
   HANDLE handles[3];
@@ -1233,24 +1236,6 @@ child_setup (int in, int out, int err, char **new_argv,
      src/alloca.c) it is safe because that changes the superior's
      static variables as if the superior had done alloca and will be
      cleaned up in the usual way. */
-  {
-    char *temp;
-    ptrdiff_t i;
-
-    i = SBYTES (current_dir);
-#ifdef MSDOS
-    /* MSDOS must have all environment variables malloc'ed, because
-       low-level libc functions that launch subsidiary processes rely
-       on that.  */
-    pwd_var = xmalloc (i + 5);
-#else
-    if (MAX_ALLOCA - 5 < i)
-      exec_failed (new_argv[0], ENOMEM);
-    pwd_var = alloca (i + 5);
-#endif
-    temp = pwd_var + 4;
-    memcpy (pwd_var, "PWD=", 4);
-    lispstpcpy (temp, current_dir);
 
 #ifndef DOS_NT
     /* We can't signal an Elisp error here; we're in a vfork.  Since
@@ -1258,97 +1243,9 @@ child_setup (int in, int out, int err, char **new_argv,
        should only return an error if the directory's permissions
        are changed between the check and this chdir, but we should
        at least check.  */
-    if (chdir (temp) < 0)
+    if (chdir (SSDATA (current_dir)) < 0)
       _exit (EXIT_CANCELED);
-#else /* DOS_NT */
-    /* Get past the drive letter, so that d:/ is left alone.  */
-    if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
-      {
-       temp += 2;
-       i -= 2;
-      }
-#endif /* DOS_NT */
-
-    /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
-    while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
-      temp[--i] = 0;
-  }
-
-  /* Set `env' to a vector of the strings in the environment.  */
-  {
-    register Lisp_Object tem;
-    register char **new_env;
-    char **p, **q;
-    register int new_length;
-    Lisp_Object display = Qnil;
-
-    new_length = 0;
-
-    for (tem = Vprocess_environment;
-        CONSP (tem) && STRINGP (XCAR (tem));
-        tem = XCDR (tem))
-      {
-       if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
-           && (SDATA (XCAR (tem)) [7] == '\0'
-               || SDATA (XCAR (tem)) [7] == '='))
-         /* DISPLAY is specified in process-environment.  */
-         display = Qt;
-       new_length++;
-      }
-
-    /* If not provided yet, use the frame's DISPLAY.  */
-    if (NILP (display))
-      {
-       Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
-       if (!STRINGP (tmp) && CONSP (Vinitial_environment))
-         /* If still not found, Look for DISPLAY in Vinitial_environment.  */
-         tmp = Fgetenv_internal (build_string ("DISPLAY"),
-                                 Vinitial_environment);
-       if (STRINGP (tmp))
-         {
-           display = tmp;
-           new_length++;
-         }
-      }
-
-    /* new_length + 2 to include PWD and terminating 0.  */
-    if (MAX_ALLOCA / sizeof *env - 2 < new_length)
-      exec_failed (new_argv[0], ENOMEM);
-    env = new_env = alloca ((new_length + 2) * sizeof *env);
-    /* If we have a PWD envvar, pass one down,
-       but with corrected value.  */
-    if (egetenv ("PWD"))
-      *new_env++ = pwd_var;
-
-    if (STRINGP (display))
-      {
-       if (MAX_ALLOCA - sizeof "DISPLAY=" < SBYTES (display))
-         exec_failed (new_argv[0], ENOMEM);
-       char *vdata = alloca (sizeof "DISPLAY=" + SBYTES (display));
-       lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
-       new_env = add_env (env, new_env, vdata);
-      }
-
-    /* Overrides.  */
-    for (tem = Vprocess_environment;
-        CONSP (tem) && STRINGP (XCAR (tem));
-        tem = XCDR (tem))
-      new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
-
-    *new_env = 0;
-
-    /* Remove variable names without values.  */
-    p = q = env;
-    while (*p != 0)
-      {
-       while (*q != 0 && strchr (*q, '=') == NULL)
-         q++;
-       *p = *q++;
-       if (*p != 0)
-         p++;
-      }
-  }
-
+#endif
 
 #ifdef WINDOWSNT
   prepare_standard_handles (in, out, err, handles);
@@ -1511,6 +1408,119 @@ egetenv_internal (const char *var, ptrdiff_t len)
     return 0;
 }
 
+/* Create a new environment block.  You can pass the returned pointer
+   to `execve'.  Add unwind protections for all newly-allocated
+   objects.  Don't call any Lisp code or the garbage collector while
+   the block is active.  */
+
+char *const *
+make_environment_block (Lisp_Object current_dir)
+{
+  char **env;
+  char *pwd_var;
+
+  {
+    char *temp;
+    ptrdiff_t i;
+
+    i = SBYTES (current_dir);
+    pwd_var = xmalloc (i + 5);
+    record_unwind_protect_ptr (xfree, pwd_var);
+    temp = pwd_var + 4;
+    memcpy (pwd_var, "PWD=", 4);
+    lispstpcpy (temp, current_dir);
+
+#ifdef DOS_NT
+    /* Get past the drive letter, so that d:/ is left alone.  */
+    if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
+      {
+       temp += 2;
+       i -= 2;
+      }
+#endif /* DOS_NT */
+
+    /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
+    while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
+      temp[--i] = 0;
+  }
+
+  /* Set `env' to a vector of the strings in the environment.  */
+
+  {
+    register Lisp_Object tem;
+    register char **new_env;
+    char **p, **q;
+    register int new_length;
+    Lisp_Object display = Qnil;
+
+    new_length = 0;
+
+    for (tem = Vprocess_environment;
+        CONSP (tem) && STRINGP (XCAR (tem));
+        tem = XCDR (tem))
+      {
+       if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
+           && (SDATA (XCAR (tem)) [7] == '\0'
+               || SDATA (XCAR (tem)) [7] == '='))
+         /* DISPLAY is specified in process-environment.  */
+         display = Qt;
+       new_length++;
+      }
+
+    /* If not provided yet, use the frame's DISPLAY.  */
+    if (NILP (display))
+      {
+       Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
+       if (!STRINGP (tmp) && CONSP (Vinitial_environment))
+         /* If still not found, Look for DISPLAY in Vinitial_environment.  */
+         tmp = Fgetenv_internal (build_string ("DISPLAY"),
+                                 Vinitial_environment);
+       if (STRINGP (tmp))
+         {
+           display = tmp;
+           new_length++;
+         }
+      }
+
+    /* new_length + 2 to include PWD and terminating 0.  */
+    env = new_env = xnmalloc (new_length + 2, sizeof *env);
+    record_unwind_protect_ptr (xfree, env);
+    /* If we have a PWD envvar, pass one down,
+       but with corrected value.  */
+    if (egetenv ("PWD"))
+      *new_env++ = pwd_var;
+
+    if (STRINGP (display))
+      {
+       char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display));
+       record_unwind_protect_ptr (xfree, vdata);
+       lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
+       new_env = add_env (env, new_env, vdata);
+      }
+
+    /* Overrides.  */
+    for (tem = Vprocess_environment;
+        CONSP (tem) && STRINGP (XCAR (tem));
+        tem = XCDR (tem))
+      new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
+
+    *new_env = 0;
+
+    /* Remove variable names without values.  */
+    p = q = env;
+    while (*p != 0)
+      {
+       while (*q != 0 && strchr (*q, '=') == NULL)
+         q++;
+       *p = *q++;
+       if (*p != 0)
+         p++;
+      }
+  }
+
+  return env;
+}
+
 
 /* This is run before init_cmdargs.  */
 
diff --git a/src/lisp.h b/src/lisp.h
index 6e18433..d20e69f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4500,7 +4500,9 @@ extern void setup_process_coding_systems (Lisp_Object);
 # define CHILD_SETUP_ERROR_DESC "Doing vfork"
 #endif
 
-extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, Lisp_Object);
+extern CHILD_SETUP_TYPE child_setup (int, int, int, char **, char *const *,
+                                     Lisp_Object);
+extern char *const *make_environment_block (Lisp_Object);
 extern void init_callproc_1 (void);
 extern void init_callproc (void);
 extern void set_initial_environment (void);
diff --git a/src/process.c b/src/process.c
index b82942d..c579078 100644
--- a/src/process.c
+++ b/src/process.c
@@ -2124,8 +2124,11 @@ create_process (Lisp_Object process, char **new_argv, 
Lisp_Object current_dir)
   if (!EQ (p->command, Qt))
     add_process_read_fd (inchannel);
 
+  ptrdiff_t count = SPECPDL_INDEX ();
+
   /* This may signal an error.  */
   setup_process_coding_systems (process);
+  char *const *env = make_environment_block (current_dir);
 
   block_input ();
   block_child_signal (&oldset);
@@ -2139,6 +2142,7 @@ create_process (Lisp_Object process, char **new_argv, 
Lisp_Object current_dir)
   int volatile forkout_volatile = forkout;
   int volatile forkerr_volatile = forkerr;
   struct Lisp_Process *p_volatile = p;
+  char *const *volatile env_volatile = env;
 
 #ifdef DARWIN_OS
   /* Darwin doesn't let us run setsid after a vfork, so use fork when
@@ -2163,6 +2167,7 @@ create_process (Lisp_Object process, char **new_argv, 
Lisp_Object current_dir)
   forkout = forkout_volatile;
   forkerr = forkerr_volatile;
   p = p_volatile;
+  env = env_volatile;
 
   pty_flag = p->pty_flag;
 
@@ -2254,9 +2259,9 @@ create_process (Lisp_Object process, char **new_argv, 
Lisp_Object current_dir)
       if (forkerr < 0)
        forkerr = forkout;
 #ifdef WINDOWSNT
-      pid = child_setup (forkin, forkout, forkerr, new_argv, current_dir);
+      pid = child_setup (forkin, forkout, forkerr, new_argv, env, current_dir);
 #else  /* not WINDOWSNT */
-      child_setup (forkin, forkout, forkerr, new_argv, current_dir);
+      child_setup (forkin, forkout, forkerr, new_argv, env, current_dir);
 #endif /* not WINDOWSNT */
     }
 
@@ -2271,6 +2276,9 @@ create_process (Lisp_Object process, char **new_argv, 
Lisp_Object current_dir)
   unblock_child_signal (&oldset);
   unblock_input ();
 
+  /* Environment block no longer needed.  */
+  unbind_to (count, Qnil);
+
   if (pid < 0)
     report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno);
   else