callproc.c 52.8 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Synchronous subprocess invocation for GNU Emacs.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1988, 1993-1995, 1999-2020 Free Software Foundation,
4
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

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

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


22
#include <config.h>
23
#include <errno.h>
Paul Eggert's avatar
Paul Eggert committed
24
#include <stdlib.h>
Jim Blandy's avatar
Jim Blandy committed
25
#include <sys/types.h>
26 27
#include <unistd.h>

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

31 32
#include "lisp.h"

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

40 41 42 43 44
#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
45
#include "commands.h"
46
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
47
#include "coding.h"
48
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
49
#include "process.h"
50
#include "syssignal.h"
51
#include "syswait.h"
Kim F. Storm's avatar
Kim F. Storm committed
52
#include "blockinput.h"
53
#include "frame.h"
54 55
#include "systty.h"
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
56

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

61 62 63 64
#ifdef HAVE_NS
#include "nsterm.h"
#endif

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

68 69 70 71
/* The next two variables are used while record-unwind-protect is in place
   during call-process for a subprocess for which record_deleted_pid has
   not yet been called.  At other times, synch_process_pid is zero and
   synch_process_tempfile's contents are irrelevant.  Doing this via static
72 73 74 75 76 77 78 79 80
   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;

81 82 83 84
/* If a string, the name of a temp file that has not been removed.  */
#ifdef MSDOS
static Lisp_Object synch_process_tempfile;
#else
85
# define synch_process_tempfile make_fixnum (0)
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
#endif

/* Indexes of file descriptors that need closing on call_process_kill.  */
enum
  {
    /* The subsidiary process's stdout and stderr.  stdin is handled
       separately, in either Fcall_process_region or create_temp_file.  */
    CALLPROC_STDOUT, CALLPROC_STDERR,

    /* How to read from a pipe (or substitute) from the subsidiary process.  */
    CALLPROC_PIPEREAD,

    /* A bound on the number of file descriptors.  */
    CALLPROC_FDS
  };

102
static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t);
103

104 105 106 107 108 109 110
/* Return the current buffer's working directory, or the home
   directory if it's unreachable, as a string suitable for a system call.
   Signal an error if the result would not be an accessible directory.  */

Lisp_Object
encode_current_directory (void)
{
111 112
  Lisp_Object curdir = BVAR (current_buffer, directory);
  Lisp_Object dir = Funhandled_file_name_directory (curdir);
113 114 115 116 117 118

  /* If the file name handler says that dir is unreachable, use
     a sensible default. */
  if (NILP (dir))
    dir = build_string ("~");

Paul Eggert's avatar
Paul Eggert committed
119
  dir = expand_and_dir_to_file (dir);
120
  dir = ENCODE_FILE (remove_slash_colon (dir));
121

122
  if (! file_accessible_directory_p (dir))
123
    report_file_error ("Setting current directory", curdir);
124

125
  return dir;
126 127
}

128 129 130 131 132
/* 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
133
record_kill_process (struct Lisp_Process *p, Lisp_Object tempfile)
134
{
Eli Zaretskii's avatar
Eli Zaretskii committed
135
#ifndef MSDOS
136 137
  sigset_t oldset;
  block_child_signal (&oldset);
138 139 140

  if (p->alive)
    {
141
      record_deleted_pid (p->pid, tempfile);
142
      p->alive = 0;
143
      kill (- p->pid, SIGKILL);
144 145
    }

146
  unblock_child_signal (&oldset);
Eli Zaretskii's avatar
Eli Zaretskii committed
147
#endif	/* !MSDOS */
148 149
}

150 151 152 153 154 155 156
/* Clean up files, file descriptors and processes created by Fcall_process.  */

static void
delete_temp_file (Lisp_Object name)
{
  unlink (SSDATA (name));
}
157

158
static void
159
call_process_kill (void *ptr)
160
{
161 162 163 164 165
  int *callproc_fd = ptr;
  int i;
  for (i = 0; i < CALLPROC_FDS; i++)
    if (0 <= callproc_fd[i])
      emacs_close (callproc_fd[i]);
166 167 168

  if (synch_process_pid)
    {
169 170 171
      struct Lisp_Process proc;
      proc.alive = 1;
      proc.pid = synch_process_pid;
172 173
      record_kill_process (&proc, synch_process_tempfile);
      synch_process_pid = 0;
174
    }
175 176
  else if (STRINGP (synch_process_tempfile))
    delete_temp_file (synch_process_tempfile);
177 178
}

