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