callproc.c 13.5 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Synchronous subprocess invocation for GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
2
   Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include <signal.h>

#include "config.h"

/* Define SIGCHLD as an alias for SIGCLD.  */

#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif /* SIGCLD */

#include <sys/types.h>
#define PRIO_PROCESS 0
#include <sys/file.h>
#ifdef USG5
#include <fcntl.h>
#endif

#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#ifndef O_WRONLY
#define O_WRONLY 1
#endif

#include "lisp.h"
#include "commands.h"
#include "buffer.h"
#include "paths.h"
#include "process.h"

#ifdef VMS
extern noshare char **environ;
#else
extern char **environ;
#endif

#define max(a, b) ((a) > (b) ? (a) : (b))

Richard M. Stallman's avatar
Richard M. Stallman committed
60
Lisp_Object Vexec_path, Vexec_directory;
Jim Blandy's avatar
Jim Blandy committed
61 62 63

Lisp_Object Vshell_file_name;

Richard M. Stallman's avatar
Richard M. Stallman committed
64 65 66 67
#ifndef MAINTAIN_ENVIRONMENT
/* List of strings to append to front of environment of
   all subprocesses when they are started.  */

Jim Blandy's avatar
Jim Blandy committed
68
Lisp_Object Vprocess_environment;
Richard M. Stallman's avatar
Richard M. Stallman committed
69
#endif
Jim Blandy's avatar
Jim Blandy committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105

/* True iff we are about to fork off a synchronous process or if we
   are waiting for it.  */
int synch_process_alive;

/* Nonzero => this is a string explaining death of synchronous subprocess.  */
char *synch_process_death;

/* If synch_process_death is zero,
   this is exit code of synchronous subprocess.  */
int synch_process_retcode;

#ifndef VMS  /* VMS version is in vmsproc.c.  */

Lisp_Object
call_process_cleanup (fdpid)
     Lisp_Object fdpid;
{
  register Lisp_Object fd, pid;
  fd = Fcar (fdpid);
  pid = Fcdr (fdpid);
  close (XFASTINT (fd));
  kill (XFASTINT (pid), SIGKILL);
  synch_process_alive = 0;
  return Qnil;
}

DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
  "Call PROGRAM synchronously in separate process.\n\
The program's input comes from file INFILE (nil means `/dev/null').\n\
Insert output in BUFFER before point; t means current buffer;\n\
 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining arguments are strings passed as command arguments to PROGRAM.\n\
If BUFFER is nil or 0, returns immediately with value nil.\n\
Otherwise waits for PROGRAM to terminate\n\
Richard M. Stallman's avatar
Richard M. Stallman committed
106
and returns a numeric exit status or a signal name as a string.\n\
Jim Blandy's avatar
Jim Blandy committed
107 108 109 110 111
If you quit, the process is killed with SIGKILL.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
Richard M. Stallman's avatar
Richard M. Stallman committed
112
  Lisp_Object display, buffer, path;
Jim Blandy's avatar
Jim Blandy committed
113 114 115 116 117 118 119 120 121 122 123
  int fd[2];
  int filefd;
  register int pid;
  char buf[1024];
  int count = specpdl_ptr - specpdl;
  register unsigned char **new_argv
    = (unsigned char **) alloca ((max (2, nargs - 2)) * sizeof (char *));
  struct buffer *old = current_buffer;
#if 0
  int mask;
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
124 125 126 127 128
  struct gcpro gcpro1;

  GCPRO1 (*args);
  gcpro1.nvars = nargs;

Jim Blandy's avatar
Jim Blandy committed
129 130
  CHECK_STRING (args[0], 0);

Richard M. Stallman's avatar
Richard M. Stallman committed
131 132
  if (nargs <= 1 || NULL (args[1]))
    args[1] = build_string ("/dev/null");
Jim Blandy's avatar
Jim Blandy committed
133
  else
Richard M. Stallman's avatar
Richard M. Stallman committed
134
    args[1] = Fexpand_file_name (args[1], current_buffer->directory);