179 180
/* Clean up when exiting Fcall_process: restore the buffer, and
   kill the subsidiary process group if the process still exists.  */
181

182
static void
183
call_process_cleanup (Lisp_Object buffer)
Jim Blandy's avatar
Jim Blandy committed
184
{
185
  Fset_buffer (buffer);
186

Eli Zaretskii's avatar
Eli Zaretskii committed
187
#ifndef MSDOS
188
  if (synch_process_pid)
189
    {
190
      kill (-synch_process_pid, SIGINT);
191
      message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
192 193

      /* This will quit on C-g.  */
194
      bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
195
      synch_process_pid = 0;
196 197 198
      message1 (wait_ok
		? "Waiting for process to die...done"
		: "Waiting for process to die...internal error");
199
    }
Eli Zaretskii's avatar
Eli Zaretskii committed
200
#endif	/* !MSDOS */
Jim Blandy's avatar
Jim Blandy committed
201 202
}

203 204 205 206 207 208
#ifdef DOS_NT
static mode_t const default_output_mode = S_IREAD | S_IWRITE;
#else
static mode_t const default_output_mode = 0666;
#endif

Paul Eggert's avatar
Paul Eggert committed
209
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
210 211
       doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
212

213
The program's input comes from file INFILE (nil means `null-device').
214 215
If you want to make the input come from an Emacs buffer, use
`call-process-region' instead.
216 217 218 219 220 221 222 223 224

Third argument DESTINATION specifies how to handle program's output.
If DESTINATION is a buffer, or t that stands for the current buffer,
 it means insert output in that buffer before point.
If DESTINATION is nil, it means discard output; 0 means discard
 and don't wait for the program to terminate.
If DESTINATION is `(:file FILE)', where FILE is a file name string,
 it means that output should be written to that file (if the file
 already exists it is overwritten).
225
DESTINATION can also have the form (REAL-BUFFER STDERR-FILE); in that case,
226 227 228 229
 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.
230 231

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

234 235 236 237
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.

238
If DESTINATION is 0, `call-process' returns immediately with value nil.
239 240
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
241 242
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.

243 244 245 246
The process runs in `default-directory' if that is local (as
determined by `unhandled-file-name-directory'), or "~" otherwise.  If
you want to run a process in a remote directory use `process-file'.

247
usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS)  */)
248
  (ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
249
{
250 251 252 253 254 255 256 257 258 259 260 261
  Lisp_Object infile, encoded_infile;
  int filefd;
  ptrdiff_t count = SPECPDL_INDEX ();

  if (nargs >= 2 && ! NILP (args[1]))
    {
      infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
      CHECK_STRING (infile);
    }
  else
    infile = build_string (NULL_DEVICE);

262
  encoded_infile = ENCODE_FILE (infile);
263 264 265 266 267

  filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
  if (filefd < 0)
    report_file_error ("Opening process input file", infile);
  record_unwind_protect_int (close_file_unwind, filefd);
268
  return unbind_to (count, call_process (nargs, args, filefd, -1));
269 270 271
}

/* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
272 273 274 275 276

   If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an
   unwinder that is intended to remove the input temporary file; in
   this case NARGS must be at least 2 and ARGS[1] is the file's name.

277 278 279
   At entry, the specpdl stack top entry must be close_file_unwind (FILEFD).  */

static Lisp_Object
280 281
call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
	      ptrdiff_t tempfile_index)
