src/callproc.c

   1 /* Synchronous subprocess invocation for GNU Emacs.
   2    Copyright (C) 1985, 1986, 1987, 1988, 1992 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       /* If Emacs has been built with asynchronous subprocess support,
 246          we don't need to do this, I think because it will then have
 247          the facilities for handling SIGCHLD.  */
 248       wait_without_blocking ();
 249 #endif /* subprocesses */
 250       return Qnil;
 251     }
 252
 253   synch_process_death = 0;
 254   synch_process_retcode = 0;
 255
 256   record_unwind_protect (call_process_cleanup,
 257                          Fcons (make_number (fd[0]), make_number (pid)));
 258
 259
 260   if (XTYPE (buffer) == Lisp_Buffer)
 261     Fset_buffer (buffer);
 262
 263   immediate_quit = 1;
 264   QUIT;
 265
 266   {
 267     register int nread;
 268
 269     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
 270       {
 271         immediate_quit = 0;
 272         if (!NILP (buffer))
 273           insert (buf, nread);
 274         if (!NILP (display) && INTERACTIVE)
 275           redisplay_preserve_echo_area ();
 276         immediate_quit = 1;
 277         QUIT;
 278       }
 279   }
 280
 281   /* Wait for it to terminate, unless it already has.  */
 282   wait_for_termination (pid);
 283
 284   immediate_quit = 0;
 285
 286   set_buffer_internal (old);
 287
 288   unbind_to (count, Qnil);
 289
 290   if (synch_process_death)
 291     return build_string (synch_process_death);
 292   return make_number (synch_process_retcode);
 293 }
 294 #endif
 295 \f
 296 static void
 297 delete_temp_file (name)
 298      Lisp_Object name;
 299 {
 300   unlink (XSTRING (name)->data);
 301 }
 302
 303 DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
 304   3, MANY, 0,
 305   "Send text from START to END to a synchronous process running PROGRAM.\n\
 306 Delete the text if fourth arg DELETE is non-nil.\n\
 307 Insert output in BUFFER before point; t means current buffer;\n\
 308  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 309 Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 310 Remaining args are passed to PROGRAM at startup as command args.\n\
 311 If BUFFER is nil, returns immediately with value nil.\n\
 312 Otherwise waits for PROGRAM to terminate\n\
 313 and returns a numeric exit status or a signal name as a string.\n\
 314 If you quit, the process is killed with SIGKILL.")
 315   (nargs, args)
 316      int nargs;
 317      register Lisp_Object *args;
 318 {
 319   register Lisp_Object filename_string, start, end;
 320   char tempfile[20];
 321   int count = specpdl_ptr - specpdl;
 322
 323 #ifdef VMS
 324   strcpy (tempfile, "tmp:emacsXXXXXX.");
 325 #else
 326   strcpy (tempfile, "/tmp/emacsXXXXXX");
 327 #endif
 328   mktemp (tempfile);
 329
 330   filename_string = build_string (tempfile);
 331   start = args[0];
 332   end = args[1];
 333   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 334   record_unwind_protect (delete_temp_file, filename_string);
 335
 336   if (!NILP (args[3]))
 337     Fdelete_region (start, end);
 338
 339   args[3] = filename_string;
 340   Fcall_process (nargs - 2, args + 2);
 341
 342   return unbind_to (count, Qnil);
 343 }
 344 \f
 345 #ifndef VMS /* VMS version is in vmsproc.c.  */
 346
 347 /* This is the last thing run in a newly forked inferior
 348    either synchronous or asynchronous.
 349    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
 350    Initialize inferior's priority, pgrp, connected dir and environment.
 351    then exec another program based on new_argv.
 352
 353    This function may change environ for the superior process.
 354    Therefore, the superior process must save and restore the value
 355    of environ around the vfork and the call to this function.
 356
 357    ENV is the environment for the subprocess.
 358
 359    SET_PGRP is nonzero if we should put the subprocess into a separate
 360    process group.
 361
 362    CURRENT_DIR is an elisp string giving the path of the current
 363    directory the subprocess should have.  Since we can't really signal
 364    a decent error from within the child, this should be verified as an
 365    executable directory by the parent.  */
 366
 367 child_setup (in, out, err, new_argv, env, set_pgrp, current_dir)
 368      int in, out, err;
 369      register char **new_argv;
 370      char **env;
 371      int set_pgrp;
 372      Lisp_Object current_dir;
 373 {
 374   register int pid = getpid();
 375
 376   setpriority (PRIO_PROCESS, pid, 0);
 377
 378 #ifdef subprocesses
 379   /* Close Emacs's descriptors that this process should not have.  */
 380   close_process_descs ();
 381 #endif
 382
 383   /* Note that use of alloca is always safe here.  It's obvious for systems
 384      that do not have true vfork or that have true (stack) alloca.
 385      If using vfork and C_ALLOCA it is safe because that changes
 386      the superior's static variables as if the superior had done alloca
 387      and will be cleaned up in the usual way.  */
 388   {
 389     register unsigned char *temp;
 390     register int i;
 391
 392     i = XSTRING (current_dir)->size;
 393     temp = (unsigned char *) alloca (i + 2);
 394     bcopy (XSTRING (current_dir)->data, temp, i);
 395     if (temp[i - 1] != '/') temp[i++] = '/';
 396     temp[i] = 0;
 397
 398     /* We can't signal an Elisp error here; we're in a vfork.  Since
 399        the callers check the current directory before forking, this
 400        should only return an error if the directory's permissions
 401        are changed between the check and this chdir, but we should
 402        at least check.  */
 403     if (chdir (temp) < 0)
 404       exit (errno);
 405   }
 406
 407   /* Set `env' to a vector of the strings in Vprocess_environment.  */
 408   {
 409     register Lisp_Object tem;
 410     register char **new_env;
 411     register int new_length;
 412
 413     new_length = 0;
 414     for (tem = Vprocess_environment;
 415          (XTYPE (tem) == Lisp_Cons
 416           && XTYPE (XCONS (tem)->car) == Lisp_String);
 417          tem = XCONS (tem)->cdr)
 418       new_length++;
 419
 420     /* new_length + 1 to include terminating 0 */
 421     env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));
 422
 423     /* Copy the env strings into new_env.  */
 424     for (tem = Vprocess_environment;
 425          (XTYPE (tem) == Lisp_Cons
 426           && XTYPE (XCONS (tem)->car) == Lisp_String);
 427          tem = XCONS (tem)->cdr)
 428       *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
 429     *new_env = 0;
 430   }
 431
 432   close (0);
 433   close (1);
 434   close (2);
 435
 436   dup2 (in, 0);
 437   dup2 (out, 1);
 438   dup2 (err, 2);
 439   close (in);
 440   close (out);
 441   close (err);
 442
 443 #ifdef USG
 444   setpgrp ();                   /* No arguments but equivalent in this case */
 445 #else
 446   setpgrp (pid, pid);
 447 #endif /* USG */
 448   setpgrp_of_tty (pid);
 449
 450 #ifdef vipc
 451   something missing here;
 452 #endif /* vipc */
 453
 454   /* execvp does not accept an environment arg so the only way
 455      to pass this environment is to set environ.  Our caller
 456      is responsible for restoring the ambient value of environ.  */
 457   environ = env;
 458   execvp (new_argv[0], new_argv);
 459
 460   write (1, "Couldn't exec the program ", 26);
 461   write (1, new_argv[0], strlen (new_argv[0]));
 462   _exit (1);
 463 }
 464
 465 static int
 466 getenv_internal (var, varlen, value, valuelen)
 467      char *var;
 468      int varlen;
 469      char **value;
 470      int *valuelen;
 471 {
 472   Lisp_Object scan;
 473
 474   for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr)
 475     {
 476       Lisp_Object entry = XCONS (scan)->car;
 477
 478       if (XTYPE (entry) == Lisp_String
 479           && XSTRING (entry)->size > varlen
 480           && XSTRING (entry)->data[varlen] == '='
 481           && ! bcmp (XSTRING (entry)->data, var, varlen))
 482         {
 483           *value    = (char *) XSTRING (entry)->data + (varlen + 1);
 484           *valuelen = XSTRING (entry)->size - (varlen + 1);
 485           return 1;
 486         }
 487     }
 488
 489   return 0;
 490 }
 491
 492 DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
 493   "Return the value of environment variable VAR, as a string.\n\
 494 VAR should be a string.  Value is nil if VAR is undefined in the environment.\n\
 495 This function consults the variable ``process-environment'' for its value.")
 496   (var)
 497      Lisp_Object var;
 498 {
 499   char *value;
 500   int valuelen;
 501
 502   CHECK_STRING (var, 0);
 503   if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size,
 504                        &value, &valuelen))
 505     return make_string (value, valuelen);
 506   else
 507     return Qnil;
 508 }
 509
 510 /* A version of getenv that consults process_environment, easily
 511    callable from C.  */
 512 char *
 513 egetenv (var)
 514 {
 515   char *value;
 516   int valuelen;
 517
 518   if (getenv_internal (var, strlen (var), &value, &valuelen))
 519     return value;
 520   else
 521     return 0;
 522 }
 523
 524 #endif /* not VMS */
 525 \f
 526 init_callproc ()
 527 {
 528   register char * sh;
 529   register char **envp;
 530   Lisp_Object tempdir;
 531
 532   Vdata_directory = Ffile_name_as_directory (build_string (PATH_DATA));
 533
 534   /* Turn PATH_EXEC into a path.  `==' is just a string which we know
 535      will not be the name of an environment variable.  */
 536   Vexec_path = decode_env_path ("==", PATH_EXEC);
 537   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
 538   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 539
 540   tempdir = Fdirectory_file_name (Vexec_directory);
 541   if (access (XSTRING (tempdir)->data, 0) < 0)
 542     {
 543       printf ("Warning: arch-dependent data dir (%s) does not exist.\n",
 544               XSTRING (Vexec_directory)->data);
 545       sleep (2);
 546     }
 547
 548   tempdir = Fdirectory_file_name (Vdata_directory);
 549   if (access (XSTRING (tempdir)->data, 0) < 0)
 550     {
 551       printf ("Warning: arch-independent data dir (%s) does not exist.\n",
 552               XSTRING (Vdata_directory)->data);
 553       sleep (2);
 554     }
 555
 556 #ifdef VMS
 557   Vshell_file_name = build_string ("*dcl*");
 558 #else
 559   sh = (char *) getenv ("SHELL");
 560   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 561 #endif
 562
 563   Vprocess_environment = Qnil;
 564 #ifndef CANNOT_DUMP
 565   if (initialized)
 566 #endif
 567     for (envp = environ; *envp; envp++)
 568       Vprocess_environment = Fcons (build_string (*envp),
 569                                     Vprocess_environment);
 570 }
 571
 572 syms_of_callproc ()
 573 {
 574   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
 575     "*File name to load inferior shells from.\n\
 576 Initialized from the SHELL environment variable.");
 577
 578   DEFVAR_LISP ("exec-path", &Vexec_path,
 579     "*List of directories to search programs to run in subprocesses.\n\
 580 Each element is a string (directory name) or nil (try default directory).");
 581
 582   DEFVAR_LISP ("exec-directory", &Vexec_directory,
 583     "Directory of architecture-dependent files that come with GNU Emacs,\n\
 584 especially executable programs intended for Emacs to invoke.");
 585
 586   DEFVAR_LISP ("data-directory", &Vdata_directory,
 587     "Directory of architecture-independent files that come with GNU Emacs,\n\
 588 intended for Emacs to use.");
 589
 590   DEFVAR_LISP ("process-environment", &Vprocess_environment,
 591     "List of environment variables for subprocesses to inherit.\n\
 592 Each element should be a string of the form ENVVARNAME=VALUE.\n\
 593 The environment which Emacs inherits is placed in this variable\n\
 594 when Emacs starts.");
 595
 596 #ifndef VMS
 597   defsubr (&Scall_process);
 598 #endif
 599   defsubr (&Sgetenv);
 600   defsubr (&Scall_process_region);
 601 }