Jim Blandy's avatar
Jim Blandy committed
135

Richard M. Stallman's avatar
Richard M. Stallman committed
136 137 138 139 140 141 142 143 144 145 146 147 148 149
  CHECK_STRING (args[1], 1);

  {
    register Lisp_Object tem;
    buffer = tem = args[2];
    if (nargs <= 2)
      buffer = Qnil;
    else if (!(EQ (tem, Qnil) || EQ (tem, Qt)
	       || XFASTINT (tem) == 0))
      {
	buffer = Fget_buffer (tem);
	CHECK_BUFFER (buffer, 2);
      }
  }
Jim Blandy's avatar
Jim Blandy committed
150

Richard M. Stallman's avatar
Richard M. Stallman committed
151
  display = nargs >= 3 ? args[3] : Qnil;
Jim Blandy's avatar
Jim Blandy committed
152 153 154 155 156 157 158 159 160 161 162 163 164

  {
    register int i;
    for (i = 4; i < nargs; i++)
      {
	CHECK_STRING (args[i], i);
	new_argv[i - 3] = XSTRING (args[i])->data;
      }
    /* Program name is first command arg */
    new_argv[0] = XSTRING (args[0])->data;
    new_argv[i - 3] = 0;
  }

Richard M. Stallman's avatar
Richard M. Stallman committed
165
  filefd = open (XSTRING (args[1])->data, O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
166 167
  if (filefd < 0)
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
168
      report_file_error ("Opening process input file", Fcons (args[1], Qnil));
Jim Blandy's avatar
Jim Blandy committed
169 170 171
    }
  /* Search for program; barf if not found.  */
  openp (Vexec_path, args[0], "", &path, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
172
  if (NULL (path))
Jim Blandy's avatar
Jim Blandy committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
    {
      close (filefd);
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }
  new_argv[0] = XSTRING (path)->data;

  if (XTYPE (buffer) == Lisp_Int)
    fd[1] = open ("/dev/null", O_WRONLY), fd[0] = -1;
  else
    {
      pipe (fd);
#if 0
      /* Replaced by close_process_descs */
      set_exclusive_use (fd[0]);
#endif
    }

  {
    /* child_setup must clobber environ in systems with true vfork.
       Protect it from permanent change.  */
    register char **save_environ = environ;
    register int fd1 = fd[1];
Richard M. Stallman's avatar
Richard M. Stallman committed
195 196 197 198 199 200 201 202
    char **env;

#ifdef MAINTAIN_ENVIRONMENT
    env = (char **) alloca (size_of_current_environ ());
    get_current_environ (env);
#else
    env = environ;
#endif /* MAINTAIN_ENVIRONMENT */
Jim Blandy's avatar
Jim Blandy committed
203 204

#if 0  /* Some systems don't have sigblock.  */
Jim Blandy's avatar
Jim Blandy committed
205
    mask = sigblock (sigmask (SIGCHLD));
Jim Blandy's avatar
Jim Blandy committed
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
#endif

    /* Record that we're about to create a synchronous process.  */
    synch_process_alive = 1;

    pid = vfork ();

    if (pid == 0)
      {
	if (fd[0] >= 0)
	  close (fd[0]);
#ifdef USG
        setpgrp ();
#else
        setpgrp (pid, pid);
#endif /* USG */
Richard M. Stallman's avatar
Richard M. Stallman committed
222
	child_setup (filefd, fd1, fd1, new_argv, env, 0);
Jim Blandy's avatar
Jim Blandy committed
223 224 225 226 227 228
      }

#if 0
    /* Tell SIGCHLD handler to look for this pid.  */
    synch_process_pid = pid;
    /* Now let SIGCHLD come through.  */
Jim Blandy's avatar
Jim Blandy committed
229
    sigsetmask (mask);
Jim Blandy's avatar
Jim Blandy committed
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
#endif

    environ = save_environ;

    close (filefd);
    close (fd1);
  }

  if (pid < 0)
    {
      close (fd[0]);
      report_file_error ("Doing vfork", Qnil);
    }

  if (XTYPE (buffer) == Lisp_Int)
    {
#ifndef subprocesses
      wait_without_blocking ();
#endif /* subprocesses */
Richard M. Stallman's avatar
Richard M. Stallman committed
249 250

      UNGCPRO;
Jim Blandy's avatar
Jim Blandy committed
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
      return Qnil;
    }

  record_unwind_protect (call_process_cleanup,
			 Fcons (make_number (fd[0]), make_number (pid)));


  if (XTYPE (buffer) == Lisp_Buffer)
    Fset_buffer (buffer);

  immediate_quit = 1;
  QUIT;

  {
    register int nread;

    while ((nread = read (fd[0], buf, sizeof buf)) > 0)
      {
	immediate_quit = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
270
	if (!NULL (buffer))
Jim Blandy's avatar
Jim Blandy committed
271
	  insert (buf, nread);
Richard M. Stallman's avatar
Richard M. Stallman committed
272
	if (!NULL (display) && INTERACTIVE)
Jim Blandy's avatar
Jim Blandy committed
273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
	  redisplay_preserve_echo_area ();
	immediate_quit = 1;
	QUIT;
      }
  }

  /* Wait for it to terminate, unless it already has.  */
  wait_for_termination (pid);

  immediate_quit = 0;

  set_buffer_internal (old);

  unbind_to (count, Qnil);

Richard M. Stallman's avatar
Richard M. Stallman committed
288 289
  UNGCPRO;

Jim Blandy's avatar
Jim Blandy committed
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
  if (synch_process_death)
    return build_string (synch_process_death);
  return make_number (synch_process_retcode);
}
#endif

