callproc.c 49.2 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Synchronous subprocess invocation for GNU Emacs.
2
   Copyright (C) 1985-1988, 1993-1995, 1999-2012
3
		 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

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
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19 20


21
#include <config.h>
22
#include <errno.h>
23
#include <stdio.h>
Jim Blandy's avatar
Jim Blandy committed
24
#include <sys/types.h>
25 26
#include <unistd.h>

Jim Blandy's avatar
Jim Blandy committed
27 28 29
#include <sys/file.h>
#include <fcntl.h>

30 31
#include "lisp.h"

32 33 34
#ifdef WINDOWSNT
#define NOMINMAX
#include <windows.h>
Geoff Voelker's avatar
Geoff Voelker committed
35
#include "w32.h"
36 37 38
#define _P_NOWAIT 1	/* from process.h */
#endif

39 40 41 42 43
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
#include <sys/stat.h>
#include <sys/param.h>
#endif /* MSDOS */

Jim Blandy's avatar
Jim Blandy committed
44
#include "commands.h"
45
#include "character.h"
46
#include "buffer.h"
Kenichi Handa's avatar
Kenichi Handa committed
47
#include "ccl.h"
Karl Heuer's avatar
Karl Heuer committed
48
#include "coding.h"
Kenichi Handa's avatar
Kenichi Handa committed
49
#include "composite.h"
50
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
51
#include "process.h"
52
#include "syssignal.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
53
#include "systty.h"
54
#include "syswait.h"
Kim F. Storm's avatar
Kim F. Storm committed
55
#include "blockinput.h"
56 57
#include "frame.h"
#include "termhooks.h"
Jim Blandy's avatar
Jim Blandy committed
58

Eli Zaretskii's avatar
Eli Zaretskii committed
59 60 61 62
#ifdef MSDOS
#include "msdos.h"
#endif

63 64 65 66
#ifdef HAVE_NS
#include "nsterm.h"
#endif

67 68 69
/* Pattern used by call-process-region to make temp files.  */
static Lisp_Object Vtemp_file_name_pattern;

70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
/* The next two variables are valid only while record-unwind-protect
   is in place during call-process for a synchronous subprocess.  At
   other times, their contents are irrelevant.  Doing this via static
   C variables is more convenient than putting them into the arguments
   of record-unwind-protect, as they need to be updated at randomish
   times in the code, and Lisp cannot always store these values as
   Emacs integers.  It's safe to use static variables here, as the
   code is never invoked reentrantly.  */

/* If nonzero, a process-ID that has not been reaped.  */
static pid_t synch_process_pid;

/* If nonnegative, a file descriptor that has not been closed.  */
static int synch_process_fd;

/* Block SIGCHLD.  */
Jim Blandy's avatar
Jim Blandy committed
86

87 88 89 90 91 92 93 94 95 96
static void
block_child_signal (void)
{
#ifdef SIGCHLD
  sigset_t blocked;
  sigemptyset (&blocked);
  sigaddset (&blocked, SIGCHLD);
  pthread_sigmask (SIG_BLOCK, &blocked, 0);
#endif
}
Kenichi Handa's avatar
Kenichi Handa committed
97

98
/* Unblock SIGCHLD.  */
99

100 101 102 103 104 105 106
static void
unblock_child_signal (void)
{
#ifdef SIGCHLD
  pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
#endif
}
107

108
/* Clean up when exiting call_process_cleanup.  */
109

110
static Lisp_Object
111
call_process_kill (Lisp_Object ignored)
112
{
113 114 115 116 117 118 119 120 121 122 123 124 125 126
  if (0 <= synch_process_fd)
    emacs_close (synch_process_fd);

  /* If PID is reapable, kill it and record it as a deleted process.
     Do this in a critical section.  Unless PID is wedged it will be
     reaped on receipt of the first SIGCHLD after the critical section.  */
  if (synch_process_pid)
    {
      block_child_signal ();
      record_deleted_pid (synch_process_pid);
      EMACS_KILLPG (synch_process_pid, SIGKILL);
      unblock_child_signal ();
    }

127 128 129
  return Qnil;
}