282 283
{
  Lisp_Object buffer, current_dir, path;
284
  bool display_p;
285 286
  int fd0;
  int callproc_fd[CALLPROC_FDS];
287
  int status;
288
  ptrdiff_t i;
289 290
  ptrdiff_t count = SPECPDL_INDEX ();
  USE_SAFE_ALLOCA;
291

292
  char **new_argv;
293 294 295
  /* File to use for stderr in the child.
     t means use same as standard output.  */
  Lisp_Object error_file;
296
  Lisp_Object output_file = Qnil;
297
#ifdef MSDOS	/* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
298
  char *tempfile = NULL;
299
#else
300
  sigset_t oldset;
301
  pid_t pid;
Jim Blandy's avatar
Jim Blandy committed
302
#endif
303
  int child_errno;
304
  int fd_output, fd_error;
Karl Heuer's avatar
Karl Heuer committed
305 306
  struct coding_system process_coding; /* coding-system of process output */
  struct coding_system argument_coding;	/* coding-system of arguments */
307 308
  /* Set to the return value of Ffind_operation_coding_system.  */
  Lisp_Object coding_systems;
309 310 311 312
  bool discard_output;

  if (synch_process_pid)
    error ("call-process invoked recursively");
313 314 315

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

317
  CHECK_STRING (args[0]);
Jim Blandy's avatar
Jim Blandy committed
318

319 320
  error_file = Qt;

321 322
#ifndef subprocesses
  /* Without asynchronous processes we cannot have BUFFER == 0.  */
323
  if (nargs >= 3
324
      && (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
325 326 327
    error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */

328
  /* Decide the coding-system for giving arguments.  */
Karl Heuer's avatar
Karl Heuer committed
329 330 331 332 333 334
  {
    Lisp_Object val, *args2;

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

338
	for (i = 4; i < nargs; i++)
339
	  CHECK_STRING (args[i]);
340

341
	for (i = 4; i < nargs; i++)
342 343 344
	  if (STRING_MULTIBYTE (args[i]))
	    must_encode = 1;

345 346
	if (!NILP (Vcoding_system_for_write))
	  val = Vcoding_system_for_write;
347
	else if (! must_encode)
348
	  val = Qraw_text;
349
	else
Karl Heuer's avatar
Karl Heuer committed
350
	  {
351
	    SAFE_NALLOCA (args2, 1, nargs + 1);
Karl Heuer's avatar
Karl Heuer committed
352 353
	    args2[0] = Qcall_process;
	    for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
354
	    coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
355
	    val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
Karl Heuer's avatar
Karl Heuer committed
356
	  }
357
	val = complement_process_encoding_system (val);
Karl Heuer's avatar
Karl Heuer committed
358
	setup_coding_system (Fcheck_coding_system (val), &argument_coding);
359 360 361 362 363 364 365
	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
366 367 368
      }
  }

369 370
  if (nargs < 3)
    buffer = Qnil;
Jim Blandy's avatar
Jim Blandy committed
371
  else
372
    {
373 374
      buffer = args[2];

375 376 377
      /* 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. */
378
      if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
379
	{
380
	  if (CONSP (XCDR (buffer)))
381
	    {
382
	      Lisp_Object stderr_file;
383
	      stderr_file = XCAR (XCDR (buffer));
384 385 386 387 388 389 390

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

391
	  buffer = XCAR (buffer);
392
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
393

394
      /* If the buffer is (still) a list, it might be a (:file "file") spec. */
395
      if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
396 397 398 399 400 401 402
	{
	  output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
					   BVAR (current_buffer, directory));
	  CHECK_STRING (output_file);
	  buffer = Qnil;
	}

403
      if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
404
	{
405 406
	  Lisp_Object spec_buffer;
	  spec_buffer = buffer;
407
	  buffer = Fget_buffer_create (buffer);
408 409
	  /* Mention the buffer name for a better error message.  */
	  if (NILP (buffer))
410 411
	    CHECK_BUFFER (spec_buffer);
	  CHECK_BUFFER (buffer);
412 413
	}
    }
Jim Blandy's avatar
Jim Blandy committed
414

415 416 417
  /* 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
418 419
     chdir, since it's in a vfork.  */
  current_dir = encode_current_directory ();
420

421 422 423 424
  if (STRINGP (error_file))
    error_file = ENCODE_FILE (error_file);
  if (STRINGP (output_file))
    output_file = ENCODE_FILE (output_file);
425

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

428 429 430
  for (i = 0; i < CALLPROC_FDS; i++)
    callproc_fd[i] = -1;
#ifdef MSDOS
431
  synch_process_tempfile = make_fixnum (0);
432 433
#endif
  record_unwind_protect_ptr (call_process_kill, callproc_fd);
434

Jim Blandy's avatar
Jim Blandy committed
435
  /* Search for program; barf if not found.  */
436
  {
437
    int ok;
438

439
    ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
440
		make_fixnum (X_OK), false);
441
    if (ok < 0)
442
      report_file_error ("Searching for program", args[0]);
443
  }
444

445 446
  /* Remove "/:" from PATH.  */
  path = remove_slash_colon (path);
447

448
  SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
449

450 451 452
  if (nargs > 4)
    {
      ptrdiff_t i;
453

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

471
  discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file));
472

473 474
#ifdef MSDOS
  if (! discard_output && ! STRINGP (output_file))
475
    {
476 477 478 479
      char const *tmpdir = egetenv ("TMPDIR");
      char const *outf = tmpdir ? tmpdir : "";
      tempfile = alloca (strlen (outf) + 20);
      strcpy (tempfile, outf);
Eli Zaretskii's avatar
Eli Zaretskii committed
480
      dostounix_filename (tempfile);
481 482
      if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
	strcat (tempfile, "/");
Eli Zaretskii's avatar
Eli Zaretskii committed
483
      strcat (tempfile, "emXXXXXX");
484
      mktemp (tempfile);
485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503
      if (!*tempfile)
	report_file_error ("Opening process output file", Qnil);
      output_file = build_string (tempfile);
      synch_process_tempfile = output_file;
    }
#endif

  if (discard_output)
    {
      fd_output = emacs_open (NULL_DEVICE, O_WRONLY, 0);
      if (fd_output < 0)
	report_file_error ("Opening null device", Qnil);
    }
  else if (STRINGP (output_file))
    {
      fd_output = emacs_open (SSDATA (output_file),
			      O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
			      default_output_mode);
      if (fd_output < 0)
504 505
	{
	  int open_errno = errno;
506
	  output_file = DECODE_FILE (output_file);
507
	  report_file_errno ("Opening process output file",
508
			     output_file, open_errno);
509
	}
510
    }
Jim Blandy's avatar
Jim Blandy committed
511 512
  else
    {
513
      int fd[2];
514
      if (emacs_pipe (fd) != 0)
515 516 517
	report_file_error ("Creating process pipe", Qnil);
      callproc_fd[CALLPROC_PIPEREAD] = fd[0];
      fd_output = fd[1];
Jim Blandy's avatar
Jim Blandy committed
518
    }
519
  callproc_fd[CALLPROC_STDOUT] = fd_output;
Jim Blandy's avatar
Jim Blandy committed
520

521
  fd_error = fd_output;
Jim Blandy's avatar
Jim Blandy committed
522

523 524 525 526 527
  if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
    {
      fd_error = emacs_open ((STRINGP (error_file)
			      ? SSDATA (error_file)
			      : NULL_DEVICE),
528 529
			     O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
			     default_output_mode);
530 531 532 533 534 535 536 537 538 539 540
      if (fd_error < 0)
	{
	  int open_errno = errno;
	  report_file_errno ("Cannot redirect stderr",
			     (STRINGP (error_file)
			      ? DECODE_FILE (error_file)
			      : build_string (NULL_DEVICE)),
			     open_errno);
	}
      callproc_fd[CALLPROC_STDERR] = fd_error;
    }
541

542
#ifdef MSDOS /* MW, July 1993 */
543
  status = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
544

545
  if (status < 0)
546 547 548 549 550 551 552 553 554 555 556
    {
      child_errno = errno;
      unbind_to (count, Qnil);
      synchronize_system_messages_locale ();
      return
	code_convert_string_norecord (build_string (strerror (child_errno)),
				      Vlocale_coding_system, 0);
    }

  for (i = 0; i < CALLPROC_FDS; i++)
    if (0 <= callproc_fd[i])
557
      {
558 559
	emacs_close (callproc_fd[i]);
	callproc_fd[i] = -1;
560
      }
561 562 563 564 565 566 567
  emacs_close (filefd);
  clear_unwind_protect (count - 1);

  if (tempfile)
    {
      /* Since CRLF is converted to LF within `decode_coding', we
	 can always open a file with binary mode.  */
Paul Eggert's avatar
Paul Eggert committed
568
      callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
569 570 571 572 573 574 575 576
      if (callproc_fd[CALLPROC_PIPEREAD] < 0)
	{
	  int open_errno = errno;
	  report_file_errno ("Cannot re-open temporary file",
			     build_string (tempfile), open_errno);
	}
    }

Paul Eggert's avatar
Paul Eggert committed
577
#endif /* MSDOS */
578

579 580 581 582
  /* 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.  */
  record_unwind_protect (call_process_cleanup, Fcurrent_buffer ());
Paul Eggert's avatar
Paul Eggert committed
583

584
#ifndef MSDOS
585

586
  block_input ();
587
  block_child_signal (&oldset);
588

589
#ifdef WINDOWSNT
590
  pid = child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
591
#else  /* not WINDOWSNT */
592

593 594 595 596 597 598 599 600 601
  /* vfork, and prevent local vars from being clobbered by the vfork.  */
  {
    Lisp_Object volatile buffer_volatile = buffer;
    Lisp_Object volatile coding_systems_volatile = coding_systems;
    Lisp_Object volatile current_dir_volatile = current_dir;
    bool volatile display_p_volatile = display_p;
    int volatile fd_error_volatile = fd_error;
    int volatile filefd_volatile = filefd;
    ptrdiff_t volatile count_volatile = count;
602
    ptrdiff_t volatile sa_avail_volatile = sa_avail;
603 604 605 606 607 608 609 610 611 612 613 614 615 616 617
    ptrdiff_t volatile sa_count_volatile = sa_count;
    char **volatile new_argv_volatile = new_argv;
    int volatile callproc_fd_volatile[CALLPROC_FDS];
    for (i = 0; i < CALLPROC_FDS; i++)
      callproc_fd_volatile[i] = callproc_fd[i];

    pid = vfork ();

    buffer = buffer_volatile;
    coding_systems = coding_systems_volatile;
    current_dir = current_dir_volatile;
    display_p = display_p_volatile;
    fd_error = fd_error_volatile;
    filefd = filefd_volatile;
    count = count_volatile;
618
    sa_avail = sa_avail_volatile;
619 620 621 622 623 624 625
    sa_count = sa_count_volatile;
    new_argv = new_argv_volatile;

    for (i = 0; i < CALLPROC_FDS; i++)
      callproc_fd[i] = callproc_fd_volatile[i];
    fd_output = callproc_fd[CALLPROC_STDOUT];
  }
626

627 628
  if (pid == 0)
    {
629 630 631
#ifdef DARWIN_OS
      /* Work around a macOS bug, where SIGCHLD is apparently
	 delivered to a vforked child instead of to its parent.  See:
632
	 https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
633 634 635 636
      */
      signal (SIGCHLD, SIG_DFL);
#endif

637
      unblock_child_signal (&oldset);
638
      dissociate_controlling_tty ();
639

640 641
      /* Emacs ignores SIGPIPE, but the child should not.  */
      signal (SIGPIPE, SIG_DFL);
642 643 644 645
      /* Likewise for SIGPROF.  */
#ifdef SIGPROF
      signal (SIGPROF, SIG_DFL);
#endif
646

647 648
      child_setup (filefd, fd_output, fd_error, new_argv, 0, current_dir);
    }
Kim F. Storm's avatar
Kim F. Storm committed
649

650
#endif /* not WINDOWSNT */
651

652
  child_errno = errno;
653

654
  if (pid > 0)
655 656 657
    {
      synch_process_pid = pid;

658
      if (FIXNUMP (buffer))
659 660 661 662 663 664 665 666 667 668 669 670
	{
	  if (tempfile_index < 0)
	    record_deleted_pid (pid, Qnil);
	  else
	    {
	      eassert (1 < nargs);
	      record_deleted_pid (pid, args[1]);
	      clear_unwind_protect (tempfile_index);
	    }
	  synch_process_pid = 0;
	}
    }
671

672
  unblock_child_signal (&oldset);
673
  unblock_input ();
674

Jim Blandy's avatar
Jim Blandy committed
675
  if (pid < 0)
676
    report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
Jim Blandy's avatar
Jim Blandy committed
677

678 679 680 681 682 683 684 685 686 687 688
  /* Close our file descriptors, except for callproc_fd[CALLPROC_PIPEREAD]
     since we will use that to read input from.  */
  for (i = 0; i < CALLPROC_FDS; i++)
    if (i != CALLPROC_PIPEREAD && 0 <= callproc_fd[i])
      {
	emacs_close (callproc_fd[i]);
	callproc_fd[i] = -1;
      }
  emacs_close (filefd);
  clear_unwind_protect (count - 1);

Eli Zaretskii's avatar
Eli Zaretskii committed
689 690
#endif /* not MSDOS */

691
  if (FIXNUMP (buffer))
Paul Eggert's avatar
Paul Eggert committed
692
    return unbind_to (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
693

694
  if (BUFFERP (buffer))
Jim Blandy's avatar
Jim Blandy committed
695 696
    Fset_buffer (buffer);

697 698 699
  fd0 = callproc_fd[CALLPROC_PIPEREAD];

  if (0 <= fd0)
700 701 702 703 704 705 706 707 708 709
    {
      Lisp_Object val, *args2;

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

712
	      SAFE_NALLOCA (args2, 1, nargs + 1);
713 714 715 716 717 718
	      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))
719
	    val = XCAR (coding_systems);
720
	  else if (CONSP (Vdefault_process_coding_system))
721
	    val = XCAR (Vdefault_process_coding_system);
722 723 724
	  else
	    val = Qnil;
	}