static void
delete_temp_file (name)
     Lisp_Object name;
{
  unlink (XSTRING (name)->data);
}

DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
  3, MANY, 0,
  "Send text from START to END to a synchronous process running PROGRAM.\n\
Delete the text if fourth arg DELETE is non-nil.\n\
Insert output in BUFFER before point; t means current buffer;\n\
 nil for BUFFER means discard it; 0 means discard and don't wait.\n\
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\
Remaining args are passed to PROGRAM at startup as command args.\n\
If BUFFER is nil, returns immediately with value nil.\n\
Otherwise waits for PROGRAM to terminate\n\
Richard M. Stallman's avatar
Richard M. Stallman committed
313
and returns a numeric exit status or a signal name as a string.\n\
Jim Blandy's avatar
Jim Blandy committed
314 315 316 317 318 319 320 321
If you quit, the process is killed with SIGKILL.")
  (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
  register Lisp_Object filename_string, start, end;
  char tempfile[20];
  int count = specpdl_ptr - specpdl;
Richard M. Stallman's avatar
Richard M. Stallman committed
322 323 324 325
  struct gcpro gcpro1;

  GCPRO1 (*args);
  gcpro1.nvars = 2;
Jim Blandy's avatar
Jim Blandy committed
326 327 328 329 330 331 332 333 334 335 336 337 338 339

#ifdef VMS
  strcpy (tempfile, "tmp:emacsXXXXXX.");
#else
  strcpy (tempfile, "/tmp/emacsXXXXXX");
#endif
  mktemp (tempfile);

  filename_string = build_string (tempfile);
  start = args[0];
  end = args[1];
  Fwrite_region (start, end, filename_string, Qnil, Qlambda);
  record_unwind_protect (delete_temp_file, filename_string);

Richard M. Stallman's avatar
Richard M. Stallman committed
340
  if (!NULL (args[3]))
Jim Blandy's avatar
Jim Blandy committed
341 342 343 344 345
    Fdelete_region (start, end);

  args[3] = filename_string;
  Fcall_process (nargs - 2, args + 2);

Richard M. Stallman's avatar
Richard M. Stallman committed
346
  UNGCPRO;
Jim Blandy's avatar
Jim Blandy committed
347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
  return unbind_to (count, Qnil);
}

#ifndef VMS /* VMS version is in vmsproc.c.  */

