src/callproc.c

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