725
      Fcheck_coding_system (val);
726 727 728
      /* 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
729
      if (NILP (BVAR (current_buffer, enable_multibyte_characters))
730
	  && !NILP (val))
731 732
	val = raw_text_coding_system (val);
      setup_coding_system (val, &process_coding);
733 734
      process_coding.dst_multibyte
	= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
735
      process_coding.src_multibyte = 0;
736 737
    }

738
  if (0 <= fd0)
739
    {
740 741 742 743
      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;
744
      int nread;
745 746
      EMACS_INT total_read = 0;
      int carryover = 0;
747
      bool display_on_the_fly = display_p;
748
      struct coding_system saved_coding = process_coding;
749 750
      ptrdiff_t prepared_pos = 0; /* prepare_to_modify_buffer was last
                                     called here.  */
751 752 753 754 755 756 757 758 759

      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)
	    {
Paul Eggert's avatar
Paul Eggert committed
760 761
	      int this_read = emacs_read_quit (fd0, buf + nread,
					       bufsize - nread);
762

763 764
	      if (this_read < 0)
		goto give_up;
765

766 767 768 769 770
	      if (this_read == 0)
		{
		  process_coding.mode |= CODING_MODE_LAST_BLOCK;
		  break;
		}
771

772 773
	      nread += this_read;
	      total_read += this_read;
774

775 776 777
	      if (display_on_the_fly)
		break;
	    }
