callproc.c 49.5 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
static void
block_child_signal (void)
{
  sigset_t blocked;
  sigemptyset (&blocked);
  sigaddset (&blocked, SIGCHLD);
  pthread_sigmask (SIG_BLOCK, &blocked, 0);
}
Kenichi Handa's avatar
Kenichi Handa committed
95

96
/* Unblock SIGCHLD.  */
97

98 99 100 101 102
static void
unblock_child_signal (void)
{
  pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
}
103

104 105 106 107 108 109 110 111 112 113 114 115 116
/* If P is reapable, record it as a deleted process and kill it.
   Do this in a critical section.  Unless PID is wedged it will be
   reaped on receipt of the first SIGCHLD after the critical section.  */

void
record_kill_process (struct Lisp_Process *p)
{
  block_child_signal ();

  if (p->alive)
    {
      p->alive = 0;
      record_deleted_pid (p->pid);
117
      kill (- p->pid, SIGKILL);
118 119 120 121 122
    }

  unblock_child_signal ();
}

123
/* Clean up when exiting call_process_cleanup.  */
124

125
static Lisp_Object
126
call_process_kill (Lisp_Object ignored)
127
{
128 129 130 131 132
  if (0 <= synch_process_fd)
    emacs_close (synch_process_fd);

  if (synch_process_pid)
    {
133 134 135 136
      struct Lisp_Process proc;
      proc.alive = 1;
      proc.pid = synch_process_pid;
      record_kill_process (&proc);
137 138
    }

139 140 141
  return Qnil;
}

142 143 144 145
/* 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.  */

