src/callproc.c

   1 /* Synchronous subprocess invocation for GNU Emacs.
   2    Copyright (C) 1985, 1986, 1987, 1988 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 1, 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 /* Define SIGCHLD as an alias for SIGCLD.  */
  27
  28 #if !defined (SIGCHLD) && defined (SIGCLD)
  29 #define SIGCHLD SIGCLD
  30 #endif /* SIGCLD */
  31
  32 #include <sys/types.h>
  33 #define PRIO_PROCESS 0
  34 #include <sys/file.h>
  35 #ifdef USG5
  36 #include <fcntl.h>
  37 #endif
  38
  39 #ifndef O_RDONLY
  40 #define O_RDONLY 0
  41 #endif
  42
  43 #ifndef O_WRONLY
  44 #define O_WRONLY 1
  45 #endif
  46
  47 #include "lisp.h"
  48 #include "commands.h"
  49 #include "buffer.h"
  50 #include "paths.h"
  51 #include "process.h"
  52
  53 #ifdef VMS
  54 extern noshare char **environ;
  55 #else
  56 extern char **environ;
  57 #endif
  58
  59 #define max(a, b) ((a) > (b) ? (a) : (b))
  60
  61 Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
  62
  63 Lisp_Object Vshell_file_name;
  64
  65 Lisp_Object Vprocess_environment;
  66
  67 /* True iff we are about to fork off a synchronous process or if we
  68    are waiting for it.  */
  69 int synch_process_alive;
  70
  71 /* Nonzero => this is a string explaining death of synchronous subprocess.  */
  72 char *synch_process_death;
  73
  74 /* If synch_process_death is zero,
  75    this is exit code of synchronous subprocess.  */
  76 int synch_process_retcode;
  77 \f
  78 #ifndef VMS  /* VMS version is in vmsproc.c.  */
  79
  80 Lisp_Object
  81 call_process_cleanup (fdpid)
  82      Lisp_Object fdpid;
  83 {
  84   register Lisp_Object fd, pid;
  85   fd = Fcar (fdpid);
  86   pid = Fcdr (fdpid);
  87   close (XFASTINT (fd));
  88   kill (XFASTINT (pid), SIGKILL);
  89   synch_process_alive = 0;
  90   return Qnil;
  91 }
  92
  93 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  94   "Call PROGRAM synchronously in separate process.\n\
  95 The program's input comes from file INFILE (nil means `/dev/null').\n\
  96 Insert output in BUFFER before point; t means current buffer;\n\
  97  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
  98 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
  99 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 100 If BUFFER is nil or 0, returns immediately with value nil.\n\
 101 Otherwise waits for PROGRAM to terminate\n\
 102 and returns a numeric exit status or a signal name as a string.\n\
 103 If you quit, the process is killed with SIGKILL.")
 104   (nargs, args)
 105      int nargs;
 106      register Lisp_Object *args;
 107 {
 108   Lisp_Object display, infile, buffer, path, current_dir;
 109   int fd[2];
 110   int filefd;
 111   register int pid;
 112   char buf[1024];
 113   int count = specpdl_ptr - specpdl;
 114   register unsigned char **new_argv
 115     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
 116   struct buffer *old = current_buffer;
 117 #if 0
 118   int mask;
 119 #endif
 120   CHECK_STRING (args[0], 0);
 121
 122   if (nargs >= 2 && ! NILP (args[1]))
 123     {
 124       infile = Fexpand_file_name (args[1], current_buffer->directory);
 125       CHECK_STRING (infile, 1);
 126     }
 127   else
 128     infile = build_string ("/dev/null");
 129
 130   {
 131     register Lisp_Object tem;
 132     if (nargs < 3)
 133       buffer = Qnil;
 134     else
 135       {
 136         buffer = tem = args[2];
 137         if (!(EQ (tem, Qnil) || EQ (tem, Qt)
 138               || XFASTINT (tem) == 0))
 139           {
 140             buffer = Fget_buffer (tem);
 141             CHECK_BUFFER (buffer, 2);
 142           }
 143       }
 144   }
 145
 146   display = nargs >= 3 ? args[3] : Qnil;
 147
 148   {
 149     register int i;
 150     for (i = 4; i < nargs; i++)
 151       {
 152         CHECK_STRING (args[i], i);
 153         new_argv[i - 3] = XSTRING (args[i])->data;
 154       }
 155     /* Program name is first command arg */
 156     new_argv[0] = XSTRING (args[0])->data;
 157     new_argv[i - 3] = 0;
 158   }
 159
 160   filefd = open (XSTRING (infile)->data, O_RDONLY, 0);
 161   if (filefd < 0)
 162     {
 163       report_file_error ("Opening process input file", Fcons (infile, Qnil));
 164     }
 165   /* Search for program; barf if not found.  */
 166   openp (Vexec_path, args[0], "", &path, 1);
 167   if (NILP (path))
 168     {
 169       close (filefd);
 170       report_file_error ("Searching for program", Fcons (args[0], Qnil));
 171     }
 172   new_argv[0] = XSTRING (path)->data;
 173
 174   if (XTYPE (buffer) == Lisp_Int)
 175     fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
 176   else
 177     {
 178       pipe (fd);
 179 #if 0
 180       /* Replaced by close_process_descs */
 181       set_exclusive_use (fd[0]);
 182 #endif
 183     }
 184
 185   /* Make sure that the child will be able to chdir to the current
 186      buffer's current directory.  We can't just have the child check
 187      for an error when it does the chdir, since it's in a vfork.  */
 188   current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil);
 189   if (NILP (Ffile_accessible_directory_p (current_dir)))
 190     report_file_error ("Setting current directory",
 191                        Fcons (current_buffer->directory, Qnil));
 192
 193   {
 194     /* child_setup must clobber environ in systems with true vfork.
 195        Protect it from permanent change.  */
 196     register char **save_environ = environ;
 197     register int fd1 = fd[1];
 198     char **env;
 199
 200     env = environ;
 201
 202 #if 0  /* Some systems don't have sigblock.  */
 203     mask = sigblock (sigmask (SIGCHLD));
 204 #endif
 205
 206     /* Record that we're about to create a synchronous process.  */
 207     synch_process_alive = 1;
 208
 209     pid = vfork ();
 210
 211     if (pid == 0)
 212       {
 213         if (fd[0] >= 0)
 214           close (fd[0]);
 215 #ifdef USG
 216         setpgrp ();
 217 #else
 218         setpgrp (pid, pid);
 219 #endif /* USG */
 220         child_setup (filefd, fd1, fd1, new_argv, env, 0, current_dir);
 221       }
 222
 223 #if 0
 224     /* Tell SIGCHLD handler to look for this pid.  */
 225     synch_process_pid = pid;
 226     /* Now let SIGCHLD come through.  */
 227     sigsetmask (mask);
 228 #endif
 229
 230     environ = save_environ;
 231
 232     close (filefd);
 233     close (fd1);
 234   }
 235
 236   if (pid < 0)
 237     {
 238       close (fd[0]);
 239       report_file_error ("Doing vfork", Qnil);
 240     }
 241
 242   if (XTYPE (buffer) == Lisp_Int)
 243     {
 244 #ifndef subprocesses
 245       wait_without_blocking ();
 246 #endif /* subprocesses */
 247       return Qnil;
 248     }
 249
 250   synch_process_death = 0;
 251   synch_process_retcode = 0;
 252
 253   record_unwind_protect (call_process_cleanup,
 254                          Fcons (make_number (fd[0]), make_number (pid)));
 255
 256
 257   if (XTYPE (buffer) == Lisp_Buffer)
 258     Fset_buffer (buffer);
 259
 260   immediate_quit = 1;
 261   QUIT;
 262
 263   {
 264     register int nread;
 265
 266     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
 267       {
 268         immediate_quit = 0;
 269         if (!NILP (buffer))
 270           insert (buf, nread);
 271         if (!NILP (display) && INTERACTIVE)
 272           redisplay_preserve_echo_area ();
 273         immediate_quit = 1;
 274         QUIT;
 275       }
 276   }
 277
 278   /* Wait for it to terminate, unless it already has.  */
 279   wait_for_termination (pid);
 280
 281   immediate_quit = 0;
 282
 283   set_buffer_internal (old);
 284
 285   unbind_to (count, Qnil);
 286
 287   if (synch_process_death)
 288     return build_string (synch_process_death);
 289   return make_number (synch_process_retcode);
 290 }
 291 #endif
 292 \f
 293 static void
 294 delete_temp_file (name)
 295      Lisp_Object name;
 296 {
 297   unlink (XSTRING (name)->data);
 298 }
 299
 300 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
 301   3, MANY, 0,
 302   "Send text from START to END to a synchronous process running PROGRAM.\n\
 303 Delete the text if fourth arg DELETE is non-nil.\n\
 304 Insert output in BUFFER before point; t means current buffer;\n\
 305  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 306 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 307 Remaining args are passed to PROGRAM at startup as command args.\n\
 308 If BUFFER is nil, returns immediately with value nil.\n\
 309 Otherwise waits for PROGRAM to terminate\n\
 310 and returns a numeric exit status or a signal name as a string.\n\
 311 If you quit, the process is killed with SIGKILL.")
 312   (nargs, args)
 313      int nargs;
 314      register Lisp_Object *args;
 315 {
 316   register Lisp_Object filename_string, start, end;
 317   char tempfile[20];
 318   int count = specpdl_ptr - specpdl;
 319
 320 #ifdef VMS
 321   strcpy (tempfile, "tmp:emacsXXXXXX.");
 322 #else
 323   strcpy (tempfile, "/tmp/emacsXXXXXX");
 324 #endif
 325   mktemp (tempfile);
 326
 327   filename_string = build_string (tempfile);
 328   start = args[0];
 329   end = args[1];
 330   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 331   record_unwind_protect (delete_temp_file, filename_string);
 332
 333   if (!NILP (args[3]))
 334     Fdelete_region (start, end);
 335
 336   args[3] = filename_string;
 337   Fcall_process (nargs - 2, args + 2);
 338
 339   return unbind_to (count, Qnil);
 340 }
 341 \f
 342 #ifndef VMS /* VMS version is in vmsproc.c.  */
 343
 344 /* This is the last thing run in a newly forked inferior
 345    either synchronous or asynchronous.
 346    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
 347    Initialize inferior's priority, pgrp, connected dir and environment.
 348    then exec another program based on new_argv.
 349
 350    This function may change environ for the superior process.
 351    Therefore, the superior process must save and restore the value
 352    of environ around the vfork and the call to this function.
 353
 354    ENV is the environment for the subprocess.
 355
 356    SET_PGRP is nonzero if we should put the subprocess into a separate
 357    process group.
 358
 359    CURRENT_DIR is an elisp string giving the path of the current
 360    directory the subprocess should have.  Since we can't really signal
 361    a decent error from within the child, this should be verified as an
 362    executable directory by the parent.  */
 363
 364 child_setup (in, out, err, new_argv, env, set_pgrp, current_dir)
 365      int in, out, err;
 366      register char **new_argv;
 367      char **env;
 368      int set_pgrp;
 369      Lisp_Object current_dir;
 370 {
 371   register int pid = getpid();
 372
 373   setpriority (PRIO_PROCESS, pid, 0);
 374
 375 #ifdef subprocesses
 376   /* Close Emacs's descriptors that this process should not have.  */
 377   close_process_descs ();
 378 #endif
 379
 380   /* Note that use of alloca is always safe here.  It's obvious for systems
 381      that do not have true vfork or that have true (stack) alloca.
 382      If using vfork and C_ALLOCA it is safe because that changes
 383      the superior's static variables as if the superior had done alloca
 384      and will be cleaned up in the usual way.  */
 385
 386   {
 387     register unsigned char *temp;
 388     register int i;
 389
 390     i = XSTRING (current_dir)->size;
 391     temp = (unsigned char *) alloca (i + 2);
 392     bcopy (XSTRING (current_dir)->data, temp, i);
 393     if (temp[i - 1] != '/') temp[i++] = '/';
 394     temp[i] = 0;
 395
 396     /* We can't signal an Elisp error here; we're in a vfork.  Since
 397        the callers check the current directory before forking, this
 398        should only return an error if the directory's permissions
 399        are changed between the check and this chdir, but we should
 400        at least check.  */
 401     if (chdir (temp) < 0)
 402       exit (errno);
 403   }
 404
 405   /* Set `env' to a vector of the strings in Vprocess_environment.  */
 406   {
 407     register Lisp_Object tem;
 408     register char **new_env;
 409     register int new_length;
 410
 411     new_length = 0;
 412     for (tem = Vprocess_environment;
 413          (XTYPE (tem) == Lisp_Cons
 414           && XTYPE (XCONS (tem)->car) == Lisp_String);
 415          tem = XCONS (tem)->cdr)
 416       new_length++;
 417
 418     /* new_length + 1 to include terminating 0 */
 419     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
 420
 421     /* Copy the env strings into new_env.  */
 422     for (tem = Vprocess_environment;
 423          (XTYPE (tem) == Lisp_Cons
 424           && XTYPE (XCONS (tem)->car) == Lisp_String);
 425          tem = XCONS (tem)->cdr)
 426       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
 427     *new_env = 0;
 428   }
 429
 430   close (0);
 431   close (1);
 432   close (2);
 433
 434   dup2 (in, 0);
 435   dup2 (out, 1);
 436   dup2 (err, 2);
 437   close (in);
 438   close (out);
 439   close (err);
 440
 441   setpgrp_of_tty (pid);
 442
 443 #ifdef vipc
 444   something missing here;
 445 #endif /* vipc */
 446
 447   /* execvp does not accept an environment arg so the only way
 448      to pass this environment is to set environ.  Our caller
 449      is responsible for restoring the ambient value of environ.  */
 450   environ = env;
 451   execvp (new_argv[0], new_argv);
 452
 453   write (1, "Couldn't exec the program ", 26);
 454   write (1, new_argv[0], strlen (new_argv[0]));
 455   _exit (1);
 456 }
 457
 458 static int
 459 getenv_internal (var, varlen, value, valuelen)
 460      char *var;
 461      int varlen;
 462      char **value;
 463      int *valuelen;
 464 {
 465   Lisp_Object scan;
 466
 467   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
 468     {
 469       Lisp_Object entry = XCONS (scan)->car;
 470
 471       if (XTYPE (entry) == Lisp_String
 472           && XSTRING (entry)->size > varlen
 473           && XSTRING (entry)->data[varlen] == '='
 474           && ! bcmp (XSTRING (entry)->data, var, varlen))
 475         {
 476           *value    = (char *) XSTRING (entry)->data + (varlen + 1);
 477           *valuelen = XSTRING (entry)->size - (varlen + 1);
 478           return 1;
 479         }
 480     }
 481
 482   return 0;
 483 }
 484
 485 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
 486   "Return the value of environment variable VAR, as a string.\n\
 487 VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
 488 This function consults the variable ``process-environment'' for its value.")
 489   (var)
 490      Lisp_Object var;
 491 {
 492   char *value;
 493   int valuelen;
 494
 495   CHECK_STRING (var, 0);
 496   if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
 497                        &value, &valuelen))
 498     return make_string (value, valuelen);
 499   else
 500     return Qnil;
 501 }
 502
 503 /* A version of getenv that consults process_environment, easily
 504    callable from C.  */
 505 char *
 506 egetenv (var)
 507 {
 508   char *value;
 509   int valuelen;
 510
 511   if (getenv_internal (var, strlen (var), &value, &valuelen))
 512     return value;
 513   else
 514     return 0;
 515 }
 516
 517 #endif /* not VMS */
 518 \f
 519 init_callproc ()
 520 {
 521   register char * sh;
 522   register char **envp;
 523   Lisp_Object tempdir;
 524
 525   Vdata_directory = Ffile_name_as_directory (build_string (PATH_DATA));
 526
 527   /* Turn PATH_EXEC into a path.  `==' is just a string which we know
 528      will not be the name of an environment variable.  */
 529   Vexec_path = decode_env_path ("==", PATH_EXEC);
 530   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
 531   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 532
 533   tempdir = Fdirectory_file_name (Vexec_directory);
 534   if (access (XSTRING (tempdir)->data, 0) < 0)
 535     {
 536       printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
 537               XSTRING (Vexec_directory)->data);
 538       sleep (2);
 539     }
 540
 541   tempdir = Fdirectory_file_name (Vdata_directory);
 542   if (access (XSTRING (tempdir)->data, 0) < 0)
 543     {
 544       printf ("Warning: arch-independent data dir (%s) does not exist.\n",
 545               XSTRING (Vdata_directory)->data);
 546       sleep (2);
 547     }
 548
 549 #ifdef VMS
 550   Vshell_file_name = build_string ("*dcl*");
 551 #else
 552   sh = (char *) getenv ("SHELL");
 553   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 554 #endif
 555
 556   Vprocess_environment = Qnil;
 557 #ifndef CANNOT_DUMP
 558   if (initialized)
 559 #endif
 560     for (envp = environ; *envp; envp++)
 561       Vprocess_environment = Fcons (build_string (*envp),
 562                                     Vprocess_environment);
 563 }
 564
 565 syms_of_callproc ()
 566 {
 567   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
 568     "*File name to load inferior shells from.\n\
 569 Initialized from the SHELL environment variable.");
 570
 571   DEFVAR_LISP ("exec-path", &Vexec_path,
 572     "*List of directories to search programs to run in subprocesses.\n\
 573 Each element is a string (directory name) or nil (try default directory).");
 574
 575   DEFVAR_LISP ("exec-directory", &Vexec_directory,
 576     "Directory of architecture-dependent files that come with GNU Emacs,\n\
 577 especially executable programs intended for Emacs to invoke.");
 578
 579   DEFVAR_LISP ("data-directory", &Vdata_directory,
 580     "Directory of architecture-independent files that come with GNU Emacs,\n\
 581 intended for Emacs to use.");
 582
 583   DEFVAR_LISP ("process-environment", &Vprocess_environment,
 584     "List of environment variables for subprocesses to inherit.\n\
 585 Each element should be a string of the form ENVVARNAME=VALUE.\n\
 586 The environment which Emacs inherits is placed in this variable\n\
 587 when Emacs starts.");
 588
 589 #ifndef VMS
 590   defsubr (&Scall_process);
 591 #endif
 592   defsubr (&Sgetenv);
 593   defsubr (&Scall_process_region);
 594 }