/* This is the last thing run in a newly forked inferior
   either synchronous or asynchronous.
   Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
   Initialize inferior's priority, pgrp, connected dir and environment.
   then exec another program based on new_argv.

   This function may change environ for the superior process.
   Therefore, the superior process must save and restore the value
   of environ around the vfork and the call to this function.

   ENV is the environment for the subprocess.

   SET_PGRP is nonzero if we should put the subprocess into a separate
Richard M. Stallman's avatar
Richard M. Stallman committed
365
   process group.  */
Jim Blandy's avatar
Jim Blandy committed
366

Richard M. Stallman's avatar
Richard M. Stallman committed
367
child_setup (in, out, err, new_argv, env, set_pgrp)
Jim Blandy's avatar
Jim Blandy committed
368 369
     int in, out, err;
     register char **new_argv;
Richard M. Stallman's avatar
Richard M. Stallman committed
370
     char **env;
Jim Blandy's avatar
Jim Blandy committed
371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386
     int set_pgrp;
{
  register int pid = getpid();

  setpriority (PRIO_PROCESS, pid, 0);

#ifdef subprocesses
  /* Close Emacs's descriptors that this process should not have.  */
  close_process_descs ();
#endif

  /* Note that use of alloca is always safe here.  It's obvious for systems
     that do not have true vfork or that have true (stack) alloca.
     If using vfork and C_ALLOCA it is safe because that changes
     the superior's static variables as if the superior had done alloca
     and will be cleaned up in the usual way.  */
Jim Blandy's avatar
Jim Blandy committed
387

Richard M. Stallman's avatar
Richard M. Stallman committed
388 389 390 391 392 393 394 395 396 397 398 399 400 401 402
  if (XTYPE (current_buffer->directory) == Lisp_String)
    {
      register unsigned char *temp;
      register int i;

      i = XSTRING (current_buffer->directory)->size;
      temp = (unsigned char *) alloca (i + 2);
      bcopy (XSTRING (current_buffer->directory)->data, temp, i);
      if (temp[i - 1] != '/') temp[i++] = '/';
      temp[i] = 0;
      /* Switch to that directory, and report any error.  */
      if (chdir (temp) < 0)
	report_file_error ("In chdir",
			   Fcons (current_buffer->directory, Qnil));
    }
Jim Blandy's avatar
Jim Blandy committed
403

Richard M. Stallman's avatar
Richard M. Stallman committed
404
#ifndef MAINTAIN_ENVIRONMENT
Jim Blandy's avatar
Jim Blandy committed
405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420
  /* Set `env' to a vector of the strings in Vprocess_environment.  */
  {
    register Lisp_Object tem;
    register char **new_env;
    register int new_length;

    new_length = 0;
    for (tem = Vprocess_environment;
	 (XTYPE (tem) == Lisp_Cons
	  && XTYPE (XCONS (tem)->car) == Lisp_String);
	 tem = XCONS (tem)->cdr)
      new_length++;

    /* new_length + 1 to include terminating 0 */
    env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *));

Richard M. Stallman's avatar
Richard M. Stallman committed
421
    /* Copy the env strings into new_env.  */
Jim Blandy's avatar
Jim Blandy committed
422 423 424 425 426 427 428
    for (tem = Vprocess_environment;
	 (XTYPE (tem) == Lisp_Cons
	  && XTYPE (XCONS (tem)->car) == Lisp_String);
	 tem = XCONS (tem)->cdr)
      *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data;
    *new_env = 0;
  }
Richard M. Stallman's avatar
Richard M. Stallman committed
429
#endif /* Not MAINTAIN_ENVIRONMENT */
Jim Blandy's avatar
Jim Blandy committed
430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464

  close (0);
  close (1);
  close (2);

  dup2 (in, 0);
  dup2 (out, 1);
  dup2 (err, 2);
  close (in);
  close (out);
  close (err);

  setpgrp_of_tty (pid);

#ifdef vipc
  something missing here;