146
static Lisp_Object
147
call_process_cleanup (Lisp_Object arg)
Jim Blandy's avatar
Jim Blandy committed
148
{
149 150 151
#ifdef MSDOS
  Lisp_Object buffer = Fcar (arg);
  Lisp_Object file = Fcdr (arg);
152
#else
153
  Lisp_Object buffer = arg;
154 155
#endif

156
  Fset_buffer (buffer);
157

158 159 160
#ifndef MSDOS
  /* If the process still exists, kill its process group.  */
  if (synch_process_pid)
161
    {
162
      ptrdiff_t count = SPECPDL_INDEX ();
163
      kill (-synch_process_pid, SIGINT);
164
      record_unwind_protect (call_process_kill, make_number (0));
165 166 167
      message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
      immediate_quit = 1;
      QUIT;
168 169
      wait_for_termination (synch_process_pid, 0, 1);
      synch_process_pid = 0;
170 171 172 173
      immediate_quit = 0;
      specpdl_ptr = specpdl + count; /* Discard the unwind protect.  */
      message1 ("Waiting for process to die...done");
    }
174 175 176 177 178 179 180 181 182 183 184 185
#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
186 187 188
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
189
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
190 191 192
       doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
193 194
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
195 196
 FILE is a file name string, means that it should be written to that file
 \(if the file already exists it is overwritten).
197 198 199 200 201 202 203 204 205
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.

206 207 208 209
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.

210 211 212
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.
213 214 215
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)  */)
216
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
217
{
218
  Lisp_Object infile, buffer, current_dir, path;
219
  bool display_p;
220
  int fd0, fd1, filefd;
221
  int status;
222 223
  ptrdiff_t count = SPECPDL_INDEX ();
  USE_SAFE_ALLOCA;
224

225
  char **new_argv;
226 227 228
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
229
  Lisp_Object output_file = Qnil;
230
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
231
  char *outf, *tempfile = NULL;
232
  int outfilefd;
233 234 235
  int pid;
#else
  pid_t pid;
Jim Blandy's avatar
Jim Blandy committed
236
#endif
237
  int child_errno;
238
  int fd_output = -1;
Karl Heuer's avatar
Karl Heuer committed
239 240
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding;	/* coding-system of arguments */
241 242
  /* Set to the return value of Ffind_operation_coding_system.  */
  Lisp_Object coding_systems;
243
  bool output_to_buffer = 1;
244 245 246

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

248
  CHECK_STRING (args[0]);
Jim Blandy's avatar
Jim Blandy committed
249

250 251
  error_file = Qt;

252 253
#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
254
  if (nargs >= 3
255
      && (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
256 257 258
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

259
  /* Decide the coding-system for giving arguments.  */
Karl Heuer's avatar
Karl Heuer committed
260 261
  {
    Lisp_Object val, *args2;
262
    ptrdiff_t i;
Karl Heuer's avatar
Karl Heuer committed
263 264 265 266

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

270
	for (i = 4; i < nargs; i++)
271
	  CHECK_STRING (args[i]);
272

273
	for (i = 4; i < nargs; i++)
274 275 276
	  if (STRING_MULTIBYTE (args[i]))
	    must_encode = 1;

277 278
	if (!NILP (Vcoding_system_for_write))
	  val = Vcoding_system_for_write;
279
	else if (! must_encode)
280
	  val = Qraw_text;
281
	else
Karl Heuer's avatar
Karl Heuer committed
282
	  {
283
	    SAFE_NALLOCA (args2, 1, nargs + 1);
Karl Heuer's avatar
Karl Heuer committed
284 285
	    args2[0] = Qcall_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
286
	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
287
	    val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
Karl Heuer's avatar
Karl Heuer committed
288
	  }
289
	val = complement_process_encoding_system (val);
Karl Heuer's avatar
Karl Heuer committed
290
	setup_coding_system (Fcheck_coding_system (val), &argument_coding);
291 292 293 294 295 296 297
	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
298 299 300
      }
  }

301 302
  if (nargs >= 2 && ! NILP (args[1]))
    {
Tom Tromey's avatar
Tom Tromey committed
303
      infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
304
      CHECK_STRING (infile);
305
    }
Jim Blandy's avatar
Jim Blandy committed
306
  else
307
    infile = build_string (NULL_DEVICE);
Jim Blandy's avatar
Jim Blandy committed
308

309 310
  if (nargs >= 3)
    {
311 312
      buffer = args[2];

313 314 315
      /* 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. */
316 317 318
      if (CONSP (buffer)
	  && (! SYMBOLP (XCAR (buffer))
	      || strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file")))
319
	{
320
	  if (CONSP (XCDR (buffer)))
321
	    {
322
	      Lisp_Object stderr_file;
323
	      stderr_file = XCAR (XCDR (buffer));
324 325 326 327 328 329 330

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

331
	  buffer = XCAR (buffer);
332
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
333

334
      /* If the buffer is (still) a list, it might be a (:file "file") spec. */
335 336 337
      if (CONSP (buffer)
	  && SYMBOLP (XCAR (buffer))
	  && ! strcmp (SSDATA (SYMBOL_NAME (XCAR (buffer))), ":file"))
338 339 340 341 342 343 344
	{
	  output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
					   BVAR (current_buffer, directory));
	  CHECK_STRING (output_file);
	  buffer = Qnil;
	}

345 346
      if (!(EQ (buffer, Qnil)
	    || EQ (buffer, Qt)
347
	    || INTEGERP (buffer)))
348
	{
349 350
	  Lisp_Object spec_buffer;
	  spec_buffer = buffer;
351
	  buffer = Fget_buffer_create (buffer);
352 353
	  /* Mention the buffer name for a better error message.  */
	  if (NILP (buffer))
354 355
	    CHECK_BUFFER (spec_buffer);
	  CHECK_BUFFER (buffer);
356 357
	}
    }
358
  else
359
    buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
360

361 362 363 364 365 366 367 368 369 370 371
  /* 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.  */
  {
372
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
373

Tom Tromey's avatar
Tom Tromey committed
374
    current_dir = BVAR (current_buffer, directory);
375

376
    GCPRO5 (infile, buffer, current_dir, error_file, output_file);
377

Stefan Monnier's avatar
Stefan Monnier committed
378 379 380 381 382 383
    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);
384 385
    current_dir = Ffile_name_as_directory (current_dir);

386 387
    if (NILP (Ffile_accessible_directory_p (current_dir)))
      report_file_error ("Setting current directory",
Tom Tromey's avatar
Tom Tromey committed
388
			 Fcons (BVAR (current_buffer, directory), Qnil));
389

390 391 392 393 394 395
    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);
396 397
    if (STRINGP (output_file) && STRING_MULTIBYTE (output_file))
      output_file = ENCODE_FILE (output_file);
398 399 400
    UNGCPRO;
  }

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

403
  filefd = emacs_open (SSDATA (infile), O_RDONLY, 0);
Jim Blandy's avatar
Jim Blandy committed
404 405
  if (filefd < 0)
    {
406
      infile = DECODE_FILE (infile);
407
      report_file_error ("Opening process input file", Fcons (infile, Qnil));
Jim Blandy's avatar
Jim Blandy committed
408
    }
409 410 411 412 413 414 415 416 417 418 419 420 421 422 423

  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));
424
	}
