src/callproc.c

   1 /* Synchronous subprocess invocation for GNU Emacs.
   2    Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <signal.h>
  22 #include <errno.h>
  23
  24 #include <config.h>
  25 #include <stdio.h>
  26
  27 extern int errno;
  28 extern char *strerror ();
  29
  30 /* Define SIGCHLD as an alias for SIGCLD.  */
  31
  32 #if !defined (SIGCHLD) && defined (SIGCLD)
  33 #define SIGCHLD SIGCLD
  34 #endif /* SIGCLD */
  35
  36 #include <sys/types.h>
  37
  38 #include <sys/file.h>
  39 #ifdef USG5
  40 #define INCLUDED_FCNTL
  41 #include <fcntl.h>
  42 #endif
  43
  44 #ifdef WINDOWSNT
  45 #define NOMINMAX
  46 #include <windows.h>
  47 #include <stdlib.h>     /* for proper declaration of environ */
  48 #include <fcntl.h>
  49 #include "nt.h"
  50 #define _P_NOWAIT 1     /* from process.h */
  51 #endif
  52
  53 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
  54 #include "msdos.h"
  55 #define INCLUDED_FCNTL
  56 #include <fcntl.h>
  57 #include <sys/stat.h>
  58 #include <sys/param.h>
  59 #include <errno.h>
  60 #endif /* MSDOS */
  61
  62 #ifndef O_RDONLY
  63 #define O_RDONLY 0
  64 #endif
  65
  66 #ifndef O_WRONLY
  67 #define O_WRONLY 1
  68 #endif
  69
  70 #include "lisp.h"
  71 #include "commands.h"
  72 #include "buffer.h"
  73 #include <paths.h>
  74 #include "process.h"
  75 #include "syssignal.h"
  76 #include "systty.h"
  77
  78 #ifdef VMS
  79 extern noshare char **environ;
  80 #else
  81 extern char **environ;
  82 #endif
  83
  84 #define max(a, b) ((a) > (b) ? (a) : (b))
  85
  86 #ifdef DOS_NT
  87 /* When we are starting external processes we need to know whether they
  88    take binary input (no conversion) or text input (\n is converted to
  89    \r\n).  Similar for output: if newlines are written as \r\n then it's
  90    text process output, otherwise it's binary.  */
  91 Lisp_Object Vbinary_process_input;
  92 Lisp_Object Vbinary_process_output;
  93 #endif /* DOS_NT */
  94
  95 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory;
  96 Lisp_Object Vconfigure_info_directory;
  97
  98 Lisp_Object Vshell_file_name;
  99
 100 Lisp_Object Vprocess_environment;
 101
 102 #ifdef DOS_NT
 103 Lisp_Object Qbuffer_file_type;
 104 #endif /* DOS_NT */
 105
 106 /* True iff we are about to fork off a synchronous process or if we
 107    are waiting for it.  */
 108 int synch_process_alive;
 109
 110 /* Nonzero => this is a string explaining death of synchronous subprocess.  */
 111 char *synch_process_death;
 112
 113 /* If synch_process_death is zero,
 114    this is exit code of synchronous subprocess.  */
 115 int synch_process_retcode;
 116
 117 extern Lisp_Object Vdoc_file_name;
 118 \f
 119 /* Clean up when exiting Fcall_process.
 120    On MSDOS, delete the temporary file on any kind of termination.
 121    On Unix, kill the process and any children on termination by signal.  */
 122
 123 /* Nonzero if this is termination due to exit.  */
 124 static int call_process_exited;
 125
 126 #ifndef VMS  /* VMS version is in vmsproc.c.  */
 127
 128 static Lisp_Object
 129 call_process_kill (fdpid)
 130      Lisp_Object fdpid;
 131 {
 132   close (XFASTINT (Fcar (fdpid)));
 133   EMACS_KILLPG (XFASTINT (Fcdr (fdpid)), SIGKILL);
 134   synch_process_alive = 0;
 135   return Qnil;
 136 }
 137
 138 Lisp_Object
 139 call_process_cleanup (fdpid)
 140      Lisp_Object fdpid;
 141 {
 142 #ifdef MSDOS
 143   /* for MSDOS fdpid is really (fd . tempfile)  */
 144   register Lisp_Object file;
 145   file = Fcdr (fdpid);
 146   close (XFASTINT (Fcar (fdpid)));
 147   if (strcmp (XSTRING (file)-> data, NULL_DEVICE) != 0)
 148     unlink (XSTRING (file)->data);
 149 #else /* not MSDOS */
 150   register int pid = XFASTINT (Fcdr (fdpid));
 151
 152
 153   if (call_process_exited)
 154     {
 155       close (XFASTINT (Fcar (fdpid)));
 156       return Qnil;
 157     }
 158
 159   if (EMACS_KILLPG (pid, SIGINT) == 0)
 160     {
 161       int count = specpdl_ptr - specpdl;
 162       record_unwind_protect (call_process_kill, fdpid);
 163       message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
 164       immediate_quit = 1;
 165       QUIT;
 166       wait_for_termination (pid);
 167       immediate_quit = 0;
 168       specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
 169       message1 ("Waiting for process to die...done");
 170     }
 171   synch_process_alive = 0;
 172   close (XFASTINT (Fcar (fdpid)));
 173 #endif /* not MSDOS */
 174   return Qnil;
 175 }
 176
 177 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
 178   "Call PROGRAM synchronously in separate process.\n\
 179 The program's input comes from file INFILE (nil means `/dev/null').\n\
 180 Insert output in BUFFER before point; t means current buffer;\n\
 181  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 182 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 183 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 184 If BUFFER is 0, returns immediately with value nil.\n\
 185 Otherwise waits for PROGRAM to terminate\n\
 186 and returns a numeric exit status or a signal description string.\n\
 187 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 188   (nargs, args)
 189      int nargs;
 190      register Lisp_Object *args;
 191 {
 192   Lisp_Object infile, buffer, current_dir, display, path;
 193   int fd[2];
 194   int filefd;
 195   register int pid;
 196   char buf[1024];
 197   int count = specpdl_ptr - specpdl;
 198   register unsigned char **new_argv
 199     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
 200   struct buffer *old = current_buffer;
 201 #ifdef MSDOS    /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
 202   char *outf, *tempfile;
 203   int outfilefd;
 204 #endif
 205 #if 0
 206   int mask;
 207 #endif
 208   CHECK_STRING (args[0], 0);
 209
 210 #ifndef subprocesses
 211   /* Without asynchronous processes we cannot have BUFFER == 0.  */
 212   if (nargs >= 3 && INTEGERP (args[2]))
 213     error ("Operating system cannot handle asynchronous subprocesses");
 214 #endif /* subprocesses */
 215
 216   if (nargs >= 2 && ! NILP (args[1]))
 217     {
 218       infile = Fexpand_file_name (args[1], current_buffer->directory);
 219       CHECK_STRING (infile, 1);
 220     }
 221   else
 222     infile = build_string (NULL_DEVICE);
 223
 224   if (nargs >= 3)
 225     {
 226       register Lisp_Object tem;
 227
 228       buffer = tem = args[2];
 229       if (!(EQ (tem, Qnil)
 230             || EQ (tem, Qt)
 231             || XFASTINT (tem) == 0))
 232         {
 233           buffer = Fget_buffer (tem);
 234           CHECK_BUFFER (buffer, 2);
 235         }
 236     }
 237   else
 238     buffer = Qnil;
 239
 240   /* Make sure that the child will be able to chdir to the current
 241      buffer's current directory, or its unhandled equivalent.  We
 242      can't just have the child check for an error when it does the
 243      chdir, since it's in a vfork.
 244
 245      We have to GCPRO around this because Fexpand_file_name,
 246      Funhandled_file_name_directory, and Ffile_accessible_directory_p
 247      might call a file name handling function.  The argument list is
 248      protected by the caller, so all we really have to worry about is
 249      buffer.  */
 250   {
 251     struct gcpro gcpro1, gcpro2, gcpro3;
 252
 253     current_dir = current_buffer->directory;
 254
 255     GCPRO3 (infile, buffer, current_dir);
 256
 257     current_dir
 258       = expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
 259                                 Qnil);
 260     if (NILP (Ffile_accessible_directory_p (current_dir)))
 261       report_file_error ("Setting current directory",
 262                          Fcons (current_buffer->directory, Qnil));
 263
 264     UNGCPRO;
 265   }
 266
 267   display = nargs >= 4 ? args[3] : Qnil;
 268
 269   filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
 270   if (filefd < 0)
 271     {
 272       report_file_error ("Opening process input file", Fcons (infile, Qnil));
 273     }
 274   /* Search for program; barf if not found.  */
 275   {
 276     struct gcpro gcpro1;
 277
 278     GCPRO1 (current_dir);
 279     openp (Vexec_path, args[0], EXEC_SUFFIXES, &path, 1);
 280     UNGCPRO;
 281   }
 282   if (NILP (path))
 283     {
 284       close (filefd);
 285       report_file_error ("Searching for program", Fcons (args[0], Qnil));
 286     }
 287   new_argv[0] = XSTRING (path)->data;
 288   {
 289     register int i;
 290     for (i = 4; i < nargs; i++)
 291       {
 292         CHECK_STRING (args[i], i);
 293         new_argv[i - 3] = XSTRING (args[i])->data;
 294       }
 295     new_argv[i - 3] = 0;
 296   }
 297
 298 #ifdef MSDOS /* MW, July 1993 */
 299   /* These vars record information from process termination.
 300      Clear them now before process can possibly terminate,
 301      to avoid timing error if process terminates soon.  */
 302   synch_process_death = 0;
 303   synch_process_retcode = 0;
 304
 305   if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
 306     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
 307   else
 308     {
 309       tempfile = alloca (20);
 310       *tempfile = '\0';
 311     }
 312   dostounix_filename (tempfile);
 313   if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
 314     strcat (tempfile, "/");
 315   strcat (tempfile, "detmp.XXX");
 316   mktemp (tempfile);
 317
 318   outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
 319   if (outfilefd < 0)
 320     {
 321       close (filefd);
 322       report_file_error ("Opening process output file", Fcons (tempfile, Qnil));
 323     }
 324 #endif
 325
 326   if (INTEGERP (buffer))
 327     fd[1] = open (NULL_DEVICE, O_WRONLY), fd[0] = -1;
 328   else
 329     {
 330 #ifndef MSDOS
 331 #ifdef WINDOWSNT
 332       pipe_with_inherited_out (fd);
 333 #else  /* not WINDOWSNT */
 334       pipe (fd);
 335 #endif /* not WINDOWSNT */
 336 #endif
 337 #if 0
 338       /* Replaced by close_process_descs */
 339       set_exclusive_use (fd[0]);
 340 #endif
 341     }
 342
 343   {
 344     /* child_setup must clobber environ in systems with true vfork.
 345        Protect it from permanent change.  */
 346     register char **save_environ = environ;
 347     register int fd1 = fd[1];
 348
 349 #if 0  /* Some systems don't have sigblock.  */
 350     mask = sigblock (sigmask (SIGCHLD));
 351 #endif
 352
 353     /* Record that we're about to create a synchronous process.  */
 354     synch_process_alive = 1;
 355
 356     /* These vars record information from process termination.
 357        Clear them now before process can possibly terminate,
 358        to avoid timing error if process terminates soon.  */
 359     synch_process_death = 0;
 360     synch_process_retcode = 0;
 361
 362 #ifdef MSDOS /* MW, July 1993 */
 363     /* ??? Someone who knows MSDOG needs to check whether this properly
 364        closes all descriptors that it opens.  */
 365     pid = run_msdos_command (new_argv, current_dir, filefd, outfilefd);
 366     close (outfilefd);
 367     fd1 = -1; /* No harm in closing that one!  */
 368     fd[0] = open (tempfile, NILP (Vbinary_process_output) ? O_TEXT : O_BINARY);
 369     if (fd[0] < 0)
 370       {
 371         unlink (tempfile);
 372         close (filefd);
 373         report_file_error ("Cannot re-open temporary file", Qnil);
 374       }
 375 #else /* not MSDOS */
 376 #ifdef WINDOWSNT
 377     pid = child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
 378 #else  /* not WINDOWSNT */
 379     pid = vfork ();
 380
 381     if (pid == 0)
 382       {
 383         if (fd[0] >= 0)
 384           close (fd[0]);
 385 #ifdef USG
 386         setpgrp ();
 387 #else
 388         setpgrp (pid, pid);
 389 #endif /* USG */
 390         child_setup (filefd, fd1, fd1, new_argv, 0, current_dir);
 391       }
 392 #endif /* not MSDOS */
 393 #endif /* not WINDOWSNT */
 394
 395     environ = save_environ;
 396
 397     /* Close most of our fd's, but not fd[0]
 398        since we will use that to read input from.  */
 399     close (filefd);
 400     if (fd1 >= 0)
 401       close (fd1);
 402   }
 403
 404   if (pid < 0)
 405     {
 406       if (fd[0] >= 0)
 407         close (fd[0]);
 408       report_file_error ("Doing vfork", Qnil);
 409     }
 410
 411   if (INTEGERP (buffer))
 412     {
 413       if (fd[0] >= 0)
 414         close (fd[0]);
 415 #ifndef subprocesses
 416       /* If Emacs has been built with asynchronous subprocess support,
 417          we don't need to do this, I think because it will then have
 418          the facilities for handling SIGCHLD.  */
 419       wait_without_blocking ();
 420 #endif /* subprocesses */
 421       return Qnil;
 422     }
 423
 424   /* Enable sending signal if user quits below.  */
 425   call_process_exited = 0;
 426
 427 #ifdef MSDOS
 428   /* MSDOS needs different cleanup information.  */
 429   record_unwind_protect (call_process_cleanup,
 430                          Fcons (make_number (fd[0]), build_string (tempfile)));
 431 #else
 432   record_unwind_protect (call_process_cleanup,
 433                          Fcons (make_number (fd[0]), make_number (pid)));
 434 #endif /* not MSDOS */
 435
 436
 437   if (BUFFERP (buffer))
 438     Fset_buffer (buffer);
 439
 440   immediate_quit = 1;
 441   QUIT;
 442
 443   {
 444     register int nread;
 445     int first = 1;
 446
 447     while ((nread = read (fd[0], buf, sizeof buf)) != 0)
 448       {
 449         if (nread < 0)
 450           {
 451 #if defined (__osf__) && defined (__alpha)
 452             continue;           /* Work around bug in DEC OSF/1 V3.0.  */
 453 #else
 454             break;
 455 #endif
 456           }
 457         immediate_quit = 0;
 458         if (!NILP (buffer))
 459           insert (buf, nread);
 460         if (!NILP (display) && INTERACTIVE)
 461           {
 462             if (first)
 463               prepare_menu_bars ();
 464             first = 0;
 465             redisplay_preserve_echo_area ();
 466           }
 467         immediate_quit = 1;
 468         QUIT;
 469       }
 470   }
 471
 472   /* Wait for it to terminate, unless it already has.  */
 473   wait_for_termination (pid);
 474
 475   immediate_quit = 0;
 476
 477   set_buffer_internal (old);
 478
 479   /* Don't kill any children that the subprocess may have left behind
 480      when exiting.  */
 481   call_process_exited = 1;
 482
 483   unbind_to (count, Qnil);
 484
 485   if (synch_process_death)
 486     return build_string (synch_process_death);
 487   return make_number (synch_process_retcode);
 488 }
 489 #endif
 490 \f
 491 static Lisp_Object
 492 delete_temp_file (name)
 493      Lisp_Object name;
 494 {
 495   /* Use Fdelete_file (indirectly) because that runs a file name handler.
 496      We did that when writing the file, so we should do so when deleting.  */
 497   internal_delete_file (name);
 498 }
 499
 500 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
 501   3, MANY, 0,
 502   "Send text from START to END to a synchronous process running PROGRAM.\n\
 503 Delete the text if fourth arg DELETE is non-nil.\n\
 504 Insert output in BUFFER before point; t means current buffer;\n\
 505  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 506 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 507 Remaining args are passed to PROGRAM at startup as command args.\n\
 508 If BUFFER is nil, returns immediately with value nil.\n\
 509 Otherwise waits for PROGRAM to terminate\n\
 510 and returns a numeric exit status or a signal description string.\n\
 511 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.")
 512   (nargs, args)
 513      int nargs;
 514      register Lisp_Object *args;
 515 {
 516   struct gcpro gcpro1;
 517   Lisp_Object filename_string;
 518   register Lisp_Object start, end;
 519 #ifdef DOS_NT
 520   char *tempfile;
 521 #else
 522   char tempfile[20];
 523 #endif
 524   int count = specpdl_ptr - specpdl;
 525 #ifdef DOS_NT
 526   char *outf = '\0';
 527
 528   if ((outf = egetenv ("TMP")) || (outf = egetenv ("TEMP")))
 529     strcpy (tempfile = alloca (strlen (outf) + 20), outf);
 530   else
 531     {
 532       tempfile = alloca (20);
 533       *tempfile = '\0';
 534     }
 535   dostounix_filename (tempfile);
 536   if (tempfile[strlen (tempfile) - 1] != '/')
 537     strcat (tempfile, "/");
 538   strcat (tempfile, "detmp.XXX");
 539 #else /* not DOS_NT */
 540
 541 #ifdef VMS
 542   strcpy (tempfile, "tmp:emacsXXXXXX.");
 543 #else
 544   strcpy (tempfile, "/tmp/emacsXXXXXX");
 545 #endif
 546 #endif /* not DOS_NT */
 547
 548   mktemp (tempfile);
 549
 550   filename_string = build_string (tempfile);
 551   GCPRO1 (filename_string);
 552   start = args[0];
 553   end = args[1];
 554 #ifdef DOS_NT
 555   specbind (Qbuffer_file_type, Vbinary_process_input);
 556   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 557   unbind_to (count, Qnil);
 558 #else  /* not DOS_NT */
 559   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 560 #endif /* not DOS_NT */
 561
 562   record_unwind_protect (delete_temp_file, filename_string);
 563
 564   if (!NILP (args[3]))
 565     Fdelete_region (start, end);
 566
 567   args[3] = filename_string;
 568
 569   RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs - 2, args + 2)));
 570 }
 571 \f
 572 #ifndef VMS /* VMS version is in vmsproc.c.  */
 573
 574 /* This is the last thing run in a newly forked inferior
 575    either synchronous or asynchronous.
 576    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
 577    Initialize inferior's priority, pgrp, connected dir and environment.
 578    then exec another program based on new_argv.
 579
 580    This function may change environ for the superior process.
 581    Therefore, the superior process must save and restore the value
 582    of environ around the vfork and the call to this function.
 583
 584    ENV is the environment for the subprocess.
 585
 586    SET_PGRP is nonzero if we should put the subprocess into a separate
 587    process group.
 588
 589    CURRENT_DIR is an elisp string giving the path of the current
 590    directory the subprocess should have.  Since we can't really signal
 591    a decent error from within the child, this should be verified as an
 592    executable directory by the parent.  */
 593
 594 child_setup (in, out, err, new_argv, set_pgrp, current_dir)
 595      int in, out, err;
 596      register char **new_argv;
 597      int set_pgrp;
 598      Lisp_Object current_dir;
 599 {
 600 #ifdef MSDOS
 601   /* The MSDOS port of gcc cannot fork, vfork, ... so we must call system
 602      instead.  */
 603 #else /* not MSDOS */
 604   char **env;
 605   char *pwd_var;
 606 #ifdef WINDOWSNT
 607   int cpid;
 608   HANDLE handles[4];
 609 #endif /* WINDOWSNT */
 610
 611   int pid = getpid ();
 612
 613 #ifdef SET_EMACS_PRIORITY
 614   {
 615     extern int emacs_priority;
 616
 617     if (emacs_priority < 0)
 618       nice (- emacs_priority);
 619   }
 620 #endif
 621
 622 #ifdef subprocesses
 623   /* Close Emacs's descriptors that this process should not have.  */
 624   close_process_descs ();
 625 #endif
 626   close_load_descs ();
 627
 628   /* Note that use of alloca is always safe here.  It's obvious for systems
 629      that do not have true vfork or that have true (stack) alloca.
 630      If using vfork and C_ALLOCA it is safe because that changes
 631      the superior's static variables as if the superior had done alloca
 632      and will be cleaned up in the usual way.  */
 633   {
 634     register char *temp;
 635     register int i;
 636
 637     i = XSTRING (current_dir)->size;
 638     pwd_var = (char *) alloca (i + 6);
 639     temp = pwd_var + 4;
 640     bcopy ("PWD=", pwd_var, 4);
 641     bcopy (XSTRING (current_dir)->data, temp, i);
 642     if (!IS_DIRECTORY_SEP (temp[i - 1])) temp[i++] = DIRECTORY_SEP;
 643     temp[i] = 0;
 644
 645     /* We can't signal an Elisp error here; we're in a vfork.  Since
 646        the callers check the current directory before forking, this
 647        should only return an error if the directory's permissions
 648        are changed between the check and this chdir, but we should
 649        at least check.  */
 650     if (chdir (temp) < 0)
 651       _exit (errno);
 652
 653     /* Strip trailing slashes for PWD, but leave "/" and "//" alone.  */
 654     while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
 655       temp[--i] = 0;
 656   }
 657
 658   /* Set `env' to a vector of the strings in Vprocess_environment.  */
 659   {
 660     register Lisp_Object tem;
 661     register char **new_env;
 662     register int new_length;
 663
 664     new_length = 0;
 665     for (tem = Vprocess_environment;
 666          CONSP (tem) && STRINGP (XCONS (tem)->car);
 667          tem = XCONS (tem)->cdr)
 668       new_length++;
 669
 670     /* new_length + 2 to include PWD and terminating 0.  */
 671     env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
 672
 673     /* If we have a PWD envvar, pass one down,
 674        but with corrected value.  */
 675     if (getenv ("PWD"))
 676       *new_env++ = pwd_var;
 677
 678     /* Copy the Vprocess_environment strings into new_env.  */
 679     for (tem = Vprocess_environment;
 680          CONSP (tem) && STRINGP (XCONS (tem)->car);
 681          tem = XCONS (tem)->cdr)
 682       {
 683         char **ep = env;
 684         char *string = (char *) XSTRING (XCONS (tem)->car)->data;
 685         /* See if this string duplicates any string already in the env.
 686            If so, don't put it in.
 687            When an env var has multiple definitions,
 688            we keep the definition that comes first in process-environment.  */
 689         for (; ep != new_env; ep++)
 690           {
 691             char *p = *ep, *q = string;
 692             while (1)
 693               {
 694                 if (*q == 0)
 695                   /* The string is malformed; might as well drop it.  */
 696                   goto duplicate;
 697                 if (*q != *p)
 698                   break;
 699                 if (*q == '=')
 700                   goto duplicate;
 701                 p++, q++;
 702               }
 703           }
 704         *new_env++ = string;
 705       duplicate: ;
 706       }
 707     *new_env = 0;
 708   }
 709 #ifdef WINDOWSNT
 710   prepare_standard_handles (in, out, err, handles);
 711 #else  /* not WINDOWSNT */
 712   /* Make sure that in, out, and err are not actually already in
 713      descriptors zero, one, or two; this could happen if Emacs is
 714      started with its standard in, out, or error closed, as might
 715      happen under X.  */
 716   in = relocate_fd (in, 3);
 717   if (out == err)
 718     err = out = relocate_fd (out, 3);
 719   else
 720     {
 721       out = relocate_fd (out, 3);
 722       err = relocate_fd (err, 3);
 723     }
 724
 725   close (0);
 726   close (1);
 727   close (2);
 728
 729   dup2 (in, 0);
 730   dup2 (out, 1);
 731   dup2 (err, 2);
 732   close (in);
 733   close (out);
 734   close (err);
 735 #endif /* not WINDOWSNT */
 736
 737 #ifdef USG
 738 #ifndef SETPGRP_RELEASES_CTTY
 739   setpgrp ();                   /* No arguments but equivalent in this case */
 740 #endif
 741 #else
 742   setpgrp (pid, pid);
 743 #endif /* USG */
 744   /* setpgrp_of_tty is incorrect here; it uses input_fd.  */
 745   EMACS_SET_TTY_PGRP (0, &pid);
 746
 747 #ifdef vipc
 748   something missing here;
 749 #endif /* vipc */
 750
 751 #ifdef WINDOWSNT
 752   /* Spawn the child.  (See ntproc.c:Spawnve).  */
 753   cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
 754   if (cpid == -1) {    ????
 755       report_file_error ("Spawning child process", Qnil);
 756   }
 757   reset_standard_handles (in, out, err, handles);
 758   return cpid;
 759 #else /* not WINDOWSNT */
 760   /* execvp does not accept an environment arg so the only way
 761      to pass this environment is to set environ.  Our caller
 762      is responsible for restoring the ambient value of environ.  */
 763   environ = env;
 764   execvp (new_argv[0], new_argv);
 765
 766   write (1, "Couldn't exec the program ", 26);
 767   write (1, new_argv[0], strlen (new_argv[0]));
 768   _exit (1);
 769 #endif /* not WINDOWSNT */
 770 #endif /* not MSDOS */
 771 }
 772
 773 /* Move the file descriptor FD so that its number is not less than MIN.
 774    If the file descriptor is moved at all, the original is freed.  */
 775 int
 776 relocate_fd (fd, min)
 777      int fd, min;
 778 {
 779   if (fd >= min)
 780     return fd;
 781   else
 782     {
 783       int new = dup (fd);
 784       if (new == -1)
 785         {
 786           char *message1 = "Error while setting up child: ";
 787           char *errmessage = strerror (errno);
 788           char *message2 = "\n";
 789           write (2, message1, strlen (message1));
 790           write (2, errmessage, strlen (errmessage));
 791           write (2, message2, strlen (message2));
 792           _exit (1);
 793         }
 794       /* Note that we hold the original FD open while we recurse,
 795          to guarantee we'll get a new FD if we need it.  */
 796       new = relocate_fd (new, min);
 797       close (fd);
 798       return new;
 799     }
 800 }
 801
 802 static int
 803 getenv_internal (var, varlen, value, valuelen)
 804      char *var;
 805      int varlen;
 806      char **value;
 807      int *valuelen;
 808 {
 809   Lisp_Object scan;
 810
 811   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
 812     {
 813       Lisp_Object entry;
 814
 815       entry = XCONS (scan)->car;
 816       if (STRINGP (entry)
 817           && XSTRING (entry)->size > varlen
 818           && XSTRING (entry)->data[varlen] == '='
 819 #ifdef WINDOWSNT
 820           /* NT environment variables are case insensitive.  */
 821           && ! strnicmp (XSTRING (entry)->data, var, varlen))
 822 #else  /* not WINDOWSNT */
 823           && ! bcmp (XSTRING (entry)->data, var, varlen))
 824 #endif /* not WINDOWSNT */
 825         {
 826           *value    = (char *) XSTRING (entry)->data + (varlen + 1);
 827           *valuelen = XSTRING (entry)->size - (varlen + 1);
 828           return 1;
 829         }
 830     }
 831
 832   return 0;
 833 }
 834
 835 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 1, 0,
 836   "Return the value of environment variable VAR, as a string.\n\
 837 VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
 838 This function consults the variable ``process-environment'' for its value.")
 839   (var)
 840      Lisp_Object var;
 841 {
 842   char *value;
 843   int valuelen;
 844
 845   CHECK_STRING (var, 0);
 846   if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
 847                        &value, &valuelen))
 848     return make_string (value, valuelen);
 849   else
 850     return Qnil;
 851 }
 852
 853 /* A version of getenv that consults process_environment, easily
 854    callable from C.  */
 855 char *
 856 egetenv (var)
 857      char *var;
 858 {
 859   char *value;
 860   int valuelen;
 861
 862   if (getenv_internal (var, strlen (var), &value, &valuelen))
 863     return value;
 864   else
 865     return 0;
 866 }
 867
 868 #endif /* not VMS */
 869 \f
 870 /* This is run before init_cmdargs.  */
 871
 872 init_callproc_1 ()
 873 {
 874   char *data_dir = egetenv ("EMACSDATA");
 875   char *doc_dir = egetenv ("EMACSDOC");
 876
 877   Vdata_directory
 878     = Ffile_name_as_directory (build_string (data_dir ? data_dir
 879                                              : PATH_DATA));
 880   Vdoc_directory
 881     = Ffile_name_as_directory (build_string (doc_dir ? doc_dir
 882                                              : PATH_DOC));
 883
 884   /* Check the EMACSPATH environment variable, defaulting to the
 885      PATH_EXEC path from paths.h.  */
 886   Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC);
 887   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
 888   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 889 }
 890
 891 /* This is run after init_cmdargs, so that Vinvocation_directory is valid.  */
 892
 893 init_callproc ()
 894 {
 895   char *data_dir = egetenv ("EMACSDATA");
 896
 897   register char * sh;
 898   Lisp_Object tempdir;
 899
 900   if (initialized && !NILP (Vinstallation_directory))
 901     {
 902       /* Add to the path the lib-src subdir of the installation dir.  */
 903       Lisp_Object tem;
 904       tem = Fexpand_file_name (build_string ("lib-src"),
 905                                Vinstallation_directory);
 906       if (NILP (Fmember (tem, Vexec_path)))
 907         {
 908 #ifndef DOS_NT
 909           /* MSDOS uses wrapped binaries, so don't do this.  */
 910           Vexec_path = nconc2 (Vexec_path, Fcons (tem, Qnil));
 911           Vexec_directory = Ffile_name_as_directory (tem);
 912 #endif /* not DOS_NT */
 913
 914           /* If we use ../lib-src, maybe use ../etc as well.
 915              Do so if ../etc exists and has our DOC-... file in it.  */
 916           if (data_dir == 0)
 917             {
 918               tem = Fexpand_file_name (build_string ("etc"),
 919                                        Vinstallation_directory);
 920               Vdoc_directory = Ffile_name_as_directory (tem);
 921             }
 922         }
 923     }
 924
 925   /* Look for the files that should be in etc.  We don't use
 926      Vinstallation_directory, because these files are never installed
 927      in /bin near the executable, and they are never in the build
 928      directory when that's different from the source directory.
 929
 930      Instead, if these files are not in the nominal place, we try the
 931      source directory.  */
 932   if (data_dir == 0)
 933     {
 934       Lisp_Object tem, tem1, newdir;
 935
 936       tem = Fexpand_file_name (build_string ("GNU"), Vdata_directory);
 937       tem1 = Ffile_exists_p (tem);
 938       if (NILP (tem1))
 939         {
 940           newdir = Fexpand_file_name (build_string ("../etc/"),
 941                                       build_string (PATH_DUMPLOADSEARCH));
 942           tem = Fexpand_file_name (build_string ("GNU"), newdir);
 943           tem1 = Ffile_exists_p (tem);
 944           if (!NILP (tem1))
 945             Vdata_directory = newdir;
 946         }
 947     }
 948
 949   tempdir = Fdirectory_file_name (Vexec_directory);
 950   if (access (XSTRING (tempdir)->data, 0) < 0)
 951     {
 952       fprintf (stderr,
 953                "Warning: arch-dependent data dir (%s) does not exist.\n",
 954                XSTRING (Vexec_directory)->data);
 955       sleep (2);
 956     }
 957
 958   tempdir = Fdirectory_file_name (Vdata_directory);
 959   if (access (XSTRING (tempdir)->data, 0) < 0)
 960     {
 961       fprintf (stderr,
 962                "Warning: arch-independent data dir (%s) does not exist.\n",
 963                XSTRING (Vdata_directory)->data);
 964       sleep (2);
 965     }
 966
 967 #ifdef VMS
 968   Vshell_file_name = build_string ("*dcl*");
 969 #else
 970   sh = (char *) getenv ("SHELL");
 971   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 972 #endif
 973 }
 974
 975 set_process_environment ()
 976 {
 977   register char **envp;
 978
 979   Vprocess_environment = Qnil;
 980 #ifndef CANNOT_DUMP
 981   if (initialized)
 982 #endif
 983     for (envp = environ; *envp; envp++)
 984       Vprocess_environment = Fcons (build_string (*envp),
 985                                     Vprocess_environment);
 986 }
 987
 988 syms_of_callproc ()
 989 {
 990 #ifdef DOS_NT
 991   Qbuffer_file_type = intern ("buffer-file-type");
 992   staticpro (&Qbuffer_file_type);
 993
 994   DEFVAR_LISP ("binary-process-input", &Vbinary_process_input,
 995     "*If non-nil then new subprocesses are assumed to take binary input.");
 996   Vbinary_process_input = Qnil;
 997
 998   DEFVAR_LISP ("binary-process-output", &Vbinary_process_output,
 999     "*If non-nil then new subprocesses are assumed to produce binary output.");
1000   Vbinary_process_output = Qnil;
1001 #endif /* DOS_NT */
1002
1003   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
1004     "*File name to load inferior shells from.\n\
1005 Initialized from the SHELL environment variable.");
1006
1007   DEFVAR_LISP ("exec-path", &Vexec_path,
1008     "*List of directories to search programs to run in subprocesses.\n\
1009 Each element is a string (directory name) or nil (try default directory).");
1010
1011   DEFVAR_LISP ("exec-directory", &Vexec_directory,
1012     "Directory of architecture-dependent files that come with GNU Emacs,\n\
1013 especially executable programs intended for Emacs to invoke.");
1014
1015   DEFVAR_LISP ("data-directory", &Vdata_directory,
1016     "Directory of architecture-independent files that come with GNU Emacs,\n\
1017 intended for Emacs to use.");
1018
1019   DEFVAR_LISP ("doc-directory", &Vdoc_directory,
1020     "Directory containing the DOC file that comes with GNU Emacs.\n\
1021 This is usually the same as data-directory.");
1022
1023   DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory,
1024     "For internal use by the build procedure only.\n\
1025 This is the name of the directory in which the build procedure installed\n\
1026 Emacs's info files; the default value for Info-default-directory-list\n\
1027 includes this.");
1028   Vconfigure_info_directory = build_string (PATH_INFO);
1029
1030   DEFVAR_LISP ("process-environment", &Vprocess_environment,
1031     "List of environment variables for subprocesses to inherit.\n\
1032 Each element should be a string of the form ENVVARNAME=VALUE.\n\
1033 The environment which Emacs inherits is placed in this variable\n\
1034 when Emacs starts.");
1035
1036 #ifndef VMS
1037   defsubr (&Scall_process);
1038   defsubr (&Sgetenv);
1039 #endif
1040   defsubr (&Scall_process_region);
1041 }