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