425
      if (STRINGP (error_file) || NILP (error_file))
426
	output_to_buffer = 0;
427 428
    }

Jim Blandy's avatar
Jim Blandy committed
429
  /* Search for program; barf if not found.  */
430
  {
431
    struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
432

433
    GCPRO4 (infile, buffer, current_dir, error_file);
434
    openp (Vexec_path, args[0], Vexec_suffixes, &path, make_number (X_OK));
435 436
    UNGCPRO;
  }
437
  if (NILP (path))
Jim Blandy's avatar
Jim Blandy committed
438
    {
439
      emacs_close (filefd);
Jim Blandy's avatar
Jim Blandy committed
440 441
      report_file_error ("Searching for program", Fcons (args[0], Qnil));
    }
442 443 444 445 446 447 448

  /* 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);

449
  new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv);
450 451
  if (nargs > 4)
    {
452
      ptrdiff_t i;
453
      struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
454

455
      GCPRO5 (infile, buffer, current_dir, path, error_file);
456 457
      argument_coding.dst_multibyte = 0;
      for (i = 4; i < nargs; i++)
458
	{
459 460
	  argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
	  if (CODING_REQUIRE_ENCODING (&argument_coding))
461 462
	    /* We must encode this argument.  */
	    args[i] = encode_coding_string (&argument_coding, args[i], 1);
463
	}
464
      UNGCPRO;
465
      for (i = 4; i < nargs; i++)
466
	new_argv[i - 3] = SSDATA (args[i]);
467
      new_argv[i - 3] = 0;
468
    }
469 470
  else
    new_argv[1] = 0;
471
  new_argv[0] = SSDATA (path);
Jim Blandy's avatar
Jim Blandy committed
472

473 474
#ifdef MSDOS /* MW, July 1993 */

475 476
  /* If we're redirecting STDOUT to a file, that file is already open
     on fd_output.  */
477
  if (fd_output < 0)
478
    {
479 480 481 482 483 484 485 486 487 488 489 490
      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);
491 492 493 494 495 496
      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));
      }
497
    }
498 499
  else
    outfilefd = fd_output;
500 501
  fd0 = filefd;
  fd1 = outfilefd;
Miles Bader's avatar
Miles Bader committed
502
#endif /* MSDOS */
503

504
  if (INTEGERP (buffer))
505 506 507 508
    {
      fd0 = -1;
      fd1 = emacs_open (NULL_DEVICE, O_WRONLY, 0);
    }
