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