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