Jim Blandy's avatar
Jim Blandy committed
509 510
  else
    {
511
#ifndef MSDOS
512
      int fd[2];
513 514
      if (pipe (fd) == -1)
	{
515
	  int pipe_errno = errno;
516
	  emacs_close (filefd);
517
	  errno = pipe_errno;
518 519
	  report_file_error ("Creating process pipe", Qnil);
	}
520 521
      fd0 = fd[0];
      fd1 = fd[1];
Jim Blandy's avatar
Jim Blandy committed
522 523 524 525
#endif
    }

  {
526
    int fd_error = fd1;
Jim Blandy's avatar
Jim Blandy committed
527

528 529
    if (fd_output >= 0)
      fd1 = fd_output;
Jim Blandy's avatar
Jim Blandy committed
530

531
    if (NILP (error_file))
532
      fd_error = emacs_open (NULL_DEVICE, O_WRONLY, 0);
533 534 535
    else if (STRINGP (error_file))
      {
#ifdef DOS_NT
536
	fd_error = emacs_open (SSDATA (error_file),
537 538
			       O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
			       S_IREAD | S_IWRITE);
539
#else  /* not DOS_NT */
540
	fd_error = creat (SSDATA (error_file), 0666);
541 542 543 544 545
#endif /* not DOS_NT */
      }

    if (fd_error < 0)
      {
546
	emacs_close (filefd);
547 548
	if (fd0 != filefd)
	  emacs_close (fd0);
549
	if (fd1 >= 0)
550
	  emacs_close (fd1);
Miles Bader's avatar
Miles Bader committed
551 552 553
#ifdef MSDOS
	unlink (tempfile);
#endif
554 555 556 557 558
	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));
559
      }
560

561
#ifdef MSDOS /* MW, July 1993 */
562
    /* Note that on MSDOS `child_setup' actually returns the child process
563
       exit status, not its PID, so assign it to status below.  */
564
    pid = child_setup (filefd, outfilefd, fd_error, new_argv, 0, current_dir);
565
    child_errno = errno;
566

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

    /* 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;
Paul Eggert's avatar
Paul Eggert committed
601 602 603 604 605 606 607

#ifdef MSDOS
    /* MSDOS needs different cleanup information.  */
    record_unwind_protect (call_process_cleanup,
			   Fcons (Fcurrent_buffer (),
				  build_string (tempfile ? tempfile : "")));
#else
608 609 610 611 612
    record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());

    block_input ();
    block_child_signal ();

613
#ifdef WINDOWSNT
614
    pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
615
#else  /* not WINDOWSNT */
616

617
    /* vfork, and prevent local vars from being clobbered by the vfork.  */
618
    {
619 620 621
      Lisp_Object volatile buffer_volatile = buffer;
      Lisp_Object volatile coding_systems_volatile = coding_systems;
      Lisp_Object volatile current_dir_volatile = current_dir;
622 623 624
      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;
625
      int volatile fd1_volatile = fd1;
626 627
      int volatile fd_error_volatile = fd_error;
      int volatile fd_output_volatile = fd_output;
628 629
      int volatile filefd_volatile = filefd;
      ptrdiff_t volatile count_volatile = count;
630
      ptrdiff_t volatile sa_count_volatile = sa_count;
631
      char **volatile new_argv_volatile = new_argv;
Jim Blandy's avatar
Jim Blandy committed
632

633
      pid = vfork ();
634
      child_errno = errno;
Jim Blandy's avatar
Jim Blandy committed
635

636 637 638
      buffer = buffer_volatile;
      coding_systems = coding_systems_volatile;
      current_dir = current_dir_volatile;
639
      display_p = display_p_volatile;
640 641
      output_to_buffer = output_to_buffer_volatile;
      sa_must_free = sa_must_free_volatile;
642
      fd1 = fd1_volatile;
643 644
      fd_error = fd_error_volatile;
      fd_output = fd_output_volatile;
645 646
      filefd = filefd_volatile;
      count = count_volatile;
647
      sa_count = sa_count_volatile;
648
      new_argv = new_argv_volatile;
Paul Eggert's avatar
Paul Eggert committed
649 650

      fd0 = synch_process_fd;
651
    }
652

