root/src/callproc.c

DEFINITIONS

1. get_current_directory
2. record_kill_process
3. delete_temp_file
4. call_process_kill
5. call_process_cleanup
6. call_process
7. create_temp_file
8. add_env
9. exec_failed
10. child_setup
11. emacs_posix_spawn_init_actions
12. emacs_posix_spawn_init_attributes
13. emacs_spawn
14. getenv_internal_1
15. getenv_internal
16. egetenv_internal
17. make_environment_block
18. init_callproc_1
19. init_callproc
20. set_initial_environment
21. syms_of_callproc

     1 /* Synchronous subprocess invocation for GNU Emacs.
     2 
     3 Copyright (C) 1985-1988, 1993-1995, 1999-2023 Free Software Foundation,
     4 Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     8 GNU Emacs is free software: you can redistribute it and/or modify
     9 it under the terms of the GNU General Public License as published by
    10 the Free Software Foundation, either version 3 of the License, or (at
    11 your option) any later version.
    12 
    13 GNU Emacs is distributed in the hope that it will be useful,
    14 but WITHOUT ANY WARRANTY; without even the implied warranty of
    15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16 GNU General Public License for more details.
    17 
    18 You should have received a copy of the GNU General Public License
    19 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    20 
    21 
    22 #include <config.h>
    23 #include <errno.h>
    24 #include <stdlib.h>
    25 #include <sys/types.h>
    26 #include <unistd.h>
    27 
    28 #ifdef MSDOS
    29 extern char **environ;
    30 #endif
    31 
    32 #include <sys/file.h>
    33 #include <fcntl.h>
    34 
    35 /* In order to be able to use `posix_spawn', it needs to support some
    36    variant of `chdir' as well as `setsid'.  */
    37 #if defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN        \
    38   && defined HAVE_POSIX_SPAWNATTR_SETFLAGS                  \
    39   && (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR        \
    40       || defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \
    41   && defined HAVE_DECL_POSIX_SPAWN_SETSID                   \
    42   && HAVE_DECL_POSIX_SPAWN_SETSID == 1                      \
    43   /* posix_spawnattr_setflags rejects POSIX_SPAWN_SETSID on \
    44      Haiku */                                               \
    45   && !defined HAIKU
    46 # include <spawn.h>
    47 # define USABLE_POSIX_SPAWN 1
    48 #else
    49 # define USABLE_POSIX_SPAWN 0
    50 #endif
    51 
    52 #include "lisp.h"
    53 
    54 #ifdef SETUP_SLAVE_PTY
    55 # include <sys/stream.h>
    56 # include <sys/stropts.h>
    57 #endif
    58 
    59 #ifdef WINDOWSNT
    60 #include <sys/socket.h> /* for fcntl */
    61 #include <windows.h>
    62 #include "w32.h"
    63 #define _P_NOWAIT 1     /* from process.h */
    64 #endif
    65 
    66 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
    67 #include <sys/stat.h>
    68 #include <sys/param.h>
    69 #endif /* MSDOS */
    70 
    71 #include "commands.h"
    72 #include "buffer.h"
    73 #include "coding.h"
    74 #include <epaths.h>
    75 #include "process.h"
    76 #include "syssignal.h"
    77 #include "syswait.h"
    78 #include "blockinput.h"
    79 #include "frame.h"
    80 #include "systty.h"
    81 #include "keyboard.h"
    82 
    83 #ifdef MSDOS
    84 #include "msdos.h"
    85 #endif
    86 
    87 #ifdef HAVE_NS
    88 #include "nsterm.h"
    89 #endif
    90 
    91 #ifdef HAVE_PGTK
    92 #include "pgtkterm.h"
    93 #endif
    94 
    95 #ifdef HAVE_ANDROID
    96 #include "android.h"
    97 #endif /* HAVE_ANDROID */
    98 
    99 /* Pattern used by call-process-region to make temp files.  */
   100 static Lisp_Object Vtemp_file_name_pattern;
   101 
   102 /* The next two variables are used while record-unwind-protect is in place
   103    during call-process for a subprocess for which record_deleted_pid has
   104    not yet been called.  At other times, synch_process_pid is zero and
   105    synch_process_tempfile's contents are irrelevant.  Doing this via static
   106    C variables is more convenient than putting them into the arguments
   107    of record-unwind-protect, as they need to be updated at randomish
   108    times in the code, and Lisp cannot always store these values as
   109    Emacs integers.  It's safe to use static variables here, as the
   110    code is never invoked reentrantly.  */
   111 
   112 /* If nonzero, a process-ID that has not been reaped.  */
   113 static pid_t synch_process_pid;
   114 
   115 /* If a string, the name of a temp file that has not been removed.  */
   116 #ifdef MSDOS
   117 static Lisp_Object synch_process_tempfile;
   118 #else
   119 # define synch_process_tempfile make_fixnum (0)
   120 #endif
   121 
   122 /* Indexes of file descriptors that need closing on call_process_kill.  */
   123 enum
   124   {
   125     /* The subsidiary process's stdout and stderr.  stdin is handled
   126        separately, in either Fcall_process_region or create_temp_file.  */
   127     CALLPROC_STDOUT, CALLPROC_STDERR,
   128 
   129     /* How to read from a pipe (or substitute) from the subsidiary process.  */
   130     CALLPROC_PIPEREAD,
   131 
   132     /* A bound on the number of file descriptors.  */
   133     CALLPROC_FDS
   134   };
   135 
   136 static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, specpdl_ref);
   137 
   138 #ifdef DOS_NT
   139 # define CHILD_SETUP_TYPE int
   140 #else
   141 # define CHILD_SETUP_TYPE _Noreturn void
   142 #endif
   143 
   144 static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **,
   145                                      const char *);
   146 
   147 /* Return the current buffer's working directory, or the home
   148    directory if it's unreachable.  If ENCODE is true, return as a string
   149    suitable for a system call; otherwise, return a string in its
   150    internal representation.  Signal an error if the result would not be
   151    an accessible directory.
   152 
   153    If the default directory lies inside a special directory which
   154    cannot be made the current working directory, and ENCODE is also
   155    set, simply return the home directory.  */
   156 
   157 Lisp_Object
   158 get_current_directory (bool encode)
   159 {
   160   Lisp_Object curdir = BVAR (current_buffer, directory);
   161   Lisp_Object dir = Funhandled_file_name_directory (curdir);
   162 
   163   /* If the file name handler says that dir is unreachable, use
   164      a sensible default. */
   165   if (NILP (dir))
   166     dir = build_string ("~");
   167 
   168 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
   169 
   170   /* If DIR is an asset directory or a content directory, return
   171      the home directory instead.  */
   172 
   173   if (encode
   174       && (android_is_special_directory (SSDATA (dir),
   175                                         "/assets")
   176           || android_is_special_directory (SSDATA (dir),
   177                                            "/content")))
   178     dir = build_string ("~");
   179 
   180 #endif /* HAVE_ANDROID && ANDROID_STUBIFY */
   181 
   182   dir = expand_and_dir_to_file (dir);
   183   Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir));
   184 
   185   if (! file_accessible_directory_p (encoded_dir))
   186     report_file_error ("Setting current directory", curdir);
   187 
   188   return encode ? encoded_dir : dir;
   189 }
   190 
   191 /* If P is reapable, record it as a deleted process and kill it.
   192    Do this in a critical section.  Unless PID is wedged it will be
   193    reaped on receipt of the first SIGCHLD after the critical section.  */
   194 
   195 void
   196 record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
   197 {
   198 #ifndef MSDOS
   199   sigset_t oldset;
   200   block_child_signal (&oldset);
   201 
   202   if (p->alive)
   203     {
   204       record_deleted_pid (p->pid, tempfile);
   205       p->alive = 0;
   206       kill (- p->pid, SIGKILL);
   207     }
   208 
   209   unblock_child_signal (&oldset);
   210 #endif  /* !MSDOS */
   211 }
   212 
   213 /* Clean up files, file descriptors and processes created by Fcall_process.  */
   214 
   215 static void
   216 delete_temp_file (Lisp_Object name)
   217 {
   218   emacs_unlink (SSDATA (name));
   219 }
   220 
   221 static void
   222 call_process_kill (void *ptr)
   223 {
   224   int *callproc_fd = ptr;
   225   int i;
   226   for (i = 0; i < CALLPROC_FDS; i++)
   227     if (0 <= callproc_fd[i])
   228       emacs_close (callproc_fd[i]);
   229 
   230   if (synch_process_pid)
   231     {
   232       struct Lisp_Process proc;
   233       proc.alive = 1;
   234       proc.pid = synch_process_pid;
   235       record_kill_process (&proc, synch_process_tempfile);
   236       synch_process_pid = 0;
   237     }
   238   else if (STRINGP (synch_process_tempfile))
   239     delete_temp_file (synch_process_tempfile);
   240 }
   241 
   242 /* Clean up when exiting Fcall_process: restore the buffer, and
   243    kill the subsidiary process group if the process still exists.  */
   244 
   245 static void
   246 call_process_cleanup (Lisp_Object buffer)
   247 {
   248   Fset_buffer (buffer);
   249 
   250 #ifndef MSDOS
   251   if (synch_process_pid)
   252     {
   253       kill (-synch_process_pid, SIGINT);
   254       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
   255 
   256       /* This will quit on C-g.  */
   257       bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
   258       synch_process_pid = 0;
   259       message1 (wait_ok
   260                 ? "Waiting for process to die...done"
   261                 : "Waiting for process to die...internal error");
   262     }
   263 #endif  /* !MSDOS */
   264 }
   265 
   266 #ifdef DOS_NT
   267 static mode_t const default_output_mode = S_IREAD | S_IWRITE;
   268 #else
   269 static mode_t const default_output_mode = 0666;
   270 #endif
   271 
   272 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
   273        doc: /* Call PROGRAM synchronously in separate process.
   274 The remaining arguments are optional.
   275 
   276 The program's input comes from file INFILE (nil means `null-device').
   277 If INFILE is a relative path, it will be looked for relative to the
   278 directory where the process is run (see below).  If you want to make the
   279 input come from an Emacs buffer, use `call-process-region' instead.
   280 
   281 Third argument DESTINATION specifies how to handle program's output.
   282 (\"Output\" here means both standard output and standard error
   283 output.)
   284 If DESTINATION is a buffer or the name of a buffer, or t (which stands for
   285 the current buffer), it means insert output in that buffer before point.
   286 If DESTINATION is nil, it means discard output; 0 means discard
   287  and don't wait for the program to terminate.
   288 If DESTINATION is `(:file FILE)', where FILE is a file name string,
   289  it means that output should be written to that file (if the file
   290  already exists it is overwritten).
   291 DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
   292  REAL-BUFFER says what to do with standard output, as above,
   293  while STDERR-FILE says what to do with standard error in the child.
   294  STDERR-FILE may be nil (discard standard error output),
   295  t (mix it with ordinary output), or a file name string.
   296 
   297 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
   298 Remaining arguments ARGS are strings passed as command arguments to PROGRAM.
   299 
   300 If PROGRAM is not an absolute file name, `call-process' will look for
   301 PROGRAM in `exec-path' (which is a list of directories).
   302 
   303 If executable PROGRAM can't be found as an executable, `call-process'
   304 signals a Lisp error.  `call-process' reports errors in execution of
   305 the program only through its return and output.
   306 
   307 If DESTINATION is 0, `call-process' returns immediately with value nil.
   308 Otherwise it waits for PROGRAM to terminate
   309 and returns a numeric exit status or a signal description string.
   310 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
   311 
   312 The process runs in `default-directory' if that is local (as
   313 determined by `unhandled-file-name-directory'), or "~" otherwise.  If
   314 you want to run a process in a remote directory use `process-file'.
   315 
   316 usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS)  */)
   317   (ptrdiff_t nargs, Lisp_Object *args)
   318 {
   319   Lisp_Object infile, encoded_infile;
   320   int filefd;
   321   specpdl_ref count = SPECPDL_INDEX ();
   322 
   323   if (nargs >= 2 && ! NILP (args[1]))
   324     {
   325       /* Expand infile relative to the current buffer's current
   326          directory, or its unhandled equivalent ("~").  */
   327       infile = Fexpand_file_name (args[1], get_current_directory (false));
   328       CHECK_STRING (infile);
   329     }
   330   else
   331     infile = build_string (NULL_DEVICE);
   332 
   333   /* Remove "/:" from INFILE.  */
   334   infile = remove_slash_colon (infile);
   335 
   336   encoded_infile = ENCODE_FILE (infile);
   337 
   338   filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
   339   if (filefd < 0)
   340     report_file_error ("Opening process input file", infile);
   341   record_unwind_protect_int (close_file_unwind, filefd);
   342   return unbind_to (count, call_process (nargs, args, filefd,
   343                                          make_invalid_specpdl_ref ()));
   344 }
   345 
   346 /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
   347 
   348    If TEMPFILE_INDEX is valid, it is the specpdl index of an
   349    unwinder that is intended to remove the input temporary file; in
   350    this case NARGS must be at least 2 and ARGS[1] is the file's name.
   351 
   352    At entry, the specpdl stack top entry must be close_file_unwind (FILEFD).  */
   353 
   354 static Lisp_Object
   355 call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
   356               specpdl_ref tempfile_index)
   357 {
   358   Lisp_Object buffer, current_dir, path;
   359   bool display_p;
   360   int fd0;
   361   int callproc_fd[CALLPROC_FDS];
   362   int status;
   363   ptrdiff_t i;
   364   specpdl_ref count = SPECPDL_INDEX ();
   365   USE_SAFE_ALLOCA;
   366 
   367   char **new_argv;
   368   /* File to use for stderr in the child.
   369      t means use same as standard output.  */
   370   Lisp_Object error_file;
   371   Lisp_Object output_file = Qnil;
   372 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
   373   char *tempfile = NULL;
   374 #else
   375   sigset_t oldset;
   376   pid_t pid = -1;
   377 #endif
   378   int child_errno;
   379   int fd_output, fd_error;
   380   struct coding_system process_coding; /* coding-system of process output */
   381   struct coding_system argument_coding; /* coding-system of arguments */
   382   /* Set to the return value of Ffind_operation_coding_system.  */
   383   Lisp_Object coding_systems;
   384   bool discard_output;
   385 
   386   if (synch_process_pid)
   387     error ("call-process invoked recursively");
   388 
   389   /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
   390   coding_systems = Qt;
   391 
   392   CHECK_STRING (args[0]);
   393 
   394   error_file = Qt;
   395 
   396 #ifndef subprocesses
   397   /* Without asynchronous processes we cannot have BUFFER == 0.  */
   398   if (nargs >= 3
   399       && (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
   400     error ("Operating system cannot handle asynchronous subprocesses");
   401 #endif /* subprocesses */
   402 
   403   /* Decide the coding-system for giving arguments.  */
   404   {
   405     Lisp_Object val, *args2;
   406 
   407     /* If arguments are supplied, we may have to encode them.  */
   408     if (nargs >= 5)
   409       {
   410         bool must_encode = 0;
   411         Lisp_Object coding_attrs;
   412 
   413         for (i = 4; i < nargs; i++)
   414           CHECK_STRING (args[i]);
   415 
   416         for (i = 4; i < nargs; i++)
   417           if (STRING_MULTIBYTE (args[i]))
   418             must_encode = 1;
   419 
   420         if (!NILP (Vcoding_system_for_write))
   421           val = Vcoding_system_for_write;
   422         else if (! must_encode)
   423           val = Qraw_text;
   424         else
   425           {
   426             SAFE_NALLOCA (args2, 1, nargs + 1);
   427             args2[0] = Qcall_process;
   428             for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
   429             coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
   430             val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
   431           }
   432         val = complement_process_encoding_system (val);
   433         setup_coding_system (Fcheck_coding_system (val), &argument_coding);
   434         coding_attrs = CODING_ID_ATTRS (argument_coding.id);
   435         if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
   436           {
   437             /* We should not use an ASCII incompatible coding system.  */
   438             val = raw_text_coding_system (val);
   439             setup_coding_system (val, &argument_coding);
   440           }
   441       }
   442   }
   443 
   444   if (nargs < 3)
   445     buffer = Qnil;
   446   else
   447     {
   448       buffer = args[2];
   449 
   450       /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
   451          FILE-FOR-STDERR), unless the first element is :file, in which case see
   452          the next paragraph. */
   453       if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
   454         {
   455           if (CONSP (XCDR (buffer)))
   456             {
   457               Lisp_Object stderr_file;
   458               stderr_file = XCAR (XCDR (buffer));
   459 
   460               if (NILP (stderr_file) || EQ (Qt, stderr_file))
   461                 error_file = stderr_file;
   462               else
   463                 error_file = Fexpand_file_name (stderr_file, Qnil);
   464             }
   465 
   466           buffer = XCAR (buffer);
   467         }
   468 
   469       /* If the buffer is (still) a list, it might be a (:file "file") spec. */
   470       if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
   471         {
   472           Lisp_Object ofile = XCDR (buffer);
   473           if (CONSP (ofile))
   474             ofile = XCAR (ofile);
   475           CHECK_STRING (ofile);
   476           output_file = Fexpand_file_name (ofile,
   477                                            BVAR (current_buffer, directory));
   478           CHECK_STRING (output_file);
   479           buffer = Qnil;
   480         }
   481 
   482       if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
   483         {
   484           Lisp_Object spec_buffer = buffer;
   485           buffer = Fget_buffer_create (buffer, Qnil);
   486           /* Mention the buffer name for a better error message.  */
   487           if (NILP (buffer))
   488             CHECK_BUFFER (spec_buffer);
   489           CHECK_BUFFER (buffer);
   490         }
   491     }
   492 
   493   /* Make sure that the child will be able to chdir to the current
   494      buffer's current directory, or its unhandled equivalent.  We
   495      can't just have the child check for an error when it does the
   496      chdir, since it's in a vfork.  */
   497   current_dir = get_current_directory (true);
   498 
   499   if (STRINGP (error_file))
   500     {
   501       error_file = remove_slash_colon (error_file);
   502       error_file = ENCODE_FILE (error_file);
   503     }
   504   if (STRINGP (output_file))
   505     {
   506       output_file = remove_slash_colon (output_file);
   507       output_file = ENCODE_FILE (output_file);
   508     }
   509 
   510   display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
   511 
   512   for (i = 0; i < CALLPROC_FDS; i++)
   513     callproc_fd[i] = -1;
   514 #ifdef MSDOS
   515   synch_process_tempfile = make_fixnum (0);
   516 #endif
   517   record_unwind_protect_ptr (call_process_kill, callproc_fd);
   518 
   519   /* Search for program; barf if not found.  */
   520   {
   521     int ok;
   522 
   523     ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
   524                 make_fixnum (X_OK), false, false, NULL);
   525     if (ok < 0)
   526       report_file_error ("Searching for program", args[0]);
   527   }
   528 
   529   /* Remove "/:" from PATH.  */
   530   path = remove_slash_colon (path);
   531 
   532   SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
   533 
   534   if (nargs > 4)
   535     {
   536       ptrdiff_t i;
   537 
   538       argument_coding.dst_multibyte = 0;
   539       for (i = 4; i < nargs; i++)
   540         {
   541           argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
   542           if (CODING_REQUIRE_ENCODING (&argument_coding))
   543             /* We must encode this argument.  */
   544             args[i] = encode_coding_string (&argument_coding, args[i], 1);
   545         }
   546       for (i = 4; i < nargs; i++)
   547         new_argv[i - 3] = SSDATA (args[i]);
   548       new_argv[i - 3] = 0;
   549     }
   550   else
   551     new_argv[1] = 0;
   552   path = ENCODE_FILE (path);
   553   new_argv[0] = SSDATA (path);
   554 
   555   discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file));
   556 
   557 #ifdef MSDOS
   558   if (! discard_output && ! STRINGP (output_file))
   559     {
   560       char const *tmpdir = egetenv ("TMPDIR");
   561       char const *outf = tmpdir ? tmpdir : "";
   562       tempfile = alloca (strlen (outf) + 20);
   563       strcpy (tempfile, outf);
   564       dostounix_filename (tempfile);
   565       if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
   566         strcat (tempfile, "/");
   567       strcat (tempfile, "emXXXXXX");
   568       mktemp (tempfile);
   569       if (!*tempfile)
   570         report_file_error ("Opening process output file", Qnil);
   571       output_file = build_string (tempfile);
   572       synch_process_tempfile = output_file;
   573     }
   574 #endif
   575 
   576   if (discard_output)
   577     {
   578       fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
   579       if (fd_output < 0)
   580         report_file_error ("Opening null device", Qnil);
   581     }
   582   else if (STRINGP (output_file))
   583     {
   584       fd_output = emacs_open (SSDATA (output_file),
   585                               O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
   586                               default_output_mode);
   587       if (fd_output < 0)
   588         {
   589           int open_errno = errno;
   590           output_file = DECODE_FILE (output_file);
   591           report_file_errno ("Opening process output file",
   592                              output_file, open_errno);
   593         }
   594     }
   595   else
   596     {
   597       int fd[2];
   598       if (emacs_pipe (fd) != 0)
   599         report_file_error ("Creating process pipe", Qnil);
   600       callproc_fd[CALLPROC_PIPEREAD] = fd[0];
   601       fd_output = fd[1];
   602     }
   603   callproc_fd[CALLPROC_STDOUT] = fd_output;
   604 
   605   fd_error = fd_output;
   606 
   607   if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
   608     {
   609       fd_error = emacs_open ((STRINGP (error_file)
   610                               ? SSDATA (error_file)
   611                               : NULL_DEVICE),
   612                              O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
   613                              default_output_mode);
   614       if (fd_error < 0)
   615         {
   616           int open_errno = errno;
   617           report_file_errno ("Cannot redirect stderr",
   618                              (STRINGP (error_file)
   619                               ? DECODE_FILE (error_file)
   620                               : build_string (NULL_DEVICE)),
   621                              open_errno);
   622         }
   623       callproc_fd[CALLPROC_STDERR] = fd_error;
   624     }
   625 
   626   char **env = make_environment_block (current_dir);
   627 
   628 #ifdef MSDOS /* MW, July 1993 */
   629   status = child_setup (filefd, fd_output, fd_error, new_argv, env,
   630                         SSDATA (current_dir));
   631 
   632   if (status < 0)
   633     {
   634       child_errno = errno;
   635       unbind_to (count, Qnil);
   636       synchronize_system_messages_locale ();
   637       return
   638         code_convert_string_norecord (build_string (strerror (child_errno)),
   639                                       Vlocale_coding_system, 0);
   640     }
   641 
   642   for (i = 0; i < CALLPROC_FDS; i++)
   643     if (0 <= callproc_fd[i])
   644       {
   645         emacs_close (callproc_fd[i]);
   646         callproc_fd[i] = -1;
   647       }
   648   emacs_close (filefd);
   649   clear_unwind_protect (specpdl_ref_add (count, -1));
   650 
   651   if (tempfile)
   652     {
   653       /* Since CRLF is converted to LF within `decode_coding', we
   654          can always open a file with binary mode.  */
   655       callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
   656       if (callproc_fd[CALLPROC_PIPEREAD] < 0)
   657         {
   658           int open_errno = errno;
   659           report_file_errno ("Cannot re-open temporary file",
   660                              build_string (tempfile), open_errno);
   661         }
   662     }
   663 
   664 #endif /* MSDOS */
   665 
   666   /* Do the unwind-protect now, even though the pid is not known, so
   667      that no storage allocation is done in the critical section.
   668      The actual PID will be filled in during the critical section.  */
   669   record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
   670 
   671 #ifndef MSDOS
   672 
   673   child_signal_init ();
   674   block_input ();
   675   block_child_signal (&oldset);
   676 
   677   child_errno
   678     = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
   679                    SSDATA (current_dir), NULL, false, false, &oldset);
   680   eassert ((child_errno == 0) == (0 < pid));
   681 
   682   if (pid > 0)
   683     {
   684       synch_process_pid = pid;
   685 
   686       if (FIXNUMP (buffer))
   687         {
   688           if (!specpdl_ref_valid_p (tempfile_index))
   689             record_deleted_pid (pid, Qnil);
   690           else
   691             {
   692               eassert (1 < nargs);
   693               record_deleted_pid (pid, args[1]);
   694               clear_unwind_protect (tempfile_index);
   695             }
   696           synch_process_pid = 0;
   697         }
   698     }
   699 
   700   unblock_child_signal (&oldset);
   701   unblock_input ();
   702 
   703   if (pid < 0)
   704     report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
   705 
   706   /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
   707      since we will use that to read input from.  */
   708   for (i = 0; i < CALLPROC_FDS; i++)
   709     if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
   710       {
   711         emacs_close (callproc_fd[i]);
   712         callproc_fd[i] = -1;
   713       }
   714   emacs_close (filefd);
   715   clear_unwind_protect (specpdl_ref_add (count, -1));
   716 
   717 #endif /* not MSDOS */
   718 
   719   if (FIXNUMP (buffer))
   720     return unbind_to (count, Qnil);
   721 
   722   if (BUFFERP (buffer))
   723     Fset_buffer (buffer);
   724 
   725   fd0 = callproc_fd[CALLPROC_PIPEREAD];
   726 
   727   if (0 <= fd0)
   728     {
   729       Lisp_Object val, *args2;
   730 
   731       val = Qnil;
   732       if (!NILP (Vcoding_system_for_read))
   733         val = Vcoding_system_for_read;
   734       else
   735         {
   736           if (EQ (coding_systems, Qt))
   737             {
   738               ptrdiff_t i;
   739 
   740               SAFE_NALLOCA (args2, 1, nargs + 1);
   741               args2[0] = Qcall_process;
   742               for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
   743               coding_systems
   744                 = Ffind_operation_coding_system (nargs + 1, args2);
   745             }
   746           if (CONSP (coding_systems))
   747             val = XCAR (coding_systems);
   748           else if (CONSP (Vdefault_process_coding_system))
   749             val = XCAR (Vdefault_process_coding_system);
   750           else
   751             val = Qnil;
   752         }
   753       Fcheck_coding_system (val);
   754       /* In unibyte mode, character code conversion should not take
   755          place but EOL conversion should.  So, setup raw-text or one
   756          of the subsidiary according to the information just setup.  */
   757       if (NILP (BVAR (current_buffer, enable_multibyte_characters))
   758           && !NILP (val))
   759         val = raw_text_coding_system (val);
   760       setup_coding_system (val, &process_coding);
   761       process_coding.dst_multibyte
   762         = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
   763       process_coding.src_multibyte = 0;
   764     }
   765 
   766   if (0 <= fd0)
   767     {
   768       enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
   769       enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
   770       char buf[CALLPROC_BUFFER_SIZE_MAX];
   771       int bufsize = CALLPROC_BUFFER_SIZE_MIN;
   772       int nread;
   773       EMACS_INT total_read = 0;
   774       int carryover = 0;
   775       bool display_on_the_fly = display_p;
   776       struct coding_system saved_coding = process_coding;
   777       ptrdiff_t prepared_pos = 0; /* prepare_to_modify_buffer was last
   778                                      called here.  */
   779 
   780       while (1)
   781         {
   782           /* Repeatedly read until we've filled as much as possible
   783              of the buffer size we have.  But don't read
   784              less than 1024--save that for the next bufferful.  */
   785           nread = carryover;
   786           while (nread < bufsize - 1024)
   787             {
   788               int this_read = emacs_read_quit (fd0, buf + nread,
   789                                                bufsize - nread);
   790 
   791               if (this_read < 0)
   792                 goto give_up;
   793 
   794               if (this_read == 0)
   795                 {
   796                   process_coding.mode |= CODING_MODE_LAST_BLOCK;
   797                   break;
   798                 }
   799 
   800               nread += this_read;
   801               total_read += this_read;
   802 
   803               if (display_on_the_fly)
   804                 break;
   805             }
   806           /* CHANGE FUNCTIONS
   807              For each iteration of the enclosing while (1) loop which
   808              yields data (i.e. nread > 0), before- and
   809              after-change-functions are each invoked exactly once.
   810              This is done directly from the current function only, by
   811              calling prepare_to_modify_buffer and signal_after_change.
   812              It is not done here by directing another function such as
   813              insert_1_both to call them.  The call to
   814              prepare_to_modify_buffer follows this comment, and there
   815              is one call to signal_after_change in each of the
   816              branches of the next `else if'.
   817 
   818              Exceptionally, the insertion into the buffer is aborted
   819              at the call to del_range_2 ~45 lines further down, this
   820              function removing the newly inserted data.  At this stage
   821              prepare_to_modify_buffer has been called, but
   822              signal_after_change hasn't.  A continue statement
   823              restarts the enclosing while (1) loop.  A second,
   824              unwanted, call to `prepare_to_modify_buffer' is inhibited
   825              by the test prepared_pos < PT.  The data are inserted
   826              again, and this time signal_after_change gets called,
   827              balancing the previous call to prepare_to_modify_buffer.  */
   828           if ((prepared_pos < PT) && nread)
   829             {
   830               prepare_to_modify_buffer (PT, PT, NULL);
   831               prepared_pos = PT;
   832             }
   833 
   834           /* Now NREAD is the total amount of data in the buffer.  */
   835 
   836           if (!nread)
   837             ;
   838           else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
   839                    && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
   840             {
   841               insert_1_both (buf, nread, nread, 0, 0, 0);
   842               signal_after_change (PT - nread, 0, nread);
   843             }
   844           else
   845             {                   /* We have to decode the input.  */
   846               Lisp_Object curbuf;
   847               specpdl_ref count1 = SPECPDL_INDEX ();
   848 
   849               XSETBUFFER (curbuf, current_buffer);
   850               /* We cannot allow after-change-functions be run
   851                  during decoding, because that might modify the
   852                  buffer, while we rely on process_coding.produced to
   853                  faithfully reflect inserted text until we
   854                  TEMP_SET_PT_BOTH below.  */
   855               specbind (Qinhibit_modification_hooks, Qt);
   856               decode_coding_c_string (&process_coding,
   857                                       (unsigned char *) buf, nread, curbuf);
   858               unbind_to (count1, Qnil);
   859               if (display_on_the_fly
   860                   && CODING_REQUIRE_DETECTION (&saved_coding)
   861                   && ! CODING_REQUIRE_DETECTION (&process_coding))
   862                 {
   863                   /* We have detected some coding system, but the
   864                      detection may have been via insufficient data.
   865                      So give up displaying on the fly.  */
   866                   if (process_coding.produced > 0)
   867                     del_range_2 (process_coding.dst_pos,
   868                                  process_coding.dst_pos_byte,
   869                                  (process_coding.dst_pos
   870                                   + process_coding.produced_char),
   871                                  (process_coding.dst_pos_byte
   872                                   + process_coding.produced),
   873                                  0);
   874                   display_on_the_fly = false;
   875                   process_coding = saved_coding;
   876                   carryover = nread;
   877                   /* Make the above condition always fail in the future.  */
   878                   saved_coding.common_flags
   879                     &= ~CODING_REQUIRE_DETECTION_MASK;
   880                   continue;
   881                 }
   882 
   883               TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
   884                                 PT_BYTE + process_coding.produced);
   885               signal_after_change (PT - process_coding.produced_char,
   886                                    0, process_coding.produced_char);
   887               carryover = process_coding.carryover_bytes;
   888               if (carryover > 0)
   889                 memcpy (buf, process_coding.carryover,
   890                         process_coding.carryover_bytes);
   891             }
   892 
   893           if (process_coding.mode & CODING_MODE_LAST_BLOCK)
   894             break;
   895 
   896           /* Make the buffer bigger as we continue to read more data,
   897              but not past CALLPROC_BUFFER_SIZE_MAX.  */
   898           if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
   899             if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
   900               bufsize = CALLPROC_BUFFER_SIZE_MAX;
   901 
   902           if (display_p)
   903             {
   904               redisplay_preserve_echo_area (1);
   905               /* This variable might have been set to 0 for code
   906                  detection.  In that case, set it back to 1 because
   907                  we should have already detected a coding system.  */
   908               display_on_the_fly = true;
   909             }
   910         }
   911     give_up: ;
   912 
   913       Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
   914       /* If the caller required, let the buffer inherit the
   915          coding-system used to decode the process output.  */
   916       if (inherit_process_coding_system)
   917         call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
   918                make_fixnum (total_read));
   919     }
   920 
   921   bool wait_ok = true;
   922 #ifndef MSDOS
   923   /* Wait for it to terminate, unless it already has.  */
   924   wait_ok = wait_for_termination (pid, &status, fd0 < 0);
   925 #endif
   926 
   927   /* Don't kill any children that the subprocess may have left behind
   928      when exiting.  */
   929   synch_process_pid = 0;
   930 
   931   SAFE_FREE_UNBIND_TO (count, Qnil);
   932 
   933   if (!wait_ok)
   934     return build_unibyte_string ("internal error");
   935 
   936   if (WIFSIGNALED (status))
   937     {
   938       const char *signame;
   939 
   940       synchronize_system_messages_locale ();
   941       signame = strsignal (WTERMSIG (status));
   942 
   943       if (signame == 0)
   944         signame = "unknown";
   945 
   946       return code_convert_string_norecord (build_string (signame),
   947                                            Vlocale_coding_system, 0);
   948     }
   949 
   950   eassert (WIFEXITED (status));
   951   return make_fixnum (WEXITSTATUS (status));
   952 }
   953 
   954 /* Create a temporary file suitable for storing the input data of
   955    call-process-region.  NARGS and ARGS are the same as for
   956    call-process-region.  Store into *FILENAME_STRING_PTR a Lisp string
   957    naming the file, and return a file descriptor for reading.
   958    Unwind-protect the file, so that the file descriptor will be closed
   959    and the file removed when the caller unwinds the specpdl stack.  */
   960 
   961 static int
   962 create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
   963                   Lisp_Object *filename_string_ptr)
   964 {
   965   int fd;
   966   Lisp_Object filename_string;
   967   Lisp_Object val, start, end;
   968   Lisp_Object tmpdir;
   969 
   970   if (STRINGP (Vtemporary_file_directory))
   971     tmpdir = Vtemporary_file_directory;
   972   else
   973     {
   974       char *outf;
   975 #ifndef DOS_NT
   976       outf = getenv ("TMPDIR");
   977       tmpdir = build_string (outf ? outf : "/tmp/");
   978 #else /* DOS_NT */
   979       if ((outf = egetenv ("TMPDIR"))
   980           || (outf = egetenv ("TMP"))
   981           || (outf = egetenv ("TEMP")))
   982         tmpdir = build_string (outf);
   983       else
   984         tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
   985 #endif
   986     }
   987 
   988   {
   989     Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
   990     char *tempfile;
   991 
   992 #ifdef WINDOWSNT
   993     /* Cannot use the result of Fexpand_file_name, because it
   994        downcases the XXXXXX part of the pattern, and mktemp then
   995        doesn't recognize it.  */
   996     if (!NILP (Vw32_downcase_file_names))
   997       {
   998         Lisp_Object dirname = Ffile_name_directory (pattern);
   999 
  1000         if (NILP (dirname))
  1001           pattern = Vtemp_file_name_pattern;
  1002         else
  1003           pattern = concat2 (dirname, Vtemp_file_name_pattern);
  1004       }
  1005 #endif
  1006 
  1007     filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
  1008     tempfile = SSDATA (filename_string);
  1009 
  1010     specpdl_ref count = SPECPDL_INDEX ();
  1011     record_unwind_protect_nothing ();
  1012     fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
  1013     if (fd < 0)
  1014       report_file_error ("Failed to open temporary file using pattern",
  1015                          pattern);
  1016     set_unwind_protect (count, delete_temp_file, filename_string);
  1017     record_unwind_protect_int (close_file_unwind, fd);
  1018   }
  1019 
  1020   start = args[0];
  1021   end = args[1];
  1022   /* Decide coding-system of the contents of the temporary file.  */
  1023   if (!NILP (Vcoding_system_for_write))
  1024     val = Vcoding_system_for_write;
  1025   else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  1026     val = Qraw_text;
  1027   else
  1028     {
  1029       Lisp_Object coding_systems;
  1030       Lisp_Object *args2;
  1031       USE_SAFE_ALLOCA;
  1032       SAFE_NALLOCA (args2, 1, nargs + 1);
  1033       args2[0] = Qcall_process_region;
  1034       memcpy (args2 + 1, args, nargs * sizeof *args);
  1035       coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
  1036       val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
  1037       SAFE_FREE ();
  1038     }
  1039   val = complement_process_encoding_system (val);
  1040 
  1041   {
  1042     specpdl_ref count1 = SPECPDL_INDEX ();
  1043 
  1044     specbind (intern ("coding-system-for-write"), val);
  1045     /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
  1046        happen to get a ".Z" suffix.  */
  1047     specbind (Qfile_name_handler_alist, Qnil);
  1048     write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
  1049 
  1050     unbind_to (count1, Qnil);
  1051   }
  1052 
  1053   if (lseek (fd, 0, SEEK_SET) < 0)
  1054     report_file_error ("Setting file position", filename_string);
  1055 
  1056   /* Note that Fcall_process takes care of binding
  1057      coding-system-for-read.  */
  1058 
  1059   *filename_string_ptr = filename_string;
  1060   return fd;
  1061 }
  1062 
  1063 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  1064        3, MANY, 0,
  1065        doc: /* Send text from START to END to a synchronous process running PROGRAM.
  1066 
  1067 START and END are normally buffer positions specifying the part of the
  1068 buffer to send to the process.
  1069 If START is nil, that means to use the entire buffer contents; END is
  1070 ignored.
  1071 If START is a string, then send that string to the process
  1072 instead of any buffer contents; END is ignored.
  1073 The remaining arguments are optional.
  1074 Delete the text if fourth arg DELETE is non-nil.
  1075 
  1076 Insert output in BUFFER before point; t means current buffer; nil for
  1077  BUFFER means discard it; 0 means discard and don't wait; and `(:file
  1078  FILE)', where FILE is a file name string, means that it should be
  1079  written to that file (if the file already exists it is overwritten).
  1080 BUFFER can be a string which is the name of a buffer.
  1081 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
  1082 REAL-BUFFER says what to do with standard output, as above,
  1083 while STDERR-FILE says what to do with standard error in the child.
  1084 STDERR-FILE may be nil (discard standard error output),
  1085 t (mix it with ordinary output), or a file name string.
  1086 
  1087 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
  1088 Remaining arguments ARGS are passed to PROGRAM at startup as command-line
  1089 arguments.
  1090 
  1091 If PROGRAM is not an absolute file name, `call-process-region' will
  1092 look for PROGRAM in `exec-path' (which is a list of directories).
  1093 
  1094 If BUFFER is 0, `call-process-region' returns immediately with value nil.
  1095 Otherwise it waits for PROGRAM to terminate
  1096 and returns a numeric exit status or a signal description string.
  1097 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
  1098 
  1099 usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)  */)
  1100   (ptrdiff_t nargs, Lisp_Object *args)
  1101 {
  1102   Lisp_Object infile, val;
  1103   specpdl_ref count = SPECPDL_INDEX ();
  1104   Lisp_Object start = args[0];
  1105   Lisp_Object end = args[1];
  1106   bool empty_input;
  1107   int fd;
  1108 
  1109   if (STRINGP (start))
  1110     empty_input = SCHARS (start) == 0;
  1111   else if (NILP (start))
  1112     empty_input = BEG == Z;
  1113   else
  1114     {
  1115       validate_region (&args[0], &args[1]);
  1116       start = args[0];
  1117       end = args[1];
  1118       empty_input = XFIXNUM (start) == XFIXNUM (end);
  1119     }
  1120 
  1121   if (!empty_input)
  1122     fd = create_temp_file (nargs, args, &infile);
  1123   else
  1124     {
  1125       infile = Qnil;
  1126       fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
  1127       if (fd < 0)
  1128         report_file_error ("Opening null device", Qnil);
  1129       record_unwind_protect_int (close_file_unwind, fd);
  1130     }
  1131 
  1132   if (nargs > 3 && !NILP (args[3]))
  1133     {
  1134       if (NILP (start))
  1135         {
  1136           /* No need to save restrictions since we delete everything
  1137              anyway.  */
  1138           labeled_restrictions_remove_in_current_buffer ();
  1139           Fwiden ();
  1140           del_range (BEG, Z);
  1141         }
  1142       else
  1143         Fdelete_region (start, end);
  1144     }
  1145 
  1146   if (nargs > 3)
  1147     {
  1148       args += 2;
  1149       nargs -= 2;
  1150     }
  1151   else
  1152     {
  1153       args[0] = args[2];
  1154       nargs = 2;
  1155     }
  1156   args[1] = infile;
  1157 
  1158   val = call_process (nargs, args, fd,
  1159                       empty_input ? make_invalid_specpdl_ref () : count);
  1160   return unbind_to (count, val);
  1161 }
  1162 
  1163 static char **
  1164 add_env (char **env, char **new_env, char *string)
  1165 {
  1166   char **ep;
  1167   bool ok = 1;
  1168   if (string == NULL)
  1169     return new_env;
  1170 
  1171   /* See if this string duplicates any string already in the env.
  1172      If so, don't put it in.
  1173      When an env var has multiple definitions,
  1174      we keep the definition that comes first in process-environment.  */
  1175   for (ep = env; ok && ep != new_env; ep++)
  1176     {
  1177       char *p = *ep, *q = string;
  1178       while (ok)
  1179         {
  1180           if (*p && *q != *p)
  1181             break;
  1182           if (*q == 0)
  1183             /* The string is a lone variable name; keep it for now, we
  1184                will remove it later.  It is a placeholder for a
  1185                variable that is not to be included in the environment.  */
  1186             break;
  1187           if (*q == '=')
  1188             ok = 0;
  1189           p++, q++;
  1190         }
  1191     }
  1192   if (ok)
  1193     *new_env++ = string;
  1194   return new_env;
  1195 }
  1196 
  1197 #ifndef DOS_NT
  1198 
  1199 /* 'exec' failed inside a child running NAME, with error number ERR.
  1200    Possibly a vforked child needed to allocate a large vector on the
  1201    stack; such a child cannot fall back on malloc because that might
  1202    mess up the allocator's data structures in the parent.
  1203    Report the error and exit the child.  */
  1204 
  1205 static AVOID
  1206 exec_failed (char const *name, int err)
  1207 {
  1208   /* Avoid deadlock if the child's perror writes to a full pipe; the
  1209      pipe's reader is the parent, but with vfork the parent can't
  1210      run until the child exits.  Truncate the diagnostic instead.  */
  1211   fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
  1212 
  1213   errno = err;
  1214   emacs_perror (name);
  1215   _exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
  1216 }
  1217 
  1218 #endif
  1219 
  1220 /* This is the last thing run in a newly forked inferior
  1221    either synchronous or asynchronous.
  1222    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
  1223    Initialize inferior's priority, pgrp, connected dir and environment.
  1224    then exec another program based on new_argv.
  1225 
  1226    CURRENT_DIR is an elisp string giving the path of the current
  1227    directory the subprocess should have.  Since we can't really signal
  1228    a decent error from within the child, this should be verified as an
  1229    executable directory by the parent.
  1230 
  1231    On GNUish hosts, either exec or return an error number.
  1232    On MS-Windows, either return a pid or return -1 and set errno.
  1233    On MS-DOS, either return an exit status or signal an error.  */
  1234 
  1235 static CHILD_SETUP_TYPE
  1236 child_setup (int in, int out, int err, char **new_argv, char **env,
  1237              const char *current_dir)
  1238 {
  1239 #ifdef MSDOS
  1240   char *pwd_var;
  1241   char *temp;
  1242   ptrdiff_t i;
  1243 #endif
  1244 #ifdef WINDOWSNT
  1245   int cpid;
  1246   HANDLE handles[3];
  1247 #else
  1248   pid_t pid = getpid ();
  1249 #endif /* WINDOWSNT */
  1250 
  1251   /* Note that use of alloca is always safe here.  It's obvious for systems
  1252      that do not have true vfork or that have true (stack) alloca.
  1253      If using vfork and C_ALLOCA (when Emacs used to include
  1254      src/alloca.c) it is safe because that changes the superior's
  1255      static variables as if the superior had done alloca and will be
  1256      cleaned up in the usual way. */
  1257 
  1258 #ifndef DOS_NT
  1259     /* We can't signal an Elisp error here; we're in a vfork.  Since
  1260        the callers check the current directory before forking, this
  1261        should only return an error if the directory's permissions
  1262        are changed between the check and this chdir, but we should
  1263        at least check.  */
  1264     if (chdir (current_dir) < 0)
  1265       _exit (EXIT_CANCELED);
  1266 #endif
  1267 
  1268 #ifdef WINDOWSNT
  1269   prepare_standard_handles (in, out, err, handles);
  1270   set_process_dir (current_dir);
  1271   /* Spawn the child.  (See w32proc.c:sys_spawnve).  */
  1272   cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
  1273   reset_standard_handles (in, out, err, handles);
  1274   return cpid;
  1275 
  1276 #else  /* not WINDOWSNT */
  1277 
  1278 #ifndef MSDOS
  1279 
  1280   restore_nofile_limit ();
  1281 
  1282   /* Redirect file descriptors and clear the close-on-exec flag on the
  1283      redirected ones.  IN, OUT, and ERR are close-on-exec so they
  1284      need not be closed explicitly.  */
  1285   dup2 (in, STDIN_FILENO);
  1286   dup2 (out, STDOUT_FILENO);
  1287   dup2 (err, STDERR_FILENO);
  1288 
  1289   setpgid (0, 0);
  1290   tcsetpgrp (0, pid);
  1291 
  1292   int errnum = emacs_exec_file (new_argv[0], new_argv, env);
  1293   exec_failed (new_argv[0], errnum);
  1294 
  1295 #else /* MSDOS */
  1296   i = strlen (current_dir);
  1297   pwd_var = xmalloc (i + 5);
  1298   temp = pwd_var + 4;
  1299   memcpy (pwd_var, "PWD=", 4);
  1300   stpcpy (temp, current_dir);
  1301 
  1302   if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
  1303     {
  1304       temp += 2;
  1305       i -= 2;
  1306     }
  1307 
  1308   /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
  1309   while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
  1310     temp[--i] = 0;
  1311 
  1312   pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
  1313   xfree (pwd_var);
  1314   if (pid == -1)
  1315     /* An error occurred while trying to run the subprocess.  */
  1316     report_file_error ("Spawning child process", Qnil);
  1317   return pid;
  1318 #endif  /* MSDOS */
  1319 #endif  /* not WINDOWSNT */
  1320 }
  1321 
  1322 #if USABLE_POSIX_SPAWN
  1323 
  1324 /* Set up ACTIONS and ATTRIBUTES for `posix_spawn'.  Return an error
  1325    number.  */
  1326 
  1327 static int
  1328 emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions,
  1329                                 int std_in, int std_out, int std_err,
  1330                                 const char *cwd)
  1331 {
  1332   int error = posix_spawn_file_actions_init (actions);
  1333   if (error != 0)
  1334     return error;
  1335 
  1336   error = posix_spawn_file_actions_adddup2 (actions, std_in,
  1337                                             STDIN_FILENO);
  1338   if (error != 0)
  1339     goto out;
  1340 
  1341   error = posix_spawn_file_actions_adddup2 (actions, std_out,
  1342                                             STDOUT_FILENO);
  1343   if (error != 0)
  1344     goto out;
  1345 
  1346   error = posix_spawn_file_actions_adddup2 (actions,
  1347                                             std_err < 0 ? std_out
  1348                                                         : std_err,
  1349                                             STDERR_FILENO);
  1350   if (error != 0)
  1351     goto out;
  1352 
  1353   /* Haiku appears to have linkable posix_spawn_file_actions_chdir,
  1354      but it always fails.  So use the _np function instead.  */
  1355 #if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU
  1356   error = posix_spawn_file_actions_addchdir (actions, cwd);
  1357 #else
  1358   error = posix_spawn_file_actions_addchdir_np (actions, cwd);
  1359 #endif
  1360   if (error != 0)
  1361     goto out;
  1362 
  1363  out:
  1364   if (error != 0)
  1365     posix_spawn_file_actions_destroy (actions);
  1366   return error;
  1367 }
  1368 
  1369 static int
  1370 emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
  1371                                    const sigset_t *oldset)
  1372 {
  1373   int error = posix_spawnattr_init (attributes);
  1374   if (error != 0)
  1375     return error;
  1376 
  1377   error = posix_spawnattr_setflags (attributes,
  1378                                     POSIX_SPAWN_SETSID
  1379                                     | POSIX_SPAWN_SETSIGDEF
  1380                                     | POSIX_SPAWN_SETSIGMASK);
  1381   if (error != 0)
  1382     goto out;
  1383 
  1384   sigset_t sigdefault;
  1385   sigemptyset (&sigdefault);
  1386 
  1387 #ifdef DARWIN_OS
  1388   /* Work around a macOS bug, where SIGCHLD is apparently
  1389      delivered to a vforked child instead of to its parent.  See:
  1390      https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
  1391   */
  1392   sigaddset (&sigdefault, SIGCHLD);
  1393 #endif
  1394 
  1395   sigaddset (&sigdefault, SIGINT);
  1396   sigaddset (&sigdefault, SIGQUIT);
  1397 #ifdef SIGPROF
  1398   sigaddset (&sigdefault, SIGPROF);
  1399 #endif
  1400 
  1401   /* Emacs ignores SIGPIPE, but the child should not.  */
  1402   sigaddset (&sigdefault, SIGPIPE);
  1403   /* Likewise for SIGPROF.  */
  1404 #ifdef SIGPROF
  1405   sigaddset (&sigdefault, SIGPROF);
  1406 #endif
  1407 
  1408   error = posix_spawnattr_setsigdefault (attributes, &sigdefault);
  1409   if (error != 0)
  1410     goto out;
  1411 
  1412   /* Stop blocking SIGCHLD in the child.  */
  1413   error = posix_spawnattr_setsigmask (attributes, oldset);
  1414   if (error != 0)
  1415     goto out;
  1416 
  1417  out:
  1418   if (error != 0)
  1419     posix_spawnattr_destroy (attributes);
  1420 
  1421   return error;
  1422 }
  1423 
  1424 #endif
  1425 
  1426 /* Start a new asynchronous subprocess.  If successful, return zero
  1427    and store the process identifier of the new process in *NEWPID.
  1428    Use STDIN, STDOUT, and STDERR as standard streams for the new
  1429    process.  Use ARGV as argument vector for the new process; use
  1430    process image file ARGV[0].  Use ENVP for the environment block for
  1431    the new process.  Use CWD as working directory for the new process.
  1432    If PTY is not NULL, it must be a pseudoterminal device.  If PTY is
  1433    NULL, don't perform any terminal setup.  OLDSET must be a pointer
  1434    to a signal set initialized by `block_child_signal'.  Before
  1435    calling this function, call `block_input' and `block_child_signal';
  1436    afterwards, call `unblock_input' and `unblock_child_signal'.  Be
  1437    sure to call `unblock_child_signal' only after registering NEWPID
  1438    in a list where `handle_child_signal' can find it!  */
  1439 
  1440 int
  1441 emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
  1442              char **argv, char **envp, const char *cwd,
  1443              const char *pty_name, bool pty_in, bool pty_out,
  1444              const sigset_t *oldset)
  1445 {
  1446 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
  1447   /* Android 10 and later don't allow directly executing programs
  1448      installed in the application data directory.  Emacs provides a
  1449      loader binary which replaces the `execve' system call for it and
  1450      all its children.  On these systems, rewrite the command line to
  1451      call that loader binary instead.  */
  1452 
  1453   if (android_rewrite_spawn_argv ((const char ***) &argv))
  1454     return 1;
  1455 #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
  1456 
  1457 
  1458 #if USABLE_POSIX_SPAWN
  1459   /* Prefer the simpler `posix_spawn' if available.  `posix_spawn'
  1460      doesn't yet support setting up pseudoterminals, so we fall back
  1461      to `vfork' if we're supposed to use a pseudoterminal.  */
  1462 
  1463   bool use_posix_spawn = pty_name == NULL;
  1464 
  1465   posix_spawn_file_actions_t actions;
  1466   posix_spawnattr_t attributes;
  1467 
  1468   if (use_posix_spawn)
  1469     {
  1470       /* Initialize optional attributes before blocking. */
  1471       int error = emacs_posix_spawn_init_actions (&actions, std_in,
  1472                                               std_out, std_err, cwd);
  1473       if (error != 0)
  1474         return error;
  1475 
  1476       error = emacs_posix_spawn_init_attributes (&attributes, oldset);
  1477       if (error != 0)
  1478         return error;
  1479     }
  1480 #endif
  1481 
  1482   int pid;
  1483   int vfork_error;
  1484 
  1485   eassert (input_blocked_p ());
  1486 
  1487 #if USABLE_POSIX_SPAWN
  1488   if (use_posix_spawn)
  1489     {
  1490       vfork_error = posix_spawn (&pid, argv[0], &actions, &attributes,
  1491                                  argv, envp);
  1492       if (vfork_error != 0)
  1493         pid = -1;
  1494 
  1495       int error = posix_spawn_file_actions_destroy (&actions);
  1496       if (error != 0)
  1497         {
  1498           errno = error;
  1499           emacs_perror ("posix_spawn_file_actions_destroy");
  1500         }
  1501 
  1502       error = posix_spawnattr_destroy (&attributes);
  1503       if (error != 0)
  1504         {
  1505           errno = error;
  1506           emacs_perror ("posix_spawnattr_destroy");
  1507         }
  1508 
  1509       goto fork_done;
  1510     }
  1511 #endif
  1512 
  1513 #ifndef WINDOWSNT
  1514   /* vfork, and prevent local vars from being clobbered by the vfork.  */
  1515   pid_t *volatile newpid_volatile = newpid;
  1516   const char *volatile cwd_volatile = cwd;
  1517   const char *volatile ptyname_volatile = pty_name;
  1518   bool volatile ptyin_volatile = pty_in;
  1519   bool volatile ptyout_volatile = pty_out;
  1520   char **volatile argv_volatile = argv;
  1521   int volatile stdin_volatile = std_in;
  1522   int volatile stdout_volatile = std_out;
  1523   int volatile stderr_volatile = std_err;
  1524   char **volatile envp_volatile = envp;
  1525   const sigset_t *volatile oldset_volatile = oldset;
  1526 
  1527 #ifdef DARWIN_OS
  1528   /* Darwin doesn't let us run setsid after a vfork, so use fork when
  1529      necessary.  Below, we reset SIGCHLD handling after a vfork, as
  1530      apparently macOS can mistakenly deliver SIGCHLD to the child.  */
  1531   if (pty_in || pty_out)
  1532     pid = fork ();
  1533   else
  1534     pid = VFORK ();
  1535 #else
  1536   pid = vfork ();
  1537 #endif
  1538 
  1539   newpid = newpid_volatile;
  1540   cwd = cwd_volatile;
  1541   pty_name = ptyname_volatile;
  1542   pty_in = ptyin_volatile;
  1543   pty_out = ptyout_volatile;
  1544   argv = argv_volatile;
  1545   std_in = stdin_volatile;
  1546   std_out = stdout_volatile;
  1547   std_err = stderr_volatile;
  1548   envp = envp_volatile;
  1549   oldset = oldset_volatile;
  1550 
  1551   if (pid == 0)
  1552 #endif /* not WINDOWSNT */
  1553     {
  1554       /* Make the pty be the controlling terminal of the process.  */
  1555 #ifdef HAVE_PTYS
  1556       dissociate_controlling_tty ();
  1557 
  1558       /* Make the pty's terminal the controlling terminal.  */
  1559       if (pty_in && std_in >= 0)
  1560         {
  1561 #ifdef TIOCSCTTY
  1562           /* We ignore the return value
  1563              because faith@cs.unc.edu says that is necessary on Linux.  */
  1564           ioctl (std_in, TIOCSCTTY, 0);
  1565 #endif
  1566         }
  1567 #if defined (LDISC1)
  1568       if (pty_in && std_in >= 0)
  1569         {
  1570           struct termios t;
  1571           tcgetattr (std_in, &t);
  1572           t.c_lflag = LDISC1;
  1573           if (tcsetattr (std_in, TCSANOW, &t) < 0)
  1574             emacs_perror ("create_process/tcsetattr LDISC1");
  1575         }
  1576 #else
  1577 #if defined (NTTYDISC) && defined (TIOCSETD)
  1578       if (pty_in && std_in >= 0)
  1579         {
  1580           /* Use new line discipline.  */
  1581           int ldisc = NTTYDISC;
  1582           ioctl (std_in, TIOCSETD, &ldisc);
  1583         }
  1584 #endif
  1585 #endif
  1586 
  1587 #if !defined (DONT_REOPEN_PTY)
  1588 /*** There is a suggestion that this ought to be a
  1589      conditional on TIOCSPGRP, or !defined TIOCSCTTY.
  1590      Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
  1591      that system does seem to need this code, even though
  1592      both TIOCSCTTY is defined.  */
  1593         /* Now close the pty (if we had it open) and reopen it.
  1594            This makes the pty the controlling terminal of the subprocess.  */
  1595       if (pty_name)
  1596         {
  1597 
  1598           /* I wonder if emacs_close (emacs_open (pty, ...))
  1599              would work?  */
  1600           if (pty_in && std_in >= 0)
  1601             emacs_close (std_in);
  1602           int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
  1603           if (pty_in)
  1604             std_in = ptyfd;
  1605           if (pty_out)
  1606             std_out = ptyfd;
  1607           if (std_in < 0)
  1608             {
  1609               emacs_perror (pty_name);
  1610               _exit (EXIT_CANCELED);
  1611             }
  1612 
  1613         }
  1614 #endif /* not DONT_REOPEN_PTY */
  1615 
  1616 #ifdef SETUP_SLAVE_PTY
  1617       if (pty_in && std_in >= 0)
  1618         {
  1619           SETUP_SLAVE_PTY;
  1620         }
  1621 #endif /* SETUP_SLAVE_PTY */
  1622 #endif /* HAVE_PTYS */
  1623 
  1624 #ifdef DARWIN_OS
  1625       /* Work around a macOS bug, where SIGCHLD is apparently
  1626          delivered to a vforked child instead of to its parent.  See:
  1627          https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
  1628       */
  1629       signal (SIGCHLD, SIG_DFL);
  1630 #endif
  1631 
  1632       signal (SIGINT, SIG_DFL);
  1633       signal (SIGQUIT, SIG_DFL);
  1634 #ifdef SIGPROF
  1635       signal (SIGPROF, SIG_DFL);
  1636 #endif
  1637 
  1638       /* Emacs ignores SIGPIPE, but the child should not.  */
  1639       signal (SIGPIPE, SIG_DFL);
  1640       /* Likewise for SIGPROF.  */
  1641 #ifdef SIGPROF
  1642       signal (SIGPROF, SIG_DFL);
  1643 #endif
  1644 
  1645 #ifdef subprocesses
  1646       /* Stop blocking SIGCHLD in the child.  */
  1647       unblock_child_signal (oldset);
  1648 
  1649       if (pty_out)
  1650         child_setup_tty (std_out);
  1651 #endif
  1652 
  1653       if (std_err < 0)
  1654         std_err = std_out;
  1655 #ifdef WINDOWSNT
  1656       pid = child_setup (std_in, std_out, std_err, argv, envp, cwd);
  1657 #else  /* not WINDOWSNT */
  1658       child_setup (std_in, std_out, std_err, argv, envp, cwd);
  1659 #endif /* not WINDOWSNT */
  1660     }
  1661 
  1662   /* Back in the parent process.  */
  1663 
  1664   vfork_error = pid < 0 ? errno : 0;
  1665 
  1666 #if USABLE_POSIX_SPAWN
  1667  fork_done:
  1668 #endif
  1669   if (pid < 0)
  1670     {
  1671       eassert (0 < vfork_error);
  1672       return vfork_error;
  1673     }
  1674 
  1675   eassert (0 < pid);
  1676   *newpid = pid;
  1677   return 0;
  1678 }
  1679 
  1680 static bool
  1681 getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
  1682                    ptrdiff_t *valuelen, Lisp_Object env)
  1683 {
  1684   for (; CONSP (env); env = XCDR (env))
  1685     {
  1686       Lisp_Object entry = XCAR (env);
  1687       if (STRINGP (entry)
  1688           && SBYTES (entry) >= varlen
  1689 #ifdef WINDOWSNT
  1690           /* NT environment variables are case insensitive.  */
  1691           && ! strnicmp (SSDATA (entry), var, varlen)
  1692 #else  /* not WINDOWSNT */
  1693           && ! memcmp (SDATA (entry), var, varlen)
  1694 #endif /* not WINDOWSNT */
  1695           )
  1696         {
  1697           if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
  1698             {
  1699               *value = SSDATA (entry) + (varlen + 1);
  1700               *valuelen = SBYTES (entry) - (varlen + 1);
  1701               return 1;
  1702             }
  1703           else if (SBYTES (entry) == varlen)
  1704             {
  1705               /* Lone variable names in Vprocess_environment mean that
  1706                  variable should be removed from the environment. */
  1707               *value = NULL;
  1708               return 1;
  1709             }
  1710         }
  1711     }
  1712   return 0;
  1713 }
  1714 
  1715 static bool
  1716 getenv_internal (const char *var, ptrdiff_t varlen, char **value,
  1717                  ptrdiff_t *valuelen, Lisp_Object frame)
  1718 {
  1719   /* Try to find VAR in Vprocess_environment first.  */
  1720   if (getenv_internal_1 (var, varlen, value, valuelen,
  1721                          Vprocess_environment))
  1722     return *value ? 1 : 0;
  1723 
  1724   /* On Windows we make some modifications to Emacs' environment
  1725      without recording them in Vprocess_environment.  */
  1726 #ifdef WINDOWSNT
  1727   {
  1728     char *tmpval = getenv (var);
  1729     if (tmpval)
  1730       {
  1731         *value = tmpval;
  1732         *valuelen = strlen (tmpval);
  1733         return 1;
  1734       }
  1735   }
  1736 #endif
  1737 
  1738   /* For DISPLAY try to get the values from the frame or the initial env.  */
  1739   if (strcmp (var, "DISPLAY") == 0)
  1740     {
  1741 #ifndef HAVE_PGTK
  1742       Lisp_Object display
  1743         = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
  1744       if (STRINGP (display))
  1745         {
  1746           *value    = SSDATA (display);
  1747           *valuelen = SBYTES (display);
  1748           return 1;
  1749         }
  1750 #endif
  1751       /* If still not found, Look for DISPLAY in Vinitial_environment.  */
  1752       if (getenv_internal_1 (var, varlen, value, valuelen,
  1753                              Vinitial_environment))
  1754         return *value ? 1 : 0;
  1755     }
  1756 
  1757   return 0;
  1758 }
  1759 
  1760 DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
  1761        doc: /* Get the value of environment variable VARIABLE.
  1762 VARIABLE should be a string.  Value is nil if VARIABLE is undefined in
  1763 the environment.  Otherwise, value is a string.
  1764 
  1765 This function searches `process-environment' for VARIABLE.
  1766 
  1767 If optional parameter ENV is a list, then search this list instead of
  1768 `process-environment', and return t when encountering a negative entry
  1769 \(an entry for a variable with no value).  */)
  1770   (Lisp_Object variable, Lisp_Object env)
  1771 {
  1772   char *value;
  1773   ptrdiff_t valuelen;
  1774 
  1775   CHECK_STRING (variable);
  1776   if (CONSP (env))
  1777     {
  1778       if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
  1779                              &value, &valuelen, env))
  1780         return value ? make_string (value, valuelen) : Qt;
  1781       else
  1782         return Qnil;
  1783     }
  1784   else if (getenv_internal (SSDATA (variable), SBYTES (variable),
  1785                             &value, &valuelen, env))
  1786     return make_string (value, valuelen);
  1787   else
  1788     return Qnil;
  1789 }
  1790 
  1791 /* A version of getenv that consults the Lisp environment lists,
  1792    easily callable from C.  This is usually called from egetenv.  */
  1793 char *
  1794 egetenv_internal (const char *var, ptrdiff_t len)
  1795 {
  1796   char *value;
  1797   ptrdiff_t valuelen;
  1798 
  1799   if (getenv_internal (var, len, &value, &valuelen, Qnil))
  1800     return value;
  1801   else
  1802     return 0;
  1803 }
  1804 
  1805 /* Create a new environment block.  You can pass the returned pointer
  1806    to `execve'.  Add unwind protections for all newly-allocated
  1807    objects.  Don't call any Lisp code or the garbage collector while
  1808    the block is active.  */
  1809 
  1810 char **
  1811 make_environment_block (Lisp_Object current_dir)
  1812 {
  1813   char **env;
  1814   char *pwd_var;
  1815 
  1816   {
  1817     char *temp;
  1818     ptrdiff_t i;
  1819 
  1820     i = SBYTES (current_dir);
  1821     pwd_var = xmalloc (i + 5);
  1822     record_unwind_protect_ptr (xfree, pwd_var);
  1823     temp = pwd_var + 4;
  1824     memcpy (pwd_var, "PWD=", 4);
  1825     lispstpcpy (temp, current_dir);
  1826 
  1827 #ifdef DOS_NT
  1828     /* Get past the drive letter, so that d:/ is left alone.  */
  1829     if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
  1830       {
  1831         temp += 2;
  1832         i -= 2;
  1833       }
  1834 #endif /* DOS_NT */
  1835 
  1836     /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
  1837     while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
  1838       temp[--i] = 0;
  1839   }
  1840 
  1841   /* Set `env' to a vector of the strings in the environment.  */
  1842 
  1843   {
  1844     register Lisp_Object tem;
  1845     register char **new_env;
  1846     char **p, **q;
  1847     register int new_length;
  1848     Lisp_Object display = Qnil;
  1849 
  1850     new_length = 0;
  1851 
  1852     for (tem = Vprocess_environment;
  1853          CONSP (tem) && STRINGP (XCAR (tem));
  1854          tem = XCDR (tem))
  1855       {
  1856         if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
  1857             && (SDATA (XCAR (tem)) [7] == '\0'
  1858                 || SDATA (XCAR (tem)) [7] == '='))
  1859           /* DISPLAY is specified in process-environment.  */
  1860           display = Qt;
  1861         new_length++;
  1862       }
  1863 
  1864     /* If not provided yet, use the frame's DISPLAY.  */
  1865     if (NILP (display))
  1866       {
  1867         Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
  1868 
  1869 #ifdef HAVE_PGTK
  1870         /* The only time GDK actually returns correct information is
  1871            when it's running under X Windows.  DISPLAY shouldn't be
  1872            set to a Wayland display either, since that's an X specific
  1873            variable.  */
  1874         if (FRAME_WINDOW_P (SELECTED_FRAME ())
  1875             && strcmp (G_OBJECT_TYPE_NAME (FRAME_X_DISPLAY (SELECTED_FRAME ())),
  1876                        "GdkX11Display"))
  1877           tmp = Qnil;
  1878 #endif
  1879 
  1880         if (!STRINGP (tmp) && CONSP (Vinitial_environment))
  1881           /* If still not found, Look for DISPLAY in Vinitial_environment.  */
  1882           tmp = Fgetenv_internal (build_string ("DISPLAY"),
  1883                                   Vinitial_environment);
  1884         if (STRINGP (tmp))
  1885           {
  1886             display = tmp;
  1887             new_length++;
  1888           }
  1889       }
  1890 
  1891     /* new_length + 2 to include PWD and terminating 0.  */
  1892     env = new_env = xnmalloc (new_length + 2, sizeof *env);
  1893     record_unwind_protect_ptr (xfree, env);
  1894     /* If we have a PWD envvar, pass one down,
  1895        but with corrected value.  */
  1896     if (egetenv ("PWD"))
  1897       *new_env++ = pwd_var;
  1898 
  1899     if (STRINGP (display))
  1900       {
  1901         char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display));
  1902         record_unwind_protect_ptr (xfree, vdata);
  1903         lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
  1904         new_env = add_env (env, new_env, vdata);
  1905       }
  1906 
  1907     /* Overrides.  */
  1908     for (tem = Vprocess_environment;
  1909          CONSP (tem) && STRINGP (XCAR (tem));
  1910          tem = XCDR (tem))
  1911       new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
  1912 
  1913     *new_env = 0;
  1914 
  1915     /* Remove variable names without values.  */
  1916     p = q = env;
  1917     while (*p != 0)
  1918       {
  1919         while (*q != 0 && strchr (*q, '=') == NULL)
  1920           q++;
  1921         *p = *q++;
  1922         if (*p != 0)
  1923           p++;
  1924       }
  1925   }
  1926 
  1927   return env;
  1928 }
  1929 
  1930 
  1931 /* This is run before init_cmdargs.  */
  1932 
  1933 void
  1934 init_callproc_1 (void)
  1935 {
  1936   Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0);
  1937   Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
  1938 
  1939   Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0);
  1940   Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
  1941 
  1942   /* Check the EMACSPATH environment variable, defaulting to the
  1943      PATH_EXEC path from epaths.h.  */
  1944   Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0);
  1945   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
  1946   /* FIXME?  For ns, path_exec should go at the front?  */
  1947   Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
  1948 }
  1949 
  1950 /* This is run after init_cmdargs, when Vinstallation_directory is valid.  */
  1951 
  1952 void
  1953 init_callproc (void)
  1954 {
  1955   bool data_dir = egetenv ("EMACSDATA") != 0;
  1956 
  1957   char *sh;
  1958   Lisp_Object tempdir;
  1959 
  1960   if (!NILP (Vinstallation_directory))
  1961     {
  1962       /* Add to the path the lib-src subdir of the installation dir.  */
  1963       Lisp_Object tem;
  1964       tem = Fexpand_file_name (build_string ("lib-src"),
  1965                                Vinstallation_directory);
  1966 #ifndef MSDOS
  1967           /* MSDOS uses wrapped binaries, so don't do this.  */
  1968       if (NILP (Fmember (tem, Vexec_path)))
  1969         {
  1970           /* Running uninstalled, so default to tem rather than PATH_EXEC.  */
  1971           Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0);
  1972           Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
  1973         }
  1974 
  1975       Vexec_directory = Ffile_name_as_directory (tem);
  1976 #endif /* not MSDOS */
  1977 
  1978       /* Maybe use ../etc as well as ../lib-src.  */
  1979       if (data_dir == 0)
  1980         {
  1981           tem = Fexpand_file_name (build_string ("etc"),
  1982                                    Vinstallation_directory);
  1983           Vdoc_directory = Ffile_name_as_directory (tem);
  1984         }
  1985     }
  1986 
  1987   /* Look for the files that should be in etc.  We don't use
  1988      Vinstallation_directory, because these files are never installed
  1989      near the executable, and they are never in the build
  1990      directory when that's different from the source directory.
  1991 
  1992      Instead, if these files are not in the nominal place, we try the
  1993      source directory.  */
  1994   if (data_dir == 0)
  1995     {
  1996       Lisp_Object tem, srcdir;
  1997       Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
  1998 
  1999       srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
  2000 
  2001       tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
  2002       if (!NILP (Fequal (srcdir, Vinvocation_directory))
  2003           || NILP (Ffile_exists_p (tem)) || !NILP (Vinstallation_directory))
  2004         {
  2005           Lisp_Object newdir;
  2006           newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
  2007           tem = Fexpand_file_name (build_string ("NEWS"), newdir);
  2008           if (!NILP (Ffile_exists_p (tem)))
  2009             Vdata_directory = newdir;
  2010         }
  2011     }
  2012 
  2013   if (!will_dump_p ())
  2014     {
  2015       tempdir = Fdirectory_file_name (Vexec_directory);
  2016       if (! file_accessible_directory_p (tempdir))
  2017         dir_warning ("arch-dependent data dir", Vexec_directory);
  2018     }
  2019 
  2020   tempdir = Fdirectory_file_name (Vdata_directory);
  2021   if (! file_accessible_directory_p (tempdir))
  2022     dir_warning ("arch-independent data dir", Vdata_directory);
  2023 
  2024   sh = getenv ("SHELL");
  2025 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
  2026   /* The Android shell is found under /system/bin, not /bin.  */
  2027   Vshell_file_name = build_string (sh ? sh : "/system/bin/sh");
  2028 #else
  2029   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
  2030 #endif
  2031 
  2032   Lisp_Object gamedir = Qnil;
  2033   if (PATH_GAME)
  2034     {
  2035       const char *cpath_game = PATH_GAME;
  2036 #ifdef WINDOWSNT
  2037       /* On MS-Windows, PATH_GAME normally starts with a literal
  2038          "%emacs_dir%", so it will never work without some tweaking.  */
  2039       cpath_game = w32_relocate (cpath_game);
  2040 #endif
  2041       Lisp_Object path_game = build_unibyte_string (cpath_game);
  2042       if (file_accessible_directory_p (path_game))
  2043         gamedir = path_game;
  2044       else if (errno != ENOENT && errno != ENOTDIR
  2045 #ifdef DOS_NT
  2046                /* DOS/Windows sometimes return EACCES for bad file names  */
  2047                && errno != EACCES
  2048 #endif
  2049                )
  2050         dir_warning ("game dir", path_game);
  2051     }
  2052   Vshared_game_score_directory = gamedir;
  2053 }
  2054 
  2055 void
  2056 set_initial_environment (void)
  2057 {
  2058   char **envp;
  2059   for (envp = environ; *envp; envp++)
  2060     Vprocess_environment = Fcons (build_string (*envp),
  2061                                   Vprocess_environment);
  2062   /* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
  2063      to use `delete' and friends on process-environment.  */
  2064   Vinitial_environment = Fcopy_sequence (Vprocess_environment);
  2065 }
  2066 
  2067 void
  2068 syms_of_callproc (void)
  2069 {
  2070 #ifndef DOS_NT
  2071   Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
  2072 #else  /* DOS_NT */
  2073   Vtemp_file_name_pattern = build_string ("emXXXXXX");
  2074 #endif
  2075   staticpro (&Vtemp_file_name_pattern);
  2076 
  2077 #ifdef MSDOS
  2078   synch_process_tempfile = make_fixnum (0);
  2079   staticpro (&synch_process_tempfile);
  2080 #endif
  2081 
  2082   DEFVAR_LISP ("shell-file-name", Vshell_file_name,
  2083                doc: /* File name to load inferior shells from.
  2084 Initialized from the SHELL environment variable, or to a system-dependent
  2085 default if SHELL is unset.  See Info node `(elisp)Security Considerations'.  */);
  2086 
  2087   DEFVAR_LISP ("exec-path", Vexec_path,
  2088                doc: /* List of directories to search programs to run in subprocesses.
  2089 Each element is a string (directory name) or nil (try default directory).
  2090 
  2091 By default the last element of this list is `exec-directory'. The
  2092 last element is not always used, for example in shell completion
  2093 \(`shell-dynamic-complete-command').  */);
  2094 
  2095   DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
  2096                doc: /* List of suffixes to try to find executable file names.
  2097 Each element is a string.  */);
  2098   Vexec_suffixes = Qnil;
  2099 
  2100   DEFVAR_LISP ("exec-directory", Vexec_directory,
  2101                doc: /* Directory for executables for Emacs to invoke.
  2102 More generally, this includes any architecture-dependent files
  2103 that are built and installed from the Emacs distribution.  */);
  2104 
  2105   DEFVAR_LISP ("data-directory", Vdata_directory,
  2106                doc: /* Directory of machine-independent files that come with GNU Emacs.
  2107 These are files intended for Emacs to use while it runs.  */);
  2108 
  2109   DEFVAR_LISP ("doc-directory", Vdoc_directory,
  2110                doc: /* Directory containing the DOC file that comes with GNU Emacs.
  2111 This is usually the same as `data-directory'.  */);
  2112 
  2113   DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
  2114                doc: /* For internal use by the build procedure only.
  2115 This is the name of the directory in which the build procedure installed
  2116 Emacs's info files; the default value for `Info-default-directory-list'
  2117 includes this.  */);
  2118   Vconfigure_info_directory = build_string (PATH_INFO);
  2119 
  2120   DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
  2121                doc: /* Directory of score files for games which come with GNU Emacs.
  2122 If this variable is nil, then Emacs is unable to use a shared directory.  */);
  2123 
  2124   DEFVAR_LISP ("initial-environment", Vinitial_environment,
  2125                doc: /* List of environment variables inherited from the parent process.
  2126 Each element should be a string of the form ENVVARNAME=VALUE.
  2127 The elements must normally be decoded (using `locale-coding-system') for use.  */);
  2128   Vinitial_environment = Qnil;
  2129 
  2130   DEFVAR_LISP ("process-environment", Vprocess_environment,
  2131                doc: /* List of overridden environment variables for subprocesses to inherit.
  2132 Each element should be a string of the form ENVVARNAME=VALUE.
  2133 
  2134 Entries in this list take precedence to those in the frame-local
  2135 environments.  Therefore, let-binding `process-environment' is an easy
  2136 way to temporarily change the value of an environment variable,
  2137 irrespective of where it comes from.  To use `process-environment' to
  2138 remove an environment variable, include only its name in the list,
  2139 without "=VALUE".
  2140 
  2141 This variable is set to nil when Emacs starts.
  2142 
  2143 If multiple entries define the same variable, the first one always
  2144 takes precedence.
  2145 
  2146 Non-ASCII characters are encoded according to the initial value of
  2147 `locale-coding-system', i.e. the elements must normally be decoded for
  2148 use.
  2149 
  2150 See `setenv' and `getenv'.  */);
  2151   Vprocess_environment = Qnil;
  2152 
  2153   DEFVAR_LISP ("ctags-program-name", Vctags_program_name,
  2154     doc: /* Name of the `ctags' program distributed with Emacs.
  2155 Use this instead of calling `ctags' directly, as `ctags' may have been
  2156 renamed to comply with executable naming restrictions on the system.  */);
  2157 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2158   Vctags_program_name = build_pure_c_string ("ctags");
  2159 #else
  2160   Vctags_program_name = build_pure_c_string ("libctags.so");
  2161 #endif
  2162 
  2163   DEFVAR_LISP ("etags-program-name", Vetags_program_name,
  2164     doc: /* Name of the `etags' program distributed with Emacs.
  2165 Use this instead of calling `etags' directly, as `etags' may have been
  2166 renamed to comply with executable naming restrictions on the system.  */);
  2167 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2168   Vetags_program_name = build_pure_c_string ("etags");
  2169 #else
  2170   Vetags_program_name = build_pure_c_string ("libetags.so");
  2171 #endif
  2172 
  2173   DEFVAR_LISP ("hexl-program-name", Vhexl_program_name,
  2174     doc: /* Name of the `hexl' program distributed with Emacs.
  2175 Use this instead of calling `hexl' directly, as `hexl' may have been
  2176 renamed to comply with executable naming restrictions on the system.  */);
  2177 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2178   Vhexl_program_name = build_pure_c_string ("hexl");
  2179 #else
  2180   Vhexl_program_name = build_pure_c_string ("libhexl.so");
  2181 #endif
  2182 
  2183   DEFVAR_LISP ("emacsclient-program-name", Vemacsclient_program_name,
  2184     doc: /* Name of the `emacsclient' program distributed with Emacs.
  2185 Use this instead of calling `emacsclient' directly, as `emacsclient'
  2186 may have been renamed to comply with executable naming restrictions on
  2187 the system.  */);
  2188 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2189   Vemacsclient_program_name = build_pure_c_string ("emacsclient");
  2190 #else
  2191   Vemacsclient_program_name = build_pure_c_string ("libemacsclient.so");
  2192 #endif
  2193 
  2194   DEFVAR_LISP ("movemail-program-name", Vmovemail_program_name,
  2195     doc: /* Name of the `movemail' program distributed with Emacs.
  2196 Use this instead of calling `movemail' directly, as `movemail'
  2197 may have been renamed to comply with executable naming restrictions on
  2198 the system.  */);
  2199   /* Don't change the name of `movemail' if Emacs is being built to
  2200      use movemail from another source.  */
  2201 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY    \
  2202   || defined HAVE_MAILUTILS
  2203   Vmovemail_program_name = build_pure_c_string ("movemail");
  2204 #else
  2205   Vmovemail_program_name = build_pure_c_string ("libmovemail.so");
  2206 #endif
  2207 
  2208   DEFVAR_LISP ("ebrowse-program-name", Vebrowse_program_name,
  2209     doc: /* Name of the `ebrowse' program distributed with Emacs.
  2210 Use this instead of calling `ebrowse' directly, as `ebrowse'
  2211 may have been renamed to comply with executable naming restrictions on
  2212 the system.  */);
  2213 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2214   Vebrowse_program_name = build_pure_c_string ("ebrowse");
  2215 #else
  2216   Vebrowse_program_name = build_pure_c_string ("libebrowse.so");
  2217 #endif
  2218 
  2219   DEFVAR_LISP ("rcs2log-program-name", Vrcs2log_program_name,
  2220     doc: /* Name of the `rcs2log' program distributed with Emacs.
  2221 Use this instead of calling `rcs2log' directly, as `rcs2log'
  2222 may have been renamed to comply with executable naming restrictions on
  2223 the system.  */);
  2224 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
  2225   Vrcs2log_program_name = build_pure_c_string ("rcs2log");
  2226 #else /* HAVE_ANDROID && !ANDROID_STUBIFY */
  2227   Vrcs2log_program_name = build_pure_c_string ("librcs2log.so");
  2228 #endif /* !HAVE_ANDROID || ANDROID_STUBIFY */
  2229 
  2230   defsubr (&Scall_process);
  2231   defsubr (&Sgetenv_internal);
  2232   defsubr (&Scall_process_region);
  2233 }