130 131 132 133
/* Clean up when exiting Fcall_process.
   On MSDOS, delete the temporary file on any kind of termination.
   On Unix, kill the process and any children on termination by signal.  */

134
static Lisp_Object
135
call_process_cleanup (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
136
{
137 138 139
#ifdef MSDOS
  Lisp_Object buffer = Fcar (arg);
  Lisp_Object file = Fcdr (arg);
140
#else
141
  Lisp_Object buffer = arg;
142 143
#endif

144
  Fset_buffer (buffer);
145

146 147 148
#ifndef MSDOS
  /* If the process still exists, kill its process group.  */
  if (synch_process_pid)
149
    {
150
      ptrdiff_t count = SPECPDL_INDEX ();
151 152
      EMACS_KILLPG (synch_process_pid, SIGINT);
      record_unwind_protect (call_process_kill, make_number (0));
153 154 155
      message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
      immediate_quit = 1;
      QUIT;
156 157
      wait_for_termination (synch_process_pid, 0, 1);
      synch_process_pid = 0;
158 159 160 161
      immediate_quit = 0;
      specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
      message1 ("Waiting for process to die...done");
    }
162 163 164 165 166 167 168 169 170 171 172 173
#endif

  if (0 <= synch_process_fd)
    emacs_close (synch_process_fd);

#ifdef MSDOS
  /* FILE is "" when we didn't actually create a temporary file in
     call-process.  */
  if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0'))
    unlink (SDATA (file));
#endif

Jim Blandy's avatar
Jim Blandy committed
174 175 176
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
177
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
178 179 180
       doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
181 182
Insert output in BUFFER before point; t means current buffer; nil for BUFFER
 means discard it; 0 means discard and don't wait; and `(:file FILE)', where
183 184
 FILE is a file name string, means that it should be written to that file
 \(if the file already exists it is overwritten).
185 186 187 188 189 190 191 192 193
BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
REAL-BUFFER says what to do with standard output, as above,
while STDERR-FILE says what to do with standard error in the child.
STDERR-FILE may be nil (discard standard error output),
t (mix it with ordinary output), or a file name string.

Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments are strings passed as command arguments to PROGRAM.

194 195 196 197
If executable PROGRAM can't be found as an executable, `call-process'
signals a Lisp error.  `call-process' reports errors in execution of
the program only through its return and output.

198 199 200
If BUFFER is 0, `call-process' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
201 202 203
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)  */)
204
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
205
{
206
  Lisp_Object infile, buffer, current_dir, path;
207
  bool display_p;
208
  int fd0, fd1, filefd;
209
  int status;
210 211
  ptrdiff_t count = SPECPDL_INDEX ();
  USE_SAFE_ALLOCA;
212

213
  char **new_argv;
214 215 216
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
217
  Lisp_Object output_file = Qnil;
218
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
219
  char *outf, *tempfile = NULL;
220
  int outfilefd;
221 222 223
  int pid;
#else
  pid_t pid;
Jim Blandy's avatar
Jim Blandy committed
224
#endif
225
  int child_errno;
226
  int fd_output = -1;
Karl Heuer's avatar
Karl Heuer committed
227 228
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding;	/* coding-system of arguments */
229 230
  /* Set to the return value of Ffind_operation_coding_system.  */
  Lisp_Object coding_systems;
231
  bool output_to_buffer = 1;
232 233 234

  /* Qt denotes that Ffind_operation_coding_system is not yet called.  */
  coding_systems = Qt;
Karl Heuer's avatar
Karl Heuer committed
235

236
  CHECK_STRING (args[0]);
Jim Blandy's avatar
Jim Blandy committed
237

238 239
  error_file = Qt;

240 241
#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
242
  if (nargs >= 3
243
      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
244 245 246
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

247
  /* Decide the coding-system for giving arguments.  */
Karl Heuer's avatar
Karl Heuer committed
248 249
  {
    Lisp_Object val, *args2;
250
    ptrdiff_t i;
Karl Heuer's avatar
Karl Heuer committed
251 252 253 254

    /* If arguments are supplied, we may have to encode them.  */
    if (nargs >= 5)
      {
255
	bool must_encode = 0;
256
	Lisp_Object coding_attrs;
257

258
	for (i = 4; i < nargs; i++)
259
	  CHECK_STRING (args[i]);
260

261
	for (i = 4; i < nargs; i++)
262 263 264
	  if (STRING_MULTIBYTE (args[i]))
	    must_encode = 1;

265 266
	if (!NILP (Vcoding_system_for_write))
	  val = Vcoding_system_for_write;
267
	else if (! must_encode)
268
	  val = Qraw_text;
269
	else
Karl Heuer's avatar
Karl Heuer committed
270
	  {
271
	    SAFE_NALLOCA (args2, 1, nargs + 1);
Karl Heuer's avatar
Karl Heuer committed
272 273
	    args2[0] = Qcall_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
274
	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
275
	    val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
Karl Heuer's avatar
Karl Heuer committed
276
	  }
277
	val = complement_process_encoding_system (val);
Karl Heuer's avatar
Karl Heuer committed
278
	setup_coding_system (Fcheck_coding_system (val), &argument_coding);
279 280 281 282 283 284 285
	coding_attrs = CODING_ID_ATTRS (argument_coding.id);
	if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
	  {
	    /* We should not use an ASCII incompatible coding system.  */
	    val = raw_text_coding_system (val);
	    setup_coding_system (val, &argument_coding);
	  }
Karl Heuer's avatar
Karl Heuer committed
286 287 288
      }
  }

289 290
  if (nargs >= 2 && ! NILP (args[1]))
    {
Tom Tromey's avatar
Tom Tromey committed
291
      infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
292
      CHECK_STRING (infile);
293
    }
Jim Blandy's avatar
Jim Blandy committed
294
  else
295
    infile = build_string (NULL_DEVICE);
Jim Blandy's avatar
Jim Blandy committed
296

297 298
  if (nargs >= 3)
    {
299 300
      buffer = args[2];

301 302 303
      /* If BUFFER is a list, its meaning is (BUFFER-FOR-STDOUT
	 FILE-FOR-STDERR), unless the first element is :file, in which case see
	 the next paragraph. */
304 305 306
      if (CONSP (buffer)
	  && (! SYMBOLP (XCAR (buffer))
	      || strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file")))
307
	{
308
	  if (CONSP (XCDR (buffer)))
309
	    {
310
	      Lisp_Object stderr_file;
311
	      stderr_file = XCAR (XCDR (buffer));
312 313 314 315 316 317 318

	      if (NILP (stderr_file) || EQ (Qt, stderr_file))
		error_file = stderr_file;
	      else
		error_file = Fexpand_file_name (stderr_file, Qnil);
	    }

319
	  buffer = XCAR (buffer);
320
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
321

322
      /* If the buffer is (still) a list, it might be a (:file "file") spec. */
323 324 325
      if (CONSP (buffer)
	  && SYMBOLP (XCAR (buffer))
	  && ! strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file"))
326 327 328 329 330 331 332
	{
	  output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
					   BVAR (current_buffer, directory));
	  CHECK_STRING (output_file);
	  buffer = Qnil;
	}

333 334
      if (!(EQ (buffer, Qnil)
	    || EQ (buffer, Qt)
335
	    || INTEGERP (buffer)))
336
	{
337 338
	  Lisp_Object spec_buffer;
	  spec_buffer = buffer;
339
	  buffer = Fget_buffer_create (buffer);
340 341
	  /* Mention the buffer name for a better error message.  */
	  if (NILP (buffer))
342 343
	    CHECK_BUFFER (spec_buffer);
	  CHECK_BUFFER (buffer);
344 345
	}
    }
346
  else
347
    buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
348

349 350 351 352 353 354 355 356 357 358 359
  /* Make sure that the child will be able to chdir to the current
     buffer's current directory, or its unhandled equivalent.  We
     can't just have the child check for an error when it does the
     chdir, since it's in a vfork.

     We have to GCPRO around this because Fexpand_file_name,
     Funhandled_file_name_directory, and Ffile_accessible_directory_p
     might call a file name handling function.  The argument list is
     protected by the caller, so all we really have to worry about is
     buffer.  */
  {
360
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
361

Tom Tromey's avatar
Tom Tromey committed
362
    current_dir = BVAR (current_buffer, directory);
363

364
    GCPRO5 (infile, buffer, current_dir, error_file, output_file);
365

Stefan Monnier's avatar
Stefan Monnier committed
366 367 368 369 370 371
    current_dir = Funhandled_file_name_directory (current_dir);
    if (NILP (current_dir))
      /* If the file name handler says that current_dir is unreachable, use
	 a sensible default. */
      current_dir = build_string ("~/");
    current_dir = expand_and_dir_to_file (current_dir, Qnil);
372 373
    current_dir = Ffile_name_as_directory (current_dir);

374 375
    if (NILP (Ffile_accessible_directory_p (current_dir)))
      report_file_error ("Setting current directory",
Tom Tromey's avatar
Tom Tromey committed
376
			 Fcons (BVAR (current_buffer, directory), Qnil));
377

378 379 380 381 382 383
    if (STRING_MULTIBYTE (infile))
      infile = ENCODE_FILE (infile);
    if (STRING_MULTIBYTE (current_dir))
      current_dir = ENCODE_FILE (current_dir);
    if (STRINGP (error_file) && STRING_MULTIBYTE (error_file))
      error_file = ENCODE_FILE (error_file);
384 385
    if (STRINGP (output_file) && STRING_MULTIBYTE (output_file))
      output_file = ENCODE_FILE (output_file);
386 387 388
    UNGCPRO;
  }

389
  display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
Jim Blandy's avatar
Jim Blandy committed
390

391
  filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
392 393
  if (filefd < 0)
    {
394
      infile = DECODE_FILE (infile);
395
      report_file_error ("Opening process input file", Fcons (infile, Qnil));
Jim Blandy's avatar
Jim Blandy committed
396
    }
397 398 399 400 401 402 403 404 405 406 407 408 409 410 411

  if (STRINGP (output_file))
    {
#ifdef DOS_NT
      fd_output = emacs_open (SSDATA (output_file),
			      O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
			      S_IREAD | S_IWRITE);
#else  /* not DOS_NT */
      fd_output = creat (SSDATA (output_file), 0666);
#endif /* not DOS_NT */
      if (fd_output < 0)
	{
	  output_file = DECODE_FILE (output_file);
	  report_file_error ("Opening process output file",
			     Fcons (output_file, Qnil));
412
	}
413
      if (STRINGP (error_file) || NILP (error_file))
414
	output_to_buffer = 0;
415 416
    }

Jim Blandy's avatar
Jim Blandy committed
417
  /* Search for program; barf if not found.  */
418
  {
419
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
420

421
    GCPRO4 (infile, buffer, current_dir, error_file);
422
    openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
423 424
    UNGCPRO;
  }
425
  if (NILP (path))
Jim Blandy's avatar
Jim Blandy committed
426
    {
427
      emacs_close (filefd);
Jim Blandy's avatar
Jim Blandy committed
428 429
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }
430 431 432 433 434 435 436

  /* If program file name starts with /: for quoting a magic name,
     discard that.  */
  if (SBYTES (path) > 2 && SREF (path, 0) == '/'
      && SREF (path, 1) == ':')
    path = Fsubstring (path, make_number (2), Qnil);

437
  new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
438 439
  if (nargs > 4)
    {
440
      ptrdiff_t i;
441
      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
442

443
      GCPRO5 (infile, buffer, current_dir, path, error_file);
444 445
      argument_coding.dst_multibyte = 0;
      for (i = 4; i < nargs; i++)
446
	{
447 448
	  argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
	  if (CODING_REQUIRE_ENCODING (&argument_coding))
449 450
	    /* We must encode this argument.  */
	    args[i] = encode_coding_string (&argument_coding, args[i], 1);
451
	}
452
      UNGCPRO;
453
      for (i = 4; i < nargs; i++)
454
	new_argv[i - 3] = SSDATA (args[i]);
455
      new_argv[i - 3] = 0;
456
    }
457 458
  else
    new_argv[1] = 0;
459
  new_argv[0] = SSDATA (path);
Jim Blandy's avatar
Jim Blandy committed
460

461 462
#ifdef MSDOS /* MW, July 1993 */

463 464
  /* If we're redirecting STDOUT to a file, that file is already open
     on fd_output.  */
465
  if (fd_output < 0)
466
    {
467 468 469 470 471 472 473 474 475 476 477 478
      if ((outf = egetenv ("TMPDIR")))
	strcpy (tempfile = alloca (strlen (outf) + 20), outf);
      else
	{
	  tempfile = alloca (20);
	  *tempfile = '\0';
	}
      dostounix_filename (tempfile);
      if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
	strcat (tempfile, "/");
      strcat (tempfile, "detmp.XXX");
      mktemp (tempfile);
479 480 481 482 483 484
      outfilefd = creat (tempfile, S_IREAD | S_IWRITE);
      if (outfilefd < 0) {
	emacs_close (filefd);
	report_file_error ("Opening process output file",
			   Fcons (build_string (tempfile), Qnil));
      }
485
    }
486 487
  else
    outfilefd = fd_output;
488 489
  fd0 = filefd;
  fd1 = outfilefd;
Miles Bader's avatar
Miles Bader committed
490
#endif /* MSDOS */
491

492
  if (INTEGERP (buffer))
493 494 495 496
    {
      fd0 = -1;
      fd1 = emacs_open (NULL_DEVICE, O_WRONLY, 0);
    }
Jim Blandy's avatar
Jim Blandy committed
497 498
  else
    {
499
#ifndef MSDOS
500
      int fd[2];
501 502
      if (pipe (fd) == -1)
	{
503
	  int pipe_errno = errno;
504
	  emacs_close (filefd);
505
	  errno = pipe_errno;
506 507
	  report_file_error ("Creating process pipe", Qnil);
	}
508 509
      fd0 = fd[0];
      fd1 = fd[1];
Jim Blandy's avatar
Jim Blandy committed
510 511 512 513
#endif
    }

  {
514
    int fd_error = fd1;
Jim Blandy's avatar
Jim Blandy committed
515

516 517
    if (fd_output >= 0)
      fd1 = fd_output;
Jim Blandy's avatar
Jim Blandy committed
518

519
    if (NILP (error_file))
520
      fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
521 522 523
    else if (STRINGP (error_file))
      {
#ifdef DOS_NT
524
	fd_error = emacs_open (SSDATA (error_file),
525 526
			       O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
			       S_IREAD | S_IWRITE);
527
#else  /* not DOS_NT */
528
	fd_error = creat (SSDATA (error_file), 0666);
529 530 531 532 533
#endif /* not DOS_NT */
      }

    if (fd_error < 0)
      {
534
	emacs_close (filefd);
535 536
	if (fd0 != filefd)
	  emacs_close (fd0);
537
	if (fd1 >= 0)
538
	  emacs_close (fd1);
Miles Bader's avatar
Miles Bader committed
539 540 541
#ifdef MSDOS
	unlink (tempfile);
#endif
542 543 544 545 546
	if (NILP (error_file))
	  error_file = build_string (NULL_DEVICE);
	else if (STRINGP (error_file))
	  error_file = DECODE_FILE (error_file);
	report_file_error ("Cannot redirect stderr", Fcons (error_file, Qnil));
547
      }
548

549
#ifdef MSDOS /* MW, July 1993 */
550
    /* Note that on MSDOS `child_setup' actually returns the child process
551
       exit status, not its PID, so assign it to status below.  */
552
    pid = child_setup (filefd, outfilefd, fd_error, new_argv, 0, current_dir);
553
    child_errno = errno;
554

555
    emacs_close (outfilefd);
556
    if (fd_error != outfilefd)
557
      emacs_close (fd_error);
558 559 560 561 562 563 564 565
    if (pid < 0)
      {
	synchronize_system_messages_locale ();
	return
	  code_convert_string_norecord (build_string (strerror (child_errno)),
					Vlocale_coding_system, 0);
      }
    status = pid;
566
    fd1 = -1; /* No harm in closing that one!  */
567
    if (tempfile)
568
      {
569 570
	/* Since CRLF is converted to LF within `decode_coding', we
	   can always open a file with binary mode.  */
571 572
	fd0 = emacs_open (tempfile, O_RDONLY | O_BINARY, 0);
	if (fd0 < 0)
573 574 575 576
	  {
	    unlink (tempfile);
	    emacs_close (filefd);
	    report_file_error ("Cannot re-open temporary file",
577
			       Fcons (build_string (tempfile), Qnil));
578
	  }
579
      }
580
    else
581
      fd0 = -1; /* We are not going to read from tempfile.   */
582
#else /* not MSDOS */
583 584 585 586 587 588 589 590 591 592 593

    /* Do the unwind-protect now, even though the pid is not known, so
       that no storage allocation is done in the critical section.
       The actual PID will be filled in during the critical section.  */
    synch_process_pid = 0;
    synch_process_fd = fd0;
    record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());

    block_input ();
    block_child_signal ();

594
#ifdef WINDOWSNT
595
    pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
596
#else  /* not WINDOWSNT */
597

598
    /* vfork, and prevent local vars from being clobbered by the vfork.  */
599
    {
600 601 602
      Lisp_Object volatile buffer_volatile = buffer;
      Lisp_Object volatile coding_systems_volatile = coding_systems;
      Lisp_Object volatile current_dir_volatile = current_dir;
603 604 605
      bool volatile display_p_volatile = display_p;
      bool volatile output_to_buffer_volatile = output_to_buffer;
      bool volatile sa_must_free_volatile = sa_must_free;
606
      int volatile fd0_volatile = fd0;
607
      int volatile fd1_volatile = fd1;
608 609
      int volatile fd_error_volatile = fd_error;
      int volatile fd_output_volatile = fd_output;
610 611
      int volatile filefd_volatile = filefd;
      ptrdiff_t volatile count_volatile = count;
612
      ptrdiff_t volatile sa_count_volatile = sa_count;
613
      char **volatile new_argv_volatile = new_argv;
Jim Blandy's avatar
Jim Blandy committed
614

615
      pid = vfork ();
616
      child_errno = errno;
Jim Blandy's avatar
Jim Blandy committed
617

618 619 620
      buffer = buffer_volatile;
      coding_systems = coding_systems_volatile;
      current_dir = current_dir_volatile;
621
      display_p = display_p_volatile;
622 623 624
      output_to_buffer = output_to_buffer_volatile;
      sa_must_free = sa_must_free_volatile;
      fd0 = fd0_volatile;
625
      fd1 = fd1_volatile;
626 627
      fd_error = fd_error_volatile;
      fd_output = fd_output_volatile;
628 629
      filefd = filefd_volatile;
      count = count_volatile;
630
      sa_count = sa_count_volatile;
631 632
      new_argv = new_argv_volatile;
    }
633

Jim Blandy's avatar
Jim Blandy committed
634 635
    if (pid == 0)
      {
636 637
	unblock_child_signal ();

638 639
	if (fd0 >= 0)
	  emacs_close (fd0);
640

641
	setsid ();
642

643
	/* Emacs ignores SIGPIPE, but the child should not.  */
644
	signal (SIGPIPE, SIG_DFL);
645

646
	child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
Jim Blandy's avatar
Jim Blandy committed
647
      }
Kim F. Storm's avatar
Kim F. Storm committed
648

649
#endif /* not WINDOWSNT */
650

651 652 653 654 655 656 657 658 659 660 661 662 663
    child_errno = errno;

    if (0 < pid)
      {
	if (INTEGERP (buffer))
	  record_deleted_pid (pid);
	else
	  synch_process_pid = pid;
      }

    unblock_child_signal ();
    unblock_input ();

664 665
    /* The MSDOS case did this already.  */
    if (fd_error >= 0)
666
      emacs_close (fd_error);
667
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
668

669
    /* Close most of our file descriptors, but not fd0
670
       since we will use that to read input from.  */
671
    emacs_close (filefd);
672 673
    if (fd_output >= 0)
      emacs_close (fd_output);
674
    if (fd1 >= 0 && fd1 != fd_error)
675
      emacs_close (fd1);
Jim Blandy's avatar
Jim Blandy committed
676 677 678 679
  }

  if (pid < 0)
    {
680
      errno = child_errno;
Jim Blandy's avatar
Jim Blandy committed
681 682 683
      report_file_error ("Doing vfork", Qnil);
    }

684
  if (INTEGERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
685
    {
686 687
      if (fd0 >= 0)
	emacs_close (fd0);
688
      return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
689 690
    }

Juanma Barranquero's avatar
Juanma Barranquero committed
691
#if defined (MSDOS)
692
  /* MSDOS needs different cleanup information.  */
Jim Blandy's avatar
Jim Blandy committed
693
  record_unwind_protect (call_process_cleanup,
694
			 Fcons (Fcurrent_buffer (),
695 696
				build_string (tempfile ? tempfile : "")));
#endif
Jim Blandy's avatar
Jim Blandy committed
697

698
  if (BUFFERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
699 700
    Fset_buffer (buffer);

701 702 703 704 705
  if (NILP (buffer))
    {
      /* If BUFFER is nil, we must read process output once and then
	 discard it, so setup coding system but with nil.  */
      setup_coding_system (Qnil, &process_coding);
706
      process_coding.dst_multibyte = 0;
707 708 709 710 711 712 713 714 715 716 717 718
    }
  else
    {
      Lisp_Object val, *args2;

      val = Qnil;
      if (!NILP (Vcoding_system_for_read))
	val = Vcoding_system_for_read;
      else
	{
	  if (EQ (coding_systems, Qt))
	    {
719
	      ptrdiff_t i;
720

721
	      SAFE_NALLOCA (args2, 1, nargs + 1);
722 723 724 725 726 727
	      args2[0] = Qcall_process;
	      for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
	      coding_systems
		= Ffind_operation_coding_system (nargs + 1, args2);
	    }
	  if (CONSP (coding_systems))
728
	    val = XCAR (coding_systems);
729
	  else if (CONSP (Vdefault_process_coding_system))
730
	    val = XCAR (Vdefault_process_coding_system);
731 732 733
	  else
	    val = Qnil;
	}
734
      Fcheck_coding_system (val);
735 736 737
      /* In unibyte mode, character code conversion should not take
	 place but EOL conversion should.  So, setup raw-text or one
	 of the subsidiary according to the information just setup.  */
Tom Tromey's avatar
Tom Tromey committed
738
      if (NILP (BVAR (current_buffer, enable_multibyte_characters))
739
	  && !NILP (val))
740 741
	val = raw_text_coding_system (val);
      setup_coding_system (val, &process_coding);
742 743
      process_coding.dst_multibyte
	= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
744
    }
745
  process_coding.src_multibyte = 0;
746

Jim Blandy's avatar
Jim Blandy committed
747 748 749
  immediate_quit = 1;
  QUIT;

750
  if (output_to_buffer)
751
    {
752 753 754 755
      enum { CALLPROC_BUFFER_SIZE_MIN = 16 * 1024 };
      enum { CALLPROC_BUFFER_SIZE_MAX = 4 * CALLPROC_BUFFER_SIZE_MIN };
      char buf[CALLPROC_BUFFER_SIZE_MAX];
      int bufsize = CALLPROC_BUFFER_SIZE_MIN;
756 757
      int nread;
      bool first = 1;
758 759
      EMACS_INT total_read = 0;
      int carryover = 0;
760
      bool display_on_the_fly = display_p;
761 762 763 764 765 766 767 768 769 770 771
      struct coding_system saved_coding;

      saved_coding = process_coding;
      while (1)
	{
	  /* Repeatedly read until we've filled as much as possible
	     of the buffer size we have.  But don't read
	     less than 1024--save that for the next bufferful.  */
	  nread = carryover;
	  while (nread < bufsize - 1024)
	    {
772
	      int this_read = emacs_read (fd0, buf + nread,
773
					  bufsize - nread);
774

775 776
	      if (this_read < 0)
		goto give_up;
777

778 779 780 781 782
	      if (this_read == 0)
		{
		  process_coding.mode |= CODING_MODE_LAST_BLOCK;
		  break;
		}
783

784 785
	      nread += this_read;
	      total_read += this_read;
786

787 788 789
	      if (display_on_the_fly)
		break;
	    }
790

791 792
	  /* Now NREAD is the total amount of data in the buffer.  */
	  immediate_quit = 0;
793

794 795 796 797 798 799 800 801
	  if (!NILP (buffer))
	    {
	      if (NILP (BVAR (current_buffer, enable_multibyte_characters))
		  && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
		insert_1_both (buf, nread, nread, 0, 1, 0);
	      else
		{			/* We have to decode the input.  */
		  Lisp_Object curbuf;
802
		  ptrdiff_t count1 = SPECPDL_INDEX ();
803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846

		  XSETBUFFER (curbuf, current_buffer);
		  /* We cannot allow after-change-functions be run
		     during decoding, because that might modify the
		     buffer, while we rely on process_coding.produced to
		     faithfully reflect inserted text until we
		     TEMP_SET_PT_BOTH below.  */
		  specbind (Qinhibit_modification_hooks, Qt);
		  decode_coding_c_string (&process_coding,
					  (unsigned char *) buf, nread, curbuf);
		  unbind_to (count1, Qnil);
		  if (display_on_the_fly
		      && CODING_REQUIRE_DETECTION (&saved_coding)
		      && ! CODING_REQUIRE_DETECTION (&process_coding))
		    {
		      /* We have detected some coding system.  But,
			 there's a possibility that the detection was
			 done by insufficient data.  So, we give up
			 displaying on the fly.  */
		      if (process_coding.produced > 0)
			del_range_2 (process_coding.dst_pos,
				     process_coding.dst_pos_byte,
				     process_coding.dst_pos
				     + process_coding.produced_char,
				     process_coding.dst_pos_byte
				     + process_coding.produced, 0);
		      display_on_the_fly = 0;
		      process_coding = saved_coding;
		      carryover = nread;
		      /* This is to make the above condition always
			 fails in the future.  */
		      saved_coding.common_flags
			&= ~CODING_REQUIRE_DETECTION_MASK;
		      continue;
		    }

		  TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
				    PT_BYTE + process_coding.produced);
		  carryover = process_coding.carryover_bytes;
		  if (carryover > 0)
		    memcpy (buf, process_coding.carryover,
			    process_coding.carryover_bytes);
		}
	    }
847

848 849
	  if (process_coding.mode & CODING_MODE_LAST_BLOCK)
	    break;
Richard M. Stallman's avatar