#endif /* vipc */

  /* execvp does not accept an environment arg so the only way
     to pass this environment is to set environ.  Our caller
     is responsible for restoring the ambient value of environ.  */
  environ = env;
  execvp (new_argv[0], new_argv);

  write (1, "Couldn't exec the program ", 26);
  write (1, new_argv[0], strlen (new_argv[0]));
  _exit (1);
}

#endif /* not VMS */

init_callproc ()
{
  register char * sh;
  register char **envp;
Richard M. Stallman's avatar
Richard M. Stallman committed
465
  Lisp_Object execdir;
Jim Blandy's avatar
Jim Blandy committed
466

Richard M. Stallman's avatar
Richard M. Stallman committed
467 468 469
  /* Turn PATH_EXEC into a path.  `==' is just a string which we know
     will not be the name of an environment variable.  */
  Vexec_path = decode_env_path ("==", PATH_EXEC);
Jim Blandy's avatar
Jim Blandy committed
470 471 472
  Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
  Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path);

Richard M. Stallman's avatar
Richard M. Stallman committed
473 474
  execdir = Fdirectory_file_name (Vexec_directory);
  if (access (XSTRING (execdir)->data, 0) < 0)
Jim Blandy's avatar
Jim Blandy committed
475
    {
Richard M. Stallman's avatar
Richard M. Stallman committed
476
      printf ("Warning: executable/documentation dir (%s) does not exist.\n",
Jim Blandy's avatar
Jim Blandy committed
477 478 479 480 481 482 483
	      XSTRING (Vexec_directory)->data);
      sleep (2);
    }

#ifdef VMS
  Vshell_file_name = build_string ("*dcl*");
#else
Richard M. Stallman's avatar
Richard M. Stallman committed
484
  sh = (char *) egetenv ("SHELL");
Jim Blandy's avatar
Jim Blandy committed
485 486 487
  Vshell_file_name = build_string (sh ? sh : "/bin/sh");
#endif

Richard M. Stallman's avatar
Richard M. Stallman committed
488 489 490
#ifndef MAINTAIN_ENVIRONMENT
  /* The equivalent of this operation was done
     in init_environ in environ.c if MAINTAIN_ENVIRONMENT */
Jim Blandy's avatar
Jim Blandy committed
491 492 493 494 495 496 497
  Vprocess_environment = Qnil;
#ifndef CANNOT_DUMP
  if (initialized)
#endif
    for (envp = environ; *envp; envp++)
      Vprocess_environment = Fcons (build_string (*envp),
				    Vprocess_environment);
Richard M. Stallman's avatar
Richard M. Stallman committed
498
#endif /* MAINTAIN_ENVIRONMENT */
Jim Blandy's avatar
Jim Blandy committed
499 500 501 502 503 504 505 506 507 508 509 510 511
}

syms_of_callproc ()
{
  DEFVAR_LISP ("shell-file-name", &Vshell_file_name,
    "*File name to load inferior shells from.\n\
Initialized from the SHELL environment variable.");

  DEFVAR_LISP ("exec-path", &Vexec_path,
    "*List of directories to search programs to run in subprocesses.\n\
Each element is a string (directory name) or nil (try default directory).");

  DEFVAR_LISP ("exec-directory", &Vexec_directory,
Richard M. Stallman's avatar
Richard M. Stallman committed
512 513
    "Directory that holds programs that come with GNU Emacs,\n\
intended for Emacs to invoke.");
Jim Blandy's avatar
Jim Blandy committed
514

Richard M. Stallman's avatar
Richard M. Stallman committed
515
#ifndef MAINTAIN_ENVIRONMENT
Jim Blandy's avatar
Jim Blandy committed
516
  DEFVAR_LISP ("process-environment", &Vprocess_environment,
Richard M. Stallman's avatar
Richard M. Stallman committed
517 518 519
    "List of strings to append to environment of subprocesses that are started.\n\
Each string should have the format ENVVARNAME=VALUE.");
#endif
Jim Blandy's avatar
Jim Blandy committed
520 521 522 523 524 525

#ifndef VMS
  defsubr (&Scall_process);
#endif
  defsubr (&Scall_process_region);
}