778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796
          /* CHANGE FUNCTIONS
             For each iteration of the enclosing while (1) loop which
             yields data (i.e. nread > 0), before- and
             after-change-functions are each invoked exactly once.
             This is done directly from the current function only, by
             calling prepare_to_modify_buffer and signal_after_change.
             It is not done here by directing another function such as
             insert_1_both to call them.  The call to
             prepare_to_modify_buffer follows this comment, and there
             is one call to signal_after_change in each of the
             branches of the next `else if'.

             Exceptionally, the insertion into the buffer is aborted
             at the call to del_range_2 ~45 lines further down, this
             function removing the newly inserted data.  At this stage
             prepare_to_modify_buffer has been called, but
             signal_after_change hasn't.  A continue statement
             restarts the enclosing while (1) loop.  A second,
             unwanted, call to `prepare_to_modify_buffer' is inhibited
Paul Eggert's avatar
Paul Eggert committed
797
	     by the test prepared_pos < PT.  The data are inserted
798 799 800 801 802 803 804
             again, and this time signal_after_change gets called,
             balancing the previous call to prepare_to_modify_buffer.  */
          if ((prepared_pos < PT) && nread)
            {
              prepare_to_modify_buffer (PT, PT, NULL);
              prepared_pos = PT;
            }
805

