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
  23 #include "config.h"
  24
  25 /* Define SIGCHLD as an alias for SIGCLD.  */
  26
  27 #if !defined (SIGCHLD) && defined (SIGCLD)
  28 #define SIGCHLD SIGCLD
  29 #endif /* SIGCLD */
  30
  31 #include <sys/types.h>
  32 #define PRIO_PROCESS 0
  33 #include <sys/file.h>
  34 #ifdef USG5
  35 #include <fcntl.h>
  36 #endif
  37
  38 #ifndef O_RDONLY
  39 #define O_RDONLY 0
  40 #endif
  41
  42 #ifndef O_WRONLY
  43 #define O_WRONLY 1
  44 #endif
  45
  46 #include "lisp.h"
  47 #include "commands.h"
  48 #include "buffer.h"
  49 #include "paths.h"
  50 #include "process.h"
  51
  52 #ifdef VMS
  53 extern noshare char **environ;
  54 #else
  55 extern char **environ;
  56 #endif
  57
  58 #define max(a, b) ((a) > (b) ? (a) : (b))
  59
  60 Lisp_Object Vexec_path, Vexec_directory;
  61
  62 Lisp_Object Vshell_file_name;
  63
  64 #ifndef MAINTAIN_ENVIRONMENT
  65 /* List of strings to append to front of environment of
  66    all subprocesses when they are started.  */
  67
  68 Lisp_Object Vprocess_environment;
  69 #endif
  70
  71 /* True iff we are about to fork off a synchronous process or if we
  72    are waiting for it.  */
  73 int synch_process_alive;
  74
  75 /* Nonzero => this is a string explaining death of synchronous subprocess.  */
  76 char *synch_process_death;
  77
  78 /* If synch_process_death is zero,
  79    this is exit code of synchronous subprocess.  */
  80 int synch_process_retcode;
  81 \f
  82 #ifndef VMS  /* VMS version is in vmsproc.c.  */
  83
  84 Lisp_Object
  85 call_process_cleanup (fdpid)
  86      Lisp_Object fdpid;
  87 {
  88   register Lisp_Object fd, pid;
  89   fd = Fcar (fdpid);
  90   pid = Fcdr (fdpid);
  91   close (XFASTINT (fd));
  92   kill (XFASTINT (pid), SIGKILL);
  93   synch_process_alive = 0;
  94   return Qnil;
  95 }
  96
  97 DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  98   "Call PROGRAM synchronously in separate process.\n\
  99 The program's input comes from file INFILE (nil means `/dev/null').\n\
 100 Insert output in BUFFER before point; t means current buffer;\n\
 101  nil for BUFFER means discard it; 0 means discard and don't wait.\n\
 102 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
 103 Remaining arguments are strings passed as command arguments to PROGRAM.\n\
 104 If BUFFER is nil or 0, returns immediately with value nil.\n\
 105 Otherwise waits for PROGRAM to terminate\n\
 106 and returns a numeric exit status or a signal name as a string.\n\
 107 If you quit, the process is killed with SIGKILL.")
 108   (nargs, args)
 109      int nargs;
 110      register Lisp_Object *args;
 111 {
 112   Lisp_Object display, buffer, path;
 113   int fd[2];
 114   int filefd;
 115   register int pid;
 116   char buf[1024];
 117   int count = specpdl_ptr - specpdl;
 118   register unsigned char **new_argv
 119     = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
 120   struct buffer *old = current_buffer;
 121 #if 0
 122   int mask;
 123 #endif
 124   struct gcpro gcpro1;
 125
 126   GCPRO1 (*args);
 127   gcpro1.nvars = nargs;
 128
 129   CHECK_STRING (args[0], 0);
 130
 131   if (nargs <= 1 || NULL (args[1]))
 132     args[1] = build_string ("/dev/null");
 133   else
 134     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
 135
 136   CHECK_STRING (args[1], 1);
 137
 138   {
 139     register Lisp_Object tem;
 140     buffer = tem = args[2];
 141     if (nargs <= 2)
 142       buffer = Qnil;
 143     else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
 144                || XFASTINT (tem) == 0))
 145       {
 146         buffer = Fget_buffer (tem);
 147         CHECK_BUFFER (buffer, 2);
 148       }
 149   }
 150
 151   display = nargs >= 3 ? args[3] : Qnil;
 152
 153   {
 154     register int i;
 155     for (i = 4; i < nargs; i++)
 156       {
 157         CHECK_STRING (args[i], i);
 158         new_argv[i - 3] = XSTRING (args[i])->data;
 159       }
 160     /* Program name is first command arg */
 161     new_argv[0] = XSTRING (args[0])->data;
 162     new_argv[i - 3] = 0;
 163   }
 164
 165   filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
 166   if (filefd < 0)
 167     {
 168       report_file_error ("Opening process input file", Fcons (args[1], Qnil));
 169     }
 170   /* Search for program; barf if not found.  */
 171   openp (Vexec_path, args[0], "", &path, 1);
 172   if (NULL (path))
 173     {
 174       close (filefd);
 175       report_file_error ("Searching for program", Fcons (args[0], Qnil));
 176     }
 177   new_argv[0] = XSTRING (path)->data;
 178
 179   if (XTYPE (buffer) == Lisp_Int)
 180     fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
 181   else
 182     {
 183       pipe (fd);
 184 #if 0
 185       /* Replaced by close_process_descs */
 186       set_exclusive_use (fd[0]);
 187 #endif
 188     }
 189
 190   {
 191     /* child_setup must clobber environ in systems with true vfork.
 192        Protect it from permanent change.  */
 193     register char **save_environ = environ;
 194     register int fd1 = fd[1];
 195     char **env;
 196
 197 #ifdef MAINTAIN_ENVIRONMENT
 198     env = (char **) alloca (size_of_current_environ ());
 199     get_current_environ (env);
 200 #else
 201     env = environ;
 202 #endif /* MAINTAIN_ENVIRONMENT */
 203
 204 #if 0  /* Some systems don't have sigblock.  */
 205     mask = sigblock (sigmask (SIGCHLD));
 206 #endif
 207
 208     /* Record that we're about to create a synchronous process.  */
 209     synch_process_alive = 1;
 210
 211     pid = vfork ();
 212
 213     if (pid == 0)
 214       {
 215         if (fd[0] >= 0)
 216           close (fd[0]);
 217 #ifdef USG
 218         setpgrp ();
 219 #else
 220         setpgrp (pid, pid);
 221 #endif /* USG */
 222         child_setup (filefd, fd1, fd1, new_argv, env, 0);
 223       }
 224
 225 #if 0
 226     /* Tell SIGCHLD handler to look for this pid.  */
 227     synch_process_pid = pid;
 228     /* Now let SIGCHLD come through.  */
 229     sigsetmask (mask);
 230 #endif
 231
 232     environ = save_environ;
 233
 234     close (filefd);
 235     close (fd1);
 236   }
 237
 238   if (pid < 0)
 239     {
 240       close (fd[0]);
 241       report_file_error ("Doing vfork", Qnil);
 242     }
 243
 244   if (XTYPE (buffer) == Lisp_Int)
 245     {
 246 #ifndef subprocesses
 247       wait_without_blocking ();
 248 #endif /* subprocesses */
 249
 250       UNGCPRO;
 251       return Qnil;
 252     }
 253
 254   record_unwind_protect (call_process_cleanup,
 255                          Fcons (make_number (fd[0]), make_number (pid)));
 256
 257
 258   if (XTYPE (buffer) == Lisp_Buffer)
 259     Fset_buffer (buffer);
 260
 261   immediate_quit = 1;
 262   QUIT;
 263
 264   {
 265     register int nread;
 266
 267     while ((nread = read (fd[0], buf, sizeof buf)) > 0)
 268       {
 269         immediate_quit = 0;
 270         if (!NULL (buffer))
 271           insert (buf, nread);
 272         if (!NULL (display) && INTERACTIVE)
 273           redisplay_preserve_echo_area ();
 274         immediate_quit = 1;
 275         QUIT;
 276       }
 277   }
 278
 279   /* Wait for it to terminate, unless it already has.  */
 280   wait_for_termination (pid);
 281
 282   immediate_quit = 0;
 283
 284   set_buffer_internal (old);
 285
 286   unbind_to (count, Qnil);
 287
 288   UNGCPRO;
 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   struct gcpro gcpro1;
 323
 324   GCPRO1 (*args);
 325   gcpro1.nvars = 2;
 326
 327 #ifdef VMS
 328   strcpy (tempfile, "tmp:emacsXXXXXX.");
 329 #else
 330   strcpy (tempfile, "/tmp/emacsXXXXXX");
 331 #endif
 332   mktemp (tempfile);
 333
 334   filename_string = build_string (tempfile);
 335   start = args[0];
 336   end = args[1];
 337   Fwrite_region (start, end, filename_string, Qnil, Qlambda);
 338   record_unwind_protect (delete_temp_file, filename_string);
 339
 340   if (!NULL (args[3]))
 341     Fdelete_region (start, end);
 342
 343   args[3] = filename_string;
 344   Fcall_process (nargs - 2, args + 2);
 345
 346   UNGCPRO;
 347   return unbind_to (count, Qnil);
 348 }
 349 \f
 350 #ifndef VMS /* VMS version is in vmsproc.c.  */
 351
 352 /* This is the last thing run in a newly forked inferior
 353    either synchronous or asynchronous.
 354    Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
 355    Initialize inferior's priority, pgrp, connected dir and environment.
 356    then exec another program based on new_argv.
 357
 358    This function may change environ for the superior process.
 359    Therefore, the superior process must save and restore the value
 360    of environ around the vfork and the call to this function.
 361
 362    ENV is the environment for the subprocess.
 363
 364    SET_PGRP is nonzero if we should put the subprocess into a separate
 365    process group.  */
 366
 367 child_setup (in, out, err, new_argv, env, set_pgrp)
 368      int in, out, err;
 369      register char **new_argv;
 370      char **env;
 371      int set_pgrp;
 372 {
 373   register int pid = getpid();
 374
 375   setpriority (PRIO_PROCESS, pid, 0);
 376
 377 #ifdef subprocesses
 378   /* Close Emacs's descriptors that this process should not have.  */
 379   close_process_descs ();
 380 #endif
 381
 382   /* Note that use of alloca is always safe here.  It's obvious for systems
 383      that do not have true vfork or that have true (stack) alloca.
 384      If using vfork and C_ALLOCA it is safe because that changes
 385      the superior's static variables as if the superior had done alloca
 386      and will be cleaned up in the usual way.  */
 387
 388   if (XTYPE (current_buffer->directory) == Lisp_String)
 389     {
 390       register unsigned char *temp;
 391       register int i;
 392
 393       i = XSTRING (current_buffer->directory)->size;
 394       temp = (unsigned char *) alloca (i + 2);
 395       bcopy (XSTRING (current_buffer->directory)->data, temp, i);
 396       if (temp[i - 1] != '/') temp[i++] = '/';
 397       temp[i] = 0;
 398       /* Switch to that directory, and report any error.  */
 399       if (chdir (temp) < 0)
 400         report_file_error ("In chdir",
 401                            Fcons (current_buffer->directory, Qnil));
 402     }
 403
 404 #ifndef MAINTAIN_ENVIRONMENT
 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 #endif /* Not MAINTAIN_ENVIRONMENT */
 430
 431   close (0);
 432   close (1);
 433   close (2);
 434
 435   dup2 (in, 0);
 436   dup2 (out, 1);
 437   dup2 (err, 2);
 438   close (in);
 439   close (out);
 440   close (err);
 441
 442   setpgrp_of_tty (pid);
 443
 444 #ifdef vipc
 445   something missing here;
 446 #endif /* vipc */
 447
 448   /* execvp does not accept an environment arg so the only way
 449      to pass this environment is to set environ.  Our caller
 450      is responsible for restoring the ambient value of environ.  */
 451   environ = env;
 452   execvp (new_argv[0], new_argv);
 453
 454   write (1, "Couldn't exec the program ", 26);
 455   write (1, new_argv[0], strlen (new_argv[0]));
 456   _exit (1);
 457 }
 458
 459 #endif /* not VMS */
 460 \f
 461 init_callproc ()
 462 {
 463   register char * sh;
 464   register char **envp;
 465   Lisp_Object execdir;
 466
 467   /* Turn PATH_EXEC into a path.  `==' is just a string which we know
 468      will not be the name of an environment variable.  */
 469   Vexec_path = decode_env_path ("==", PATH_EXEC);
 470   Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
 471   Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);
 472
 473   execdir = Fdirectory_file_name (Vexec_directory);
 474   if (access (XSTRING (execdir)->data, 0) < 0)
 475     {
 476       printf ("Warning: executable/documentation dir (%s) does not exist.\n",
 477               XSTRING (Vexec_directory)->data);
 478       sleep (2);
 479     }
 480
 481 #ifdef VMS
 482   Vshell_file_name = build_string ("*dcl*");
 483 #else
 484   sh = (char *) egetenv ("SHELL");
 485   Vshell_file_name = build_string (sh ? sh : "/bin/sh");
 486 #endif
 487
 488 #ifndef MAINTAIN_ENVIRONMENT
 489   /* The equivalent of this operation was done
 490      in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
 491   Vprocess_environment = Qnil;
 492 #ifndef CANNOT_DUMP
 493   if (initialized)
 494 #endif
 495     for (envp = environ; *envp; envp++)
 496       Vprocess_environment = Fcons (build_string (*envp),
 497                                     Vprocess_environment);
 498 #endif /* MAINTAIN_ENVIRONMENT */
 499 }
 500
 501 syms_of_callproc ()
 502 {
 503   DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
 504     "*File name to load inferior shells from.\n\
 505 Initialized from the SHELL environment variable.");
 506
 507   DEFVAR_LISP ("exec-path", &Vexec_path,
 508     "*List of directories to search programs to run in subprocesses.\n\
 509 Each element is a string (directory name) or nil (try default directory).");
 510
 511   DEFVAR_LISP ("exec-directory", &Vexec_directory,
 512     "Directory that holds programs that come with GNU Emacs,\n\
 513 intended for Emacs to invoke.");
 514
 515 #ifndef MAINTAIN_ENVIRONMENT
 516   DEFVAR_LISP ("process-environment", &Vprocess_environment,
 517     "List of strings to append to environment of subprocesses that are started.\n\
 518 Each string should have the format ENVVARNAME=VALUE.");
 519 #endif
 520
 521 #ifndef VMS
 522   defsubr (&Scall_process);
 523 #endif
 524   defsubr (&Scall_process_region);
 525 }