Jim Blandy's avatar
Jim Blandy committed
653 654
    if (pid == 0)
      {
655 656
	unblock_child_signal ();

657 658
	if (fd0 >= 0)
	  emacs_close (fd0);
659

660
	setsid ();
661

662
	/* Emacs ignores SIGPIPE, but the child should not.  */
663
	signal (SIGPIPE, SIG_DFL);
664

665
	child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir);
Jim Blandy's avatar
Jim Blandy committed
666
      }
Kim F. Storm's avatar
Kim F. Storm committed
667

668
#endif /* not WINDOWSNT */
669

670 671 672 673 674 675 676 677 678 679 680 681 682
    child_errno = errno;

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

    unblock_child_signal ();
    unblock_input ();

683 684
    /* The MSDOS case did this already.  */
    if (fd_error >= 0)
685
      emacs_close (fd_error);
686
#endif /* not MSDOS */
Jim Blandy's avatar
Jim Blandy committed
687

688
    /* Close most of our file descriptors, but not fd0
689
       since we will use that to read input from.  */
690
    emacs_close (filefd);
691 692
    if (fd_output >= 0)
      emacs_close (fd_output);
693
    if (fd1 >= 0 && fd1 != fd_error)
694
      emacs_close (fd1);
Jim Blandy's avatar
Jim Blandy committed
695 696 697 698
  }

  if (pid < 0)
    {
699
      errno = child_errno;
Jim Blandy's avatar
Jim Blandy committed
700 701 702
      report_file_error ("Doing vfork", Qnil);
    }

703
  if (INTEGERP (buffer))
Paul Eggert's avatar
Paul Eggert committed
704
    return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
705

706
  if (BUFFERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
707 708
    Fset_buffer (buffer);

709 710 711 712 713
  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);
714
      process_coding.dst_multibyte = 0;
715 716 717 718 719 720 721 722 723 724 725 726
    }
  else
    {
      Lisp_Object val, *args2;

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

729
	      SAFE_NALLOCA (args2, 1, nargs + 1);
730 731 732 733 734 735
	      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))
736
	    val = XCAR (coding_systems);
737
	  else if (CONSP (Vdefault_process_coding_system))
738
	    val = XCAR (Vdefault_process_coding_system);
739 740 741
	  else
	    val = Qnil;
	}
742
      Fcheck_coding_system (val);
743 744 745
      /* 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
746
      if (NILP (BVAR (current_buffer, enable_multibyte_characters))
747
	  && !NILP (val))
748 749
	val = raw_text_coding_system (val);
      setup_coding_system (val, &process_coding);
750 751
      process_coding.dst_multibyte
	= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
752
    }
753
  process_coding.src_multibyte = 0;
754

Jim Blandy's avatar
Jim Blandy committed
755 756 757
  immediate_quit = 1;
  QUIT;

758
  if (output_to_buffer)
759
    {
760 761 762 763
      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;
764 765
      int nread;
      bool first = 1;
766 767
      EMACS_INT total_read = 0;
      int carryover = 0;
768
      bool display_on_the_fly = display_p;
769 770 771 772 773 774 775 776 777 778 779
      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)
	    {
780
	      int this_read = emacs_read (fd0, buf + nread,
781
					  bufsize - nread);
782

783 784
	      if (this_read < 0)
		goto give_up;
785

786 787 788 789 790
	      if (this_read == 0)
		{
		  process_coding.mode |= CODING_MODE_LAST_BLOCK;
		  break;
		}
791

792 793
	      nread += this_read;
	      total_read += this_read;
794

795 796 797
	      if (display_on_the_fly)
		break;
	    }
798

799 800
	  /* Now NREAD is the total amount of data in the buffer.  */
	  immediate_quit = 0;
801

802 803 804 805 806 807 808 809
	  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;
810
		  ptrdiff_t count1 = SPECPDL_INDEX ();
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 847 848 849 850 851 852 853 854

		  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