806
	  /* Now NREAD is the total amount of data in the buffer.  */
807

808 809 810 811
	  if (!nread)
	    ;
	  else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
		   && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
812 813
            {
              insert_1_both (buf, nread, nread, 0, 0, 0);
814
              signal_after_change (PT - nread, 0, nread);
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
	  else
	    {			/* We have to decode the input.  */
	      Lisp_Object curbuf;
	      ptrdiff_t count1 = SPECPDL_INDEX ();

	      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 the
		     detection may have been via insufficient data.
		     So 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);
846
		  display_on_the_fly = false;
847 848 849 850 851 852
		  process_coding = saved_coding;
		  carryover = nread;
		  /* Make the above condition always fail in the future.  */
		  saved_coding.common_flags
		    &= ~CODING_REQUIRE_DETECTION_MASK;
		  continue;
853
		}
854 855 856

	      TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
				PT_BYTE + process_coding.produced);
857 858
              signal_after_change (PT - process_coding.produced_char,
                                   0, process_coding.produced_char);
859 860 861 862
	      carryover = process_coding.carryover_bytes;
	      if (carryover > 0)
		memcpy (buf, process_coding.carryover,
			process_coding.carryover_bytes);
863
	    }
864

865 866
	  if (process_coding.mode & CODING_MODE_LAST_BLOCK)
	    break;
867

868 869 870 871 872
	  /* Make the buffer bigger as we continue to read more data,
	     but not past CALLPROC_BUFFER_SIZE_MAX.  */
	  if (bufsize < CALLPROC_BUFFER_SIZE_MAX && total_read > 32 * bufsize)
	    if ((bufsize *= 2) > CALLPROC_BUFFER_SIZE_MAX)
	      bufsize = CALLPROC_BUFFER_SIZE_MAX;
873

874 875 876 877
	  if (display_p)
	    {
	      redisplay_preserve_echo_area (1);
	      /* This variable might have been set to 0 for code
878
		 detection.  In that case, set it back to 1 because
879
		 we should have already detected a coding system.  */
880
	      display_on_the_fly = true;
881 882 883 884 885 886 887 888 889
	    }
	}
    give_up: ;

      Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
      /* If the caller required, let the buffer inherit the
	 coding-system used to decode the process output.  */
      if (inherit_process_coding_system)
	call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
890
	       make_fixnum (total_read));
891
    }
Eli Zaretskii's avatar
Eli Zaretskii committed
892

893
  bool wait_ok = true;
894
#ifndef MSDOS
Jim Blandy's avatar
Jim Blandy committed
895
  /* Wait for it to terminate, unless it already has.  */
896
  wait_ok = wait_for_termination (pid, &status, fd0 < 0);
897
#endif
Jim Blandy's avatar
Jim Blandy committed
898

899 900
  /* Don't kill any children that the subprocess may have left behind
     when exiting.  */
901
  synch_process_pid = 0;
902

Paul Eggert's avatar
Paul Eggert committed
903
  SAFE_FREE_UNBIND_TO (count, Qnil);
Jim Blandy's avatar
Jim Blandy committed
904

905 906 907
  if (!wait_ok)
    return build_unibyte_string ("internal error");

908
  if (WIFSIGNALED (status))
Kenichi Handa's avatar
Kenichi Handa committed
909
    {
910
      const char *signame;
Kenichi Handa's avatar
Kenichi Handa committed
911 912

      synchronize_system_messages_locale ();
913
      signame = strsignal (WTERMSIG (status));
Kenichi Handa's avatar
Kenichi Handa committed
914 915

      if (signame == 0)
916
	signame = "unknown";
Kenichi Handa's avatar
Kenichi Handa committed
917

918 919
      return code_convert_string_norecord (build_string (signame),
					   Vlocale_coding_system, 0);
Kenichi Handa's avatar
Kenichi Handa committed
920 921
    }

922
  eassert (WIFEXITED (status));
923
  return make_fixnum (WEXITSTATUS (status));
Jim Blandy's avatar
Jim Blandy committed
924 925
}

926 927
/* Create a temporary file suitable for storing the input data of
   call-process-region.  NARGS and ARGS are the same as for
928 929 930 931
   call-process-region.  Store into *FILENAME_STRING_PTR a Lisp string
   naming the file, and return a file descriptor for reading.
   Unwind-protect the file, so that the file descriptor will be closed
   and the file removed when the caller unwinds the specpdl stack.  */
932

933 934 935
static int
create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
		  Lisp_Object *filename_string_ptr)
