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