Jim Blandy's avatar
Jim Blandy committed
936
{
937
  int fd;
938
  Lisp_Object filename_string;
939
  Lisp_Object val, start, end;
940
  Lisp_Object tmpdir;
941

942 943
  if (STRINGP (Vtemporary_file_directory))
    tmpdir = Vtemporary_file_directory;
944 945
  else
    {
Paul Eggert's avatar
Paul Eggert committed
946
      char *outf;
947
#ifndef DOS_NT
Paul Eggert's avatar
Paul Eggert committed
948 949
      outf = getenv ("TMPDIR");
      tmpdir = build_string (outf ? outf : "/tmp/");
950 951 952 953 954 955 956
#else /* DOS_NT */
      if ((outf = egetenv ("TMPDIR"))
	  || (outf = egetenv ("TMP"))
	  || (outf = egetenv ("TEMP")))
	tmpdir = build_string (outf);
      else
	tmpdir = Ffile_name_as_directory (build_string ("c:/temp"));
957
#endif
958
    }
959

960
  {
961
    Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
962
    char *tempfile;
963
    ptrdiff_t count;
964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979

#ifdef WINDOWSNT
    /* Cannot use the result of Fexpand_file_name, because it
       downcases the XXXXXX part of the pattern, and mktemp then
       doesn't recognize it.  */
    if (!NILP (Vw32_downcase_file_names))
      {
	Lisp_Object dirname = Ffile_name_directory (pattern);

	if (NILP (dirname))
	  pattern = Vtemp_file_name_pattern;
	else
	  pattern = concat2 (dirname, Vtemp_file_name_pattern);
      }
#endif

980 981
    filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
    tempfile = SSDATA (filename_string);
982

983 984
    count = SPECPDL_INDEX ();
    record_unwind_protect_nothing ();
985
    fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
986 987 988 989 990
    if (fd < 0)
      report_file_error ("Failed to open temporary file using pattern",
			 pattern);
    set_unwind_protect (count, delete_temp_file, filename_string);
    record_unwind_protect_int (close_file_unwind, fd);
991 992
  }

Jim Blandy's avatar
Jim Blandy committed
993 994
  start = args[0];
  end = args[1];
Karl Heuer's avatar
Karl Heuer committed
995
  /* Decide coding-system of the contents of the temporary file.  */
996 997
  if (!NILP (Vcoding_system_for_write))
    val = Vcoding_system_for_write;
Tom Tromey's avatar
Tom Tromey committed
998
  else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
999
    val = Qraw_text;
Karl Heuer's avatar
Karl Heuer committed
1000
  else
1001
    {
1002 1003
      Lisp_Object coding_systems;
      Lisp_Object *args2;
1004
      USE_SAFE_ALLOCA;
1005
      SAFE_NALLOCA (args2, 1, nargs + 1);
1006
      args2[0] = Qcall_process_region;
1007
      memcpy (args2 + 1, args, nargs * sizeof *args);
1008
      coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
1009
      val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
1010
      SAFE_FREE ();
1011
    }
1012
  val = complement_process_encoding_system (val);
Karl Heuer's avatar
Karl Heuer committed
1013

1014
  {
1015
    ptrdiff_t count1 = SPECPDL_INDEX ();
1016 1017

    specbind (intern ("coding-system-for-write"), val);
1018 1019
    /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
       happen to get a ".Z" suffix.  */
1020
    specbind (Qfile_name_handler_alist, Qnil);
1021
    write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
1022 1023 1024

    unbind_to (count1, Qnil);
  }
1025

1026 1027 1028
  if (lseek (fd, 0, SEEK_SET) < 0)
    report_file_error ("Setting file position", filename_string);

1029
  /* Note that Fcall_process takes care of binding
1030
     coding-system-for-read.  */
1031

1032 1033
  *filename_string_ptr = filename_string;
  return fd;
1034 1035 1036 1037 1038
}

DEFUN ("call-process-region", Fcall_process_region, Scall_process_region,
       3, MANY, 0,
       doc: /* Send text from START to END to a synchronous process running PROGRAM.
1039 1040 1041 1042 1043 1044 1045

START and END are normally buffer positions specifying the part of the
buffer to send to the process.
If START is nil, that means to use the entire buffer contents; END is
ignored.
If START is a string, then send that string to the process
instead of any buffer contents; END is ignored.
1046 1047 1048 1049 1050 1051 1052 1053