/* Synchronous subprocess invocation for GNU Emacs.
Copyright (C) 1985-1988, 1993-1995, 1999-2024 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
#include <stdlib.h>
#include <sys/types.h>
#include <unistd.h>
#ifdef MSDOS
extern char **environ;
#endif
#include <sys/file.h>
#include <fcntl.h>
/* In order to be able to use `posix_spawn', it needs to support some
variant of `chdir' as well as `setsid'. */
#if defined HAVE_SPAWN_H && defined HAVE_POSIX_SPAWN \
&& defined HAVE_POSIX_SPAWNATTR_SETFLAGS \
&& (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR \
|| defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \
&& defined HAVE_DECL_POSIX_SPAWN_SETSID \
&& HAVE_DECL_POSIX_SPAWN_SETSID == 1 \
/* posix_spawnattr_setflags rejects POSIX_SPAWN_SETSID on \
Haiku */ \
&& !defined HAIKU
# include <spawn.h>
# define USABLE_POSIX_SPAWN 1
#else
# define USABLE_POSIX_SPAWN 0
#endif
#include "lisp.h"
#ifdef SETUP_SLAVE_PTY
# include <sys/stream.h>
# include <sys/stropts.h>
#endif
#ifdef WINDOWSNT
#include <sys/socket.h> /* for fcntl */
#include <windows.h>
#include "w32.h"
#define _P_NOWAIT 1 /* from process.h */
#endif
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
#include <sys/stat.h>
#include <sys/param.h>
#endif /* MSDOS */
#include "commands.h"
#include "buffer.h"
#include "coding.h"
#include <epaths.h>
#include "process.h"
#include "syssignal.h"
#include "syswait.h"
#include "blockinput.h"
#include "frame.h"
#include "systty.h"
#include "keyboard.h"
#ifdef MSDOS
#include "msdos.h"
#endif
#ifdef HAVE_NS
#include "nsterm.h"
#endif
#ifdef HAVE_PGTK
#include "pgtkterm.h"
#endif
/* Pattern used by call-process-region to make temp files. */
static Lisp_Object Vtemp_file_name_pattern;
/* 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
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 a string, the name of a temp file that has not been removed. */
#ifdef MSDOS
static Lisp_Object synch_process_tempfile;
#else
# define synch_process_tempfile make_fixnum (0)
#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
};
static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, specpdl_ref);
#ifdef DOS_NT
# define CHILD_SETUP_TYPE int
#else
# define CHILD_SETUP_TYPE _Noreturn void
#endif
static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **,
const char *);
/* Return the current buffer's working directory, or the home
directory if it's unreachable. If ENCODE is true, return as a string
suitable for a system call; otherwise, return a string in its
internal representation. Signal an error if the result would not be
an accessible directory. */
Lisp_Object
get_current_directory (bool encode)
{
Lisp_Object curdir = BVAR (current_buffer, directory);
Lisp_Object dir = Funhandled_file_name_directory (curdir);
/* If the file name handler says that dir is unreachable, use
a sensible default. */
if (NILP (dir))
dir = build_string ("~");
dir = expand_and_dir_to_file (dir);
Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir));
if (! file_accessible_directory_p (encoded_dir))
report_file_error ("Setting current directory", curdir);
return encode ? encoded_dir : dir;
}
/* 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, Lisp_Object tempfile)
{
#ifndef MSDOS
sigset_t oldset;
block_child_signal (&oldset);
if (p->alive)
{
record_deleted_pid (p->pid, tempfile);
p->alive = 0;
kill (- p->pid, SIGKILL);
}
unblock_child_signal (&oldset);
#endif /* !MSDOS */
}
/* Clean up files, file descriptors and processes created by Fcall_process. */
static void
delete_temp_file (Lisp_Object name)
{
unlink (SSDATA (name));
}
static void
call_process_kill (void *ptr)
{
int *callproc_fd = ptr;
int i;
for (i = 0; i < CALLPROC_FDS; i++)
if (0 <= callproc_fd[i])
emacs_close (callproc_fd[i]);
if (synch_process_pid)
{
struct Lisp_Process proc;
proc.alive = 1;
proc.pid = synch_process_pid;
record_kill_process (&proc, synch_process_tempfile);
synch_process_pid = 0;
}
else if (STRINGP (synch_process_tempfile))
delete_temp_file (synch_process_tempfile);
}
/* Clean up when exiting Fcall_process: restore the buffer, and
kill the subsidiary process group if the process still exists. */
static void
call_process_cleanup (Lisp_Object buffer)
{
Fset_buffer (buffer);
#ifndef MSDOS
if (synch_process_pid)
{
kill (-synch_process_pid, SIGINT);
message1 ("Waiting for process to die...(type C-g again to kill it instantly)");
/* This will quit on C-g. */
bool wait_ok = wait_for_termination (synch_process_pid, NULL, true);
synch_process_pid = 0;
message1 (wait_ok
? "Waiting for process to die...done"
: "Waiting for process to die...internal error");
}
#endif /* !MSDOS */
}
#ifdef DOS_NT
static mode_t const default_output_mode = S_IREAD | S_IWRITE;
#else
static mode_t const default_output_mode = 0666;
#endif
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `null-device').
If INFILE is a relative path, it will be looked for relative to the
directory where the process is run (see below). If you want to make the
input come from an Emacs buffer, use `call-process-region' instead.
Third argument DESTINATION specifies how to handle program's output.
(\"Output\" here means both standard output and standard error
output.)
If DESTINATION is a buffer or the name of a buffer, or t (which 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).
DESTINATION 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 ARGS are strings passed as command arguments to PROGRAM.
If PROGRAM is not an absolute file name, `call-process' will look for
PROGRAM in `exec-path' (which is a list of directories).
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.
If DESTINATION 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.
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
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'.
usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object infile, encoded_infile;
int filefd;
specpdl_ref count = SPECPDL_INDEX ();
if (nargs >= 2 && ! NILP (args[1]))
{
/* Expand infile relative to the current buffer's current
directory, or its unhandled equivalent ("~"). */
infile = Fexpand_file_name (args[1], get_current_directory (false));
CHECK_STRING (infile);
}
else
infile = build_string (NULL_DEVICE);
/* Remove "/:" from INFILE. */
infile = remove_slash_colon (infile);
encoded_infile = ENCODE_FILE (infile);
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);
return unbind_to (count, call_process (nargs, args, filefd,
make_invalid_specpdl_ref ()));
}
/* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file.
If TEMPFILE_INDEX is valid, 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.
At entry, the specpdl stack top entry must be close_file_unwind (FILEFD). */
static Lisp_Object
call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
specpdl_ref tempfile_index)
{
Lisp_Object buffer, current_dir, path;
bool display_p;
int fd0;
int callproc_fd[CALLPROC_FDS];
int status;
ptrdiff_t i;
specpdl_ref count = SPECPDL_INDEX ();
USE_SAFE_ALLOCA;
char **new_argv;
/* File to use for stderr in the child.
t means use same as standard output. */
Lisp_Object error_file;
Lisp_Object output_file = Qnil;
#ifdef MSDOS /* Demacs 1.1.1 91/10/16 HIRANO Satoshi */
char *tempfile = NULL;
#else
sigset_t oldset;
pid_t pid = -1;
#endif
int child_errno;
int fd_output, fd_error;
struct coding_system process_coding; /* coding-system of process output */
struct coding_system argument_coding; /* coding-system of arguments */
/* Set to the return value of Ffind_operation_coding_system. */
Lisp_Object coding_systems;
bool discard_output;
if (synch_process_pid)
error ("call-process invoked recursively");
/* Qt denotes that Ffind_operation_coding_system is not yet called. */
coding_systems = Qt;
CHECK_STRING (args[0]);
error_file = Qt;
#ifndef subprocesses
/* Without asynchronous processes we cannot have BUFFER == 0. */
if (nargs >= 3
&& (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */
/* Decide the coding-system for giving arguments. */
{
Lisp_Object val, *args2;
/* If arguments are supplied, we may have to encode them. */
if (nargs >= 5)
{
bool must_encode = 0;
Lisp_Object coding_attrs;
for (i = 4; i < nargs; i++)
CHECK_STRING (args[i]);
for (i = 4; i < nargs; i++)
if (STRING_MULTIBYTE (args[i]))
must_encode = 1;
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (! must_encode)
val = Qraw_text;
else
{
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process;
for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
}
val = complement_process_encoding_system (val);
setup_coding_system (Fcheck_coding_system (val), &argument_coding);
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);
}
}
}
if (nargs < 3)
buffer = Qnil;
else
{
buffer = args[2];
/* 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. */
if (CONSP (buffer) && !EQ (XCAR (buffer), QCfile))
{
if (CONSP (XCDR (buffer)))
{
Lisp_Object stderr_file;
stderr_file = XCAR (XCDR (buffer));
if (NILP (stderr_file) || EQ (Qt, stderr_file))
error_file = stderr_file;
else
error_file = Fexpand_file_name (stderr_file, Qnil);
}
buffer = XCAR (buffer);
}
/* If the buffer is (still) a list, it might be a (:file "file") spec. */
if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
{
Lisp_Object ofile = XCDR (buffer);
if (CONSP (ofile))
ofile = XCAR (ofile);
CHECK_STRING (ofile);
output_file = Fexpand_file_name (ofile,
BVAR (current_buffer, directory));
CHECK_STRING (output_file);
buffer = Qnil;
}
if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
{
Lisp_Object spec_buffer = buffer;
buffer = Fget_buffer_create (buffer, Qnil);
/* Mention the buffer name for a better error message. */
if (NILP (buffer))
CHECK_BUFFER (spec_buffer);
CHECK_BUFFER (buffer);
}
}
/* 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. */
current_dir = get_current_directory (true);
if (STRINGP (error_file))
{
error_file = remove_slash_colon (error_file);
error_file = ENCODE_FILE (error_file);
}
if (STRINGP (output_file))
{
output_file = remove_slash_colon (output_file);
output_file = ENCODE_FILE (output_file);
}
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
for (i = 0; i < CALLPROC_FDS; i++)
callproc_fd[i] = -1;
#ifdef MSDOS
synch_process_tempfile = make_fixnum (0);
#endif
record_unwind_protect_ptr (call_process_kill, callproc_fd);
/* Search for program; barf if not found. */
{
int ok;
ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
make_fixnum (X_OK), false, false);
if (ok < 0)
report_file_error ("Searching for program", args[0]);
}
/* Remove "/:" from PATH. */
path = remove_slash_colon (path);
SAFE_NALLOCA (new_argv, 1, nargs < 4 ? 2 : nargs - 2);
if (nargs > 4)
{
ptrdiff_t i;
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);
discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file));
#ifdef MSDOS
if (! discard_output && ! STRINGP (output_file))
{
char const *tmpdir = egetenv ("TMPDIR");
char const *outf = tmpdir ? tmpdir : "";
tempfile = alloca (strlen (outf) + 20);
strcpy (tempfile, outf);
dostounix_filename (tempfile);
if (*tempfile == '\0' || tempfile[strlen (tempfile) - 1] != '/')
strcat (tempfile, "/");
strcat (tempfile, "emXXXXXX");
mktemp (tempfile);
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)
{
int open_errno = errno;
output_file = DECODE_FILE (output_file);
report_file_errno ("Opening process output file",
output_file, open_errno);
}
}
else
{
int fd[2];
if (emacs_pipe (fd) != 0)
report_file_error ("Creating process pipe", Qnil);
callproc_fd[CALLPROC_PIPEREAD] = fd[0];
fd_output = fd[1];
}
callproc_fd[CALLPROC_STDOUT] = fd_output;
fd_error = fd_output;
if (STRINGP (error_file) || (NILP (error_file) && !discard_output))
{
fd_error = emacs_open ((STRINGP (error_file)
? SSDATA (error_file)
: NULL_DEVICE),
O_WRONLY | O_CREAT | O_TRUNC | O_TEXT,
default_output_mode);
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;
}
char **env = make_environment_block (current_dir);
#ifdef MSDOS /* MW, July 1993 */
status = child_setup (filefd, fd_output, fd_error, new_argv, env,
SSDATA (current_dir));
if (status < 0)
{
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])
{
emacs_close (callproc_fd[i]);
callproc_fd[i] = -1;
}
emacs_close (filefd);
clear_unwind_protect (specpdl_ref_add (count, -1));
if (tempfile)
{
/* Since CRLF is converted to LF within `decode_coding', we
can always open a file with binary mode. */
callproc_fd[CALLPROC_PIPEREAD] = emacs_open (tempfile, O_RDONLY, 0);
if (callproc_fd[CALLPROC_PIPEREAD] < 0)
{
int open_errno = errno;
report_file_errno ("Cannot re-open temporary file",
build_string (tempfile), open_errno);
}
}
#endif /* MSDOS */
/* 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 ());
#ifndef MSDOS
child_signal_init ();
block_input ();
block_child_signal (&oldset);
child_errno
= emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
SSDATA (current_dir), NULL, false, false, &oldset);
eassert ((child_errno == 0) == (0 < pid));
if (pid > 0)
{
synch_process_pid = pid;
if (FIXNUMP (buffer))
{
if (!specpdl_ref_valid_p (tempfile_index))
record_deleted_pid (pid, Qnil);
else
{
eassert (1 < nargs);
record_deleted_pid (pid, args[1]);
clear_unwind_protect (tempfile_index);
}
synch_process_pid = 0;
}
}
unblock_child_signal (&oldset);
unblock_input ();
if (pid < 0)
report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, child_errno);
/* 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 (specpdl_ref_add (count, -1));
#endif /* not MSDOS */
if (FIXNUMP (buffer))
return unbind_to (count, Qnil);
if (BUFFERP (buffer))
Fset_buffer (buffer);
fd0 = callproc_fd[CALLPROC_PIPEREAD];
if (0 <= fd0)
{
Lisp_Object val, *args2;
val = Qnil;
if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else
{
if (EQ (coding_systems, Qt))
{
ptrdiff_t i;
SAFE_NALLOCA (args2, 1, nargs + 1);
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))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
val = XCAR (Vdefault_process_coding_system);
else
val = Qnil;
}
Fcheck_coding_system (val);
/* 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. */
if (NILP (BVAR (current_buffer, enable_multibyte_characters))
&& !NILP (val))
val = raw_text_coding_system (val);
setup_coding_system (val, &process_coding);
process_coding.dst_multibyte
= ! NILP (BVAR (current_buffer, enable_multibyte_characters));
process_coding.src_multibyte = 0;
}
if (0 <= fd0)
{
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;
int nread;
EMACS_INT total_read = 0;
int carryover = 0;
bool display_on_the_fly = display_p;
struct coding_system saved_coding = process_coding;
ptrdiff_t prepared_pos = 0; /* prepare_to_modify_buffer was last
called here. */
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)
{
int this_read = emacs_read_quit (fd0, buf + nread,
bufsize - nread);
if (this_read < 0)
goto give_up;
if (this_read == 0)
{
process_coding.mode |= CODING_MODE_LAST_BLOCK;
break;
}
nread += this_read;
total_read += this_read;
if (display_on_the_fly)
break;
}
/* 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
by the test prepared_pos < PT. The data are inserted
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;
}
/* Now NREAD is the total amount of data in the buffer. */
if (!nread)
;
else if (NILP (BVAR (current_buffer, enable_multibyte_characters))
&& ! CODING_MAY_REQUIRE_DECODING (&process_coding))
{
insert_1_both (buf, nread, nread, 0, 0, 0);
signal_after_change (PT - nread, 0, nread);
}
else
{ /* We have to decode the input. */
Lisp_Object curbuf;
specpdl_ref 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);
display_on_the_fly = false;
process_coding = saved_coding;
carryover = nread;
/* Make the above condition always fail 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);
signal_after_change (PT - process_coding.produced_char,
0, process_coding.produced_char);
carryover = process_coding.carryover_bytes;
if (carryover > 0)
memcpy (buf, process_coding.carryover,
process_coding.carryover_bytes);
}
if (process_coding.mode & CODING_MODE_LAST_BLOCK)
break;
/* 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;
if (display_p)
{
redisplay_preserve_echo_area (1);
/* This variable might have been set to 0 for code
detection. In that case, set it back to 1 because
we should have already detected a coding system. */
display_on_the_fly = true;
}
}
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"),
make_fixnum (total_read));
}
bool wait_ok = true;
#ifndef MSDOS
/* Wait for it to terminate, unless it already has. */
wait_ok = wait_for_termination (pid, &status, fd0 < 0);
#endif
/* Don't kill any children that the subprocess may have left behind
when exiting. */
synch_process_pid = 0;
SAFE_FREE_UNBIND_TO (count, Qnil);
if (!wait_ok)
return build_unibyte_string ("internal error");
if (WIFSIGNALED (status))
{
const char *signame;
synchronize_system_messages_locale ();
signame = strsignal (WTERMSIG (status));
if (signame == 0)
signame = "unknown";
return code_convert_string_norecord (build_string (signame),
Vlocale_coding_system, 0);
}
eassert (WIFEXITED (status));
return make_fixnum (WEXITSTATUS (status));
}
/* Create a temporary file suitable for storing the input data of
call-process-region. NARGS and ARGS are the same as for
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. */
static int
create_temp_file (ptrdiff_t nargs, Lisp_Object *args,
Lisp_Object *filename_string_ptr)
{
int fd;
Lisp_Object filename_string;
Lisp_Object val, start, end;
Lisp_Object tmpdir;
if (STRINGP (Vtemporary_file_directory))
tmpdir = Vtemporary_file_directory;
else
{
char *outf;
#ifndef DOS_NT
outf = getenv ("TMPDIR");
tmpdir = build_string (outf ? outf : "/tmp/");
#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"));
#endif
}
{
Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir);
char *tempfile;
#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
filename_string = Fcopy_sequence (ENCODE_FILE (pattern));
tempfile = SSDATA (filename_string);
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect_nothing ();
fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC);
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);
}
start = args[0];
end = args[1];
/* Decide coding-system of the contents of the temporary file. */
if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
val = Qraw_text;
else
{
Lisp_Object coding_systems;
Lisp_Object *args2;
USE_SAFE_ALLOCA;
SAFE_NALLOCA (args2, 1, nargs + 1);
args2[0] = Qcall_process_region;
memcpy (args2 + 1, args, nargs * sizeof *args);
coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil;
SAFE_FREE ();
}
val = complement_process_encoding_system (val);
{
specpdl_ref count1 = SPECPDL_INDEX ();
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
specbind (Qfile_name_handler_alist, Qnil);
write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
unbind_to (count1, Qnil);
}
if (lseek (fd, 0, SEEK_SET) < 0)
report_file_error ("Setting file position", filename_string);
/* Note that Fcall_process takes care of binding
coding-system-for-read. */
*filename_string_ptr = filename_string;
return fd;
}
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.
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.
The remaining arguments are optional.
Delete the text if fourth arg DELETE is non-nil.
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 FILE is a file name string, means that it should be
written to that file (if the file already exists it is overwritten).
BUFFER can be a string which is the name of a buffer.
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.
Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.
Remaining arguments ARGS are passed to PROGRAM at startup as command-line
arguments.
If PROGRAM is not an absolute file name, `call-process-region' will
look for PROGRAM in `exec-path' (which is a list of directories).
If BUFFER is 0, `call-process-region' returns immediately with value nil.
Otherwise it waits for PROGRAM to terminate
and returns a numeric exit status or a signal description string.
If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object infile, val;
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object start = args[0];
Lisp_Object end = args[1];
bool empty_input;
int fd;
if (STRINGP (start))
empty_input = SCHARS (start) == 0;
else if (NILP (start))
empty_input = BEG == Z;
else
{
validate_region (&args[0], &args[1]);
start = args[0];
end = args[1];
empty_input = XFIXNUM (start) == XFIXNUM (end);
}
if (!empty_input)
fd = create_temp_file (nargs, args, &infile);
else
{
infile = Qnil;
fd = emacs_open (NULL_DEVICE, O_RDONLY, 0);
if (fd < 0)
report_file_error ("Opening null device", Qnil);
record_unwind_protect_int (close_file_unwind, fd);
}
if (nargs > 3 && !NILP (args[3]))
{
if (NILP (start))
{
/* No need to save restrictions since we delete everything
anyway. */
labeled_restrictions_remove_in_current_buffer ();
Fwiden ();
del_range (BEG, Z);
}
else
Fdelete_region (start, end);
}
if (nargs > 3)
{
args += 2;
nargs -= 2;
}
else
{
args[0] = args[2];
nargs = 2;
}
args[1] = infile;
val = call_process (nargs, args, fd,
empty_input ? make_invalid_specpdl_ref () : count);
return unbind_to (count, val);
}
static char **
add_env (char **env, char **new_env, char *string)
{
char **ep;
bool ok = 1;
if (string == NULL)
return new_env;
/* See if this string duplicates any string already in the env.
If so, don't put it in.
When an env var has multiple definitions,
we keep the definition that comes first in process-environment. */
for (ep = env; ok && ep != new_env; ep++)
{
char *p = *ep, *q = string;
while (ok)
{
if (*p && *q != *p)
break;
if (*q == 0)
/* The string is a lone variable name; keep it for now, we
will remove it later. It is a placeholder for a
variable that is not to be included in the environment. */
break;
if (*q == '=')
ok = 0;
p++, q++;
}
}
if (ok)
*new_env++ = string;
return new_env;
}
#ifndef DOS_NT
/* 'exec' failed inside a child running NAME, with error number ERR.
Possibly a vforked child needed to allocate a large vector on the
stack; such a child cannot fall back on malloc because that might
mess up the allocator's data structures in the parent.
Report the error and exit the child. */
static AVOID
exec_failed (char const *name, int err)
{
/* Avoid deadlock if the child's perror writes to a full pipe; the
pipe's reader is the parent, but with vfork the parent can't
run until the child exits. Truncate the diagnostic instead. */
fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK);
errno = err;
emacs_perror (name);
_exit (err == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE);
}
#endif
/* This is the last thing run in a newly forked inferior
either synchronous or asynchronous.
Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
Initialize inferior's priority, pgrp, connected dir and environment.
then exec another program based on new_argv.
CURRENT_DIR is an elisp string giving the path of the current
directory the subprocess should have. Since we can't really signal
a decent error from within the child, this should be verified as an
executable directory by the parent.
On GNUish hosts, either exec or return an error number.
On MS-Windows, either return a pid or return -1 and set errno.
On MS-DOS, either return an exit status or signal an error. */
static CHILD_SETUP_TYPE
child_setup (int in, int out, int err, char **new_argv, char **env,
const char *current_dir)
{
#ifdef MSDOS
char *pwd_var;
char *temp;
ptrdiff_t i;
#endif
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
#else
pid_t pid = getpid ();
#endif /* WINDOWSNT */
/* Note that use of alloca is always safe here. It's obvious for systems
that do not have true vfork or that have true (stack) alloca.
If using vfork and C_ALLOCA (when Emacs used to include
src/alloca.c) it is safe because that changes the superior's
static variables as if the superior had done alloca and will be
cleaned up in the usual way. */
#ifndef DOS_NT
/* We can't signal an Elisp error here; we're in a vfork. Since
the callers check the current directory before forking, this
should only return an error if the directory's permissions
are changed between the check and this chdir, but we should
at least check. */
if (chdir (current_dir) < 0)
_exit (EXIT_CANCELED);
#endif
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
set_process_dir (current_dir);
/* Spawn the child. (See w32proc.c:sys_spawnve). */
cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env);
reset_standard_handles (in, out, err, handles);
return cpid;
#else /* not WINDOWSNT */
#ifndef MSDOS
restore_nofile_limit ();
/* Redirect file descriptors and clear the close-on-exec flag on the
redirected ones. IN, OUT, and ERR are close-on-exec so they
need not be closed explicitly. */
dup2 (in, STDIN_FILENO);
dup2 (out, STDOUT_FILENO);
dup2 (err, STDERR_FILENO);
setpgid (0, 0);
tcsetpgrp (0, pid);
int errnum = emacs_exec_file (new_argv[0], new_argv, env);
exec_failed (new_argv[0], errnum);
#else /* MSDOS */
i = strlen (current_dir);
pwd_var = xmalloc (i + 5);
temp = pwd_var + 4;
memcpy (pwd_var, "PWD=", 4);
stpcpy (temp, current_dir);
if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
{
temp += 2;
i -= 2;
}
/* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
temp[--i] = 0;
pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env);
xfree (pwd_var);
if (pid == -1)
/* An error occurred while trying to run the subprocess. */
report_file_error ("Spawning child process", Qnil);
return pid;
#endif /* MSDOS */
#endif /* not WINDOWSNT */
}
#if USABLE_POSIX_SPAWN
/* Set up ACTIONS and ATTRIBUTES for `posix_spawn'. Return an error
number. */
static int
emacs_posix_spawn_init_actions (posix_spawn_file_actions_t *actions,
int std_in, int std_out, int std_err,
const char *cwd)
{
int error = posix_spawn_file_actions_init (actions);
if (error != 0)
return error;
error = posix_spawn_file_actions_adddup2 (actions, std_in,
STDIN_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions, std_out,
STDOUT_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions,
std_err < 0 ? std_out
: std_err,
STDERR_FILENO);
if (error != 0)
goto out;
/* Haiku appears to have linkable posix_spawn_file_actions_chdir,
but it always fails. So use the _np function instead. */
#if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU
error = posix_spawn_file_actions_addchdir (actions, cwd);
#else
error = posix_spawn_file_actions_addchdir_np (actions, cwd);
#endif
if (error != 0)
goto out;
out:
if (error != 0)
posix_spawn_file_actions_destroy (actions);
return error;
}
static int
emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
const sigset_t *oldset)
{
int error = posix_spawnattr_init (attributes);
if (error != 0)
return error;
error = posix_spawnattr_setflags (attributes,
POSIX_SPAWN_SETSID
| POSIX_SPAWN_SETSIGDEF
| POSIX_SPAWN_SETSIGMASK);
if (error != 0)
goto out;
sigset_t sigdefault;
sigemptyset (&sigdefault);
#ifdef DARWIN_OS
/* Work around a macOS bug, where SIGCHLD is apparently
delivered to a vforked child instead of to its parent. See:
https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
*/
sigaddset (&sigdefault, SIGCHLD);
#endif
sigaddset (&sigdefault, SIGINT);
sigaddset (&sigdefault, SIGQUIT);
#ifdef SIGPROF
sigaddset (&sigdefault, SIGPROF);
#endif
/* Emacs ignores SIGPIPE, but the child should not. */
sigaddset (&sigdefault, SIGPIPE);
/* Likewise for SIGPROF. */
#ifdef SIGPROF
sigaddset (&sigdefault, SIGPROF);
#endif
error = posix_spawnattr_setsigdefault (attributes, &sigdefault);
if (error != 0)
goto out;
/* Stop blocking SIGCHLD in the child. */
error = posix_spawnattr_setsigmask (attributes, oldset);
if (error != 0)
goto out;
out:
if (error != 0)
posix_spawnattr_destroy (attributes);
return error;
}
#endif
/* Start a new asynchronous subprocess. If successful, return zero
and store the process identifier of the new process in *NEWPID.
Use STDIN, STDOUT, and STDERR as standard streams for the new
process. Use ARGV as argument vector for the new process; use
process image file ARGV[0]. Use ENVP for the environment block for
the new process. Use CWD as working directory for the new process.
If PTY is not NULL, it must be a pseudoterminal device. If PTY is
NULL, don't perform any terminal setup. OLDSET must be a pointer
to a signal set initialized by `block_child_signal'. Before
calling this function, call `block_input' and `block_child_signal';
afterwards, call `unblock_input' and `unblock_child_signal'. Be
sure to call `unblock_child_signal' only after registering NEWPID
in a list where `handle_child_signal' can find it! */
int
emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
char **argv, char **envp, const char *cwd,
const char *pty_name, bool pty_in, bool pty_out,
const sigset_t *oldset)
{
#if USABLE_POSIX_SPAWN
/* Prefer the simpler `posix_spawn' if available. `posix_spawn'
doesn't yet support setting up pseudoterminals, so we fall back
to `vfork' if we're supposed to use a pseudoterminal. */
bool use_posix_spawn = pty_name == NULL;
posix_spawn_file_actions_t actions;
posix_spawnattr_t attributes;
if (use_posix_spawn)
{
/* Initialize optional attributes before blocking. */
int error = emacs_posix_spawn_init_actions (&actions, std_in,
std_out, std_err, cwd);
if (error != 0)
return error;
error = emacs_posix_spawn_init_attributes (&attributes, oldset);
if (error != 0)
return error;
}
#endif
int pid;
int vfork_error;
eassert (input_blocked_p ());
#if USABLE_POSIX_SPAWN
if (use_posix_spawn)
{
vfork_error = posix_spawn (&pid, argv[0], &actions, &attributes,
argv, envp);
if (vfork_error != 0)
pid = -1;
int error = posix_spawn_file_actions_destroy (&actions);
if (error != 0)
{
errno = error;
emacs_perror ("posix_spawn_file_actions_destroy");
}
error = posix_spawnattr_destroy (&attributes);
if (error != 0)
{
errno = error;
emacs_perror ("posix_spawnattr_destroy");
}
goto fork_done;
}
#endif
#ifndef WINDOWSNT
/* vfork, and prevent local vars from being clobbered by the vfork. */
pid_t *volatile newpid_volatile = newpid;
const char *volatile cwd_volatile = cwd;
const char *volatile ptyname_volatile = pty_name;
bool volatile ptyin_volatile = pty_in;
bool volatile ptyout_volatile = pty_out;
char **volatile argv_volatile = argv;
int volatile stdin_volatile = std_in;
int volatile stdout_volatile = std_out;
int volatile stderr_volatile = std_err;
char **volatile envp_volatile = envp;
const sigset_t *volatile oldset_volatile = oldset;
#ifdef DARWIN_OS
/* Darwin doesn't let us run setsid after a vfork, so use fork when
necessary. Below, we reset SIGCHLD handling after a vfork, as
apparently macOS can mistakenly deliver SIGCHLD to the child. */
if (pty_in || pty_out)
pid = fork ();
else
pid = VFORK ();
#else
pid = vfork ();
#endif
newpid = newpid_volatile;
cwd = cwd_volatile;
pty_name = ptyname_volatile;
pty_in = ptyin_volatile;
pty_out = ptyout_volatile;
argv = argv_volatile;
std_in = stdin_volatile;
std_out = stdout_volatile;
std_err = stderr_volatile;
envp = envp_volatile;
oldset = oldset_volatile;
if (pid == 0)
#endif /* not WINDOWSNT */
{
/* Make the pty be the controlling terminal of the process. */
#ifdef HAVE_PTYS
dissociate_controlling_tty ();
/* Make the pty's terminal the controlling terminal. */
if (pty_in && std_in >= 0)
{
#ifdef TIOCSCTTY
/* We ignore the return value
because faith@cs.unc.edu says that is necessary on Linux. */
ioctl (std_in, TIOCSCTTY, 0);
#endif
}
#if defined (LDISC1)
if (pty_in && std_in >= 0)
{
struct termios t;
tcgetattr (std_in, &t);
t.c_lflag = LDISC1;
if (tcsetattr (std_in, TCSANOW, &t) < 0)
emacs_perror ("create_process/tcsetattr LDISC1");
}
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
if (pty_in && std_in >= 0)
{
/* Use new line discipline. */
int ldisc = NTTYDISC;
ioctl (std_in, TIOCSETD, &ldisc);
}
#endif
#endif
#if !defined (DONT_REOPEN_PTY)
/*** There is a suggestion that this ought to be a
conditional on TIOCSPGRP, or !defined TIOCSCTTY.
Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
that system does seem to need this code, even though
both TIOCSCTTY is defined. */
/* Now close the pty (if we had it open) and reopen it.
This makes the pty the controlling terminal of the subprocess. */
if (pty_name)
{
/* I wonder if emacs_close (emacs_open (pty, ...))
would work? */
if (pty_in && std_in >= 0)
emacs_close (std_in);
int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
if (pty_in)
std_in = ptyfd;
if (pty_out)
std_out = ptyfd;
if (std_in < 0)
{
emacs_perror (pty_name);
_exit (EXIT_CANCELED);
}
}
#endif /* not DONT_REOPEN_PTY */
#ifdef SETUP_SLAVE_PTY
if (pty_in && std_in >= 0)
{
SETUP_SLAVE_PTY;
}
#endif /* SETUP_SLAVE_PTY */
#endif /* HAVE_PTYS */
#ifdef DARWIN_OS
/* Work around a macOS bug, where SIGCHLD is apparently
delivered to a vforked child instead of to its parent. See:
https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
*/
signal (SIGCHLD, SIG_DFL);
#endif
signal (SIGINT, SIG_DFL);
signal (SIGQUIT, SIG_DFL);
#ifdef SIGPROF
signal (SIGPROF, SIG_DFL);
#endif
/* Emacs ignores SIGPIPE, but the child should not. */
signal (SIGPIPE, SIG_DFL);
/* Likewise for SIGPROF. */
#ifdef SIGPROF
signal (SIGPROF, SIG_DFL);
#endif
#ifdef subprocesses
/* Stop blocking SIGCHLD in the child. */
unblock_child_signal (oldset);
if (pty_out)
child_setup_tty (std_out);
#endif
if (std_err < 0)
std_err = std_out;
#ifdef WINDOWSNT
pid = child_setup (std_in, std_out, std_err, argv, envp, cwd);
#else /* not WINDOWSNT */
child_setup (std_in, std_out, std_err, argv, envp, cwd);
#endif /* not WINDOWSNT */
}
/* Back in the parent process. */
vfork_error = pid < 0 ? errno : 0;
#if USABLE_POSIX_SPAWN
fork_done:
#endif
if (pid < 0)
{
eassert (0 < vfork_error);
return vfork_error;
}
eassert (0 < pid);
*newpid = pid;
return 0;
}
static bool
getenv_internal_1 (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object env)
{
for (; CONSP (env); env = XCDR (env))
{
Lisp_Object entry = XCAR (env);
if (STRINGP (entry)
&& SBYTES (entry) >= varlen
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
&& ! strnicmp (SSDATA (entry), var, varlen)
#else /* not WINDOWSNT */
&& ! memcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
{
if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
{
*value = SSDATA (entry) + (varlen + 1);
*valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
else if (SBYTES (entry) == varlen)
{
/* Lone variable names in Vprocess_environment mean that
variable should be removed from the environment. */
*value = NULL;
return 1;
}
}
}
return 0;
}
static bool
getenv_internal (const char *var, ptrdiff_t varlen, char **value,
ptrdiff_t *valuelen, Lisp_Object frame)
{
/* Try to find VAR in Vprocess_environment first. */
if (getenv_internal_1 (var, varlen, value, valuelen,
Vprocess_environment))
return *value ? 1 : 0;
/* On Windows we make some modifications to Emacs' environment
without recording them in Vprocess_environment. */
#ifdef WINDOWSNT
{
char *tmpval = getenv (var);
if (tmpval)
{
*value = tmpval;
*valuelen = strlen (tmpval);
return 1;
}
}
#endif
/* For DISPLAY try to get the values from the frame or the initial env. */
if (strcmp (var, "DISPLAY") == 0)
{
#ifndef HAVE_PGTK
Lisp_Object display
= Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay);
if (STRINGP (display))
{
*value = SSDATA (display);
*valuelen = SBYTES (display);
return 1;
}
#endif
/* If still not found, Look for DISPLAY in Vinitial_environment. */
if (getenv_internal_1 (var, varlen, value, valuelen,
Vinitial_environment))
return *value ? 1 : 0;
}
return 0;
}
DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
doc: /* Get the value of environment variable VARIABLE.
VARIABLE should be a string. Value is nil if VARIABLE is undefined in
the environment. Otherwise, value is a string.
This function searches `process-environment' for VARIABLE.
If optional parameter ENV is a list, then search this list instead of
`process-environment', and return t when encountering a negative entry
\(an entry for a variable with no value). */)
(Lisp_Object variable, Lisp_Object env)
{
char *value;
ptrdiff_t valuelen;
CHECK_STRING (variable);
if (CONSP (env))
{
if (getenv_internal_1 (SSDATA (variable), SBYTES (variable),
&value, &valuelen, env))
return value ? make_string (value, valuelen) : Qt;
else
return Qnil;
}
else if (getenv_internal (SSDATA (variable), SBYTES (variable),
&value, &valuelen, env))
return make_string (value, valuelen);
else
return Qnil;
}
/* A version of getenv that consults the Lisp environment lists,
easily callable from C. This is usually called from egetenv. */
char *
egetenv_internal (const char *var, ptrdiff_t len)
{
char *value;
ptrdiff_t valuelen;
if (getenv_internal (var, len, &value, &valuelen, Qnil))
return value;
else
return 0;
}
/* Create a new environment block. You can pass the returned pointer
to `execve'. Add unwind protections for all newly-allocated
objects. Don't call any Lisp code or the garbage collector while
the block is active. */
char **
make_environment_block (Lisp_Object current_dir)
{
char **env;
char *pwd_var;
{
char *temp;
ptrdiff_t i;
i = SBYTES (current_dir);
pwd_var = xmalloc (i + 5);
record_unwind_protect_ptr (xfree, pwd_var);
temp = pwd_var + 4;
memcpy (pwd_var, "PWD=", 4);
lispstpcpy (temp, current_dir);
#ifdef DOS_NT
/* Get past the drive letter, so that d:/ is left alone. */
if (i > 2 && IS_DEVICE_SEP (temp[1]) && IS_DIRECTORY_SEP (temp[2]))
{
temp += 2;
i -= 2;
}
#endif /* DOS_NT */
/* Strip trailing slashes for PWD, but leave "/" and "//" alone. */
while (i > 2 && IS_DIRECTORY_SEP (temp[i - 1]))
temp[--i] = 0;
}
/* Set `env' to a vector of the strings in the environment. */
{
register Lisp_Object tem;
register char **new_env;
char **p, **q;
register int new_length;
Lisp_Object display = Qnil;
new_length = 0;
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
{
if (strncmp (SSDATA (XCAR (tem)), "DISPLAY", 7) == 0
&& (SDATA (XCAR (tem)) [7] == '\0'
|| SDATA (XCAR (tem)) [7] == '='))
/* DISPLAY is specified in process-environment. */
display = Qt;
new_length++;
}
/* If not provided yet, use the frame's DISPLAY. */
if (NILP (display))
{
Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay);
#ifdef HAVE_PGTK
/* The only time GDK actually returns correct information is
when it's running under X Windows. DISPLAY shouldn't be
set to a Wayland display either, since that's an X specific
variable. */
if (FRAME_WINDOW_P (SELECTED_FRAME ())
&& strcmp (G_OBJECT_TYPE_NAME (FRAME_X_DISPLAY (SELECTED_FRAME ())),
"GdkX11Display"))
tmp = Qnil;
#endif
if (!STRINGP (tmp) && CONSP (Vinitial_environment))
/* If still not found, Look for DISPLAY in Vinitial_environment. */
tmp = Fgetenv_internal (build_string ("DISPLAY"),
Vinitial_environment);
if (STRINGP (tmp))
{
display = tmp;
new_length++;
}
}
/* new_length + 2 to include PWD and terminating 0. */
env = new_env = xnmalloc (new_length + 2, sizeof *env);
record_unwind_protect_ptr (xfree, env);
/* If we have a PWD envvar, pass one down,
but with corrected value. */
if (egetenv ("PWD"))
*new_env++ = pwd_var;
if (STRINGP (display))
{
char *vdata = xmalloc (sizeof "DISPLAY=" + SBYTES (display));
record_unwind_protect_ptr (xfree, vdata);
lispstpcpy (stpcpy (vdata, "DISPLAY="), display);
new_env = add_env (env, new_env, vdata);
}
/* Overrides. */
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
new_env = add_env (env, new_env, SSDATA (XCAR (tem)));
*new_env = 0;
/* Remove variable names without values. */
p = q = env;
while (*p != 0)
{
while (*q != 0 && strchr (*q, '=') == NULL)
q++;
*p = *q++;
if (*p != 0)
p++;
}
}
return env;
}
/* This is run before init_cmdargs. */
void
init_callproc_1 (void)
{
Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0);
Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0);
Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
/* Check the EMACSPATH environment variable, defaulting to the
PATH_EXEC path from epaths.h. */
Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
/* FIXME? For ns, path_exec should go at the front? */
Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
}
/* This is run after init_cmdargs, when Vinstallation_directory is valid. */
void
init_callproc (void)
{
bool data_dir = egetenv ("EMACSDATA") != 0;
char *sh;
Lisp_Object tempdir;
if (!NILP (Vinstallation_directory))
{
/* Add to the path the lib-src subdir of the installation dir. */
Lisp_Object tem;
tem = Fexpand_file_name (build_string ("lib-src"),
Vinstallation_directory);
#ifndef MSDOS
/* MSDOS uses wrapped binaries, so don't do this. */
if (NILP (Fmember (tem, Vexec_path)))
{
/* Running uninstalled, so default to tem rather than PATH_EXEC. */
Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0);
Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
}
Vexec_directory = Ffile_name_as_directory (tem);
#endif /* not MSDOS */
/* Maybe use ../etc as well as ../lib-src. */
if (data_dir == 0)
{
tem = Fexpand_file_name (build_string ("etc"),
Vinstallation_directory);
Vdoc_directory = Ffile_name_as_directory (tem);
}
}
/* Look for the files that should be in etc. We don't use
Vinstallation_directory, because these files are never installed
near the executable, and they are never in the build
directory when that's different from the source directory.
Instead, if these files are not in the nominal place, we try the
source directory. */
if (data_dir == 0)
{
Lisp_Object tem, srcdir;
Lisp_Object lispdir = Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0));
srcdir = Fexpand_file_name (build_string ("../src/"), lispdir);
tem = Fexpand_file_name (build_string ("NEWS"), Vdata_directory);
if (!NILP (Fequal (srcdir, Vinvocation_directory))
|| NILP (Ffile_exists_p (tem)) || !NILP (Vinstallation_directory))
{
Lisp_Object newdir;
newdir = Fexpand_file_name (build_string ("../etc/"), lispdir);
tem = Fexpand_file_name (build_string ("NEWS"), newdir);
if (!NILP (Ffile_exists_p (tem)))
Vdata_directory = newdir;
}
}
if (!will_dump_p ())
{
tempdir = Fdirectory_file_name (Vexec_directory);
if (! file_accessible_directory_p (tempdir))
dir_warning ("arch-dependent data dir", Vexec_directory);
}
tempdir = Fdirectory_file_name (Vdata_directory);
if (! file_accessible_directory_p (tempdir))
dir_warning ("arch-independent data dir", Vdata_directory);
sh = getenv ("SHELL");
Vshell_file_name = build_string (sh ? sh : "/bin/sh");
Lisp_Object gamedir = Qnil;
if (PATH_GAME)
{
const char *cpath_game = PATH_GAME;
#ifdef WINDOWSNT
/* On MS-Windows, PATH_GAME normally starts with a literal
"%emacs_dir%", so it will never work without some tweaking. */
cpath_game = w32_relocate (cpath_game);
#endif
Lisp_Object path_game = build_unibyte_string (cpath_game);
if (file_accessible_directory_p (path_game))
gamedir = path_game;
else if (errno != ENOENT && errno != ENOTDIR
#ifdef DOS_NT
/* DOS/Windows sometimes return EACCES for bad file names */
&& errno != EACCES
#endif
)
dir_warning ("game dir", path_game);
}
Vshared_game_score_directory = gamedir;
}
void
set_initial_environment (void)
{
char **envp;
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
/* Ideally, the `copy' shouldn't be necessary, but it seems it's frequent
to use `delete' and friends on process-environment. */
Vinitial_environment = Fcopy_sequence (Vprocess_environment);
}
void
syms_of_callproc (void)
{
#ifndef DOS_NT
Vtemp_file_name_pattern = build_string ("emacsXXXXXX");
#else /* DOS_NT */
Vtemp_file_name_pattern = build_string ("emXXXXXX");
#endif
staticpro (&Vtemp_file_name_pattern);
#ifdef MSDOS
synch_process_tempfile = make_fixnum (0);
staticpro (&synch_process_tempfile);
#endif
DEFVAR_LISP ("shell-file-name", Vshell_file_name,
doc: /* File name to load inferior shells from.
Initialized from the SHELL environment variable, or to a system-dependent
default if SHELL is unset. See Info node `(elisp)Security Considerations'. */);
DEFVAR_LISP ("exec-path", Vexec_path,
doc: /* List of directories to search programs to run in subprocesses.
Each element is a string (directory name) or nil (try default directory).
By default the last element of this list is `exec-directory'. The
last element is not always used, for example in shell completion
\(`shell-dynamic-complete-command'). */);
DEFVAR_LISP ("exec-suffixes", Vexec_suffixes,
doc: /* List of suffixes to try to find executable file names.
Each element is a string. */);
Vexec_suffixes = Qnil;
DEFVAR_LISP ("exec-directory", Vexec_directory,
doc: /* Directory for executables for Emacs to invoke.
More generally, this includes any architecture-dependent files
that are built and installed from the Emacs distribution. */);
DEFVAR_LISP ("data-directory", Vdata_directory,
doc: /* Directory of machine-independent files that come with GNU Emacs.
These are files intended for Emacs to use while it runs. */);
DEFVAR_LISP ("doc-directory", Vdoc_directory,
doc: /* Directory containing the DOC file that comes with GNU Emacs.
This is usually the same as `data-directory'. */);
DEFVAR_LISP ("configure-info-directory", Vconfigure_info_directory,
doc: /* For internal use by the build procedure only.
This is the name of the directory in which the build procedure installed
Emacs's info files; the default value for `Info-default-directory-list'
includes this. */);
Vconfigure_info_directory = build_string (PATH_INFO);
DEFVAR_LISP ("shared-game-score-directory", Vshared_game_score_directory,
doc: /* Directory of score files for games which come with GNU Emacs.
If this variable is nil, then Emacs is unable to use a shared directory. */);
DEFVAR_LISP ("initial-environment", Vinitial_environment,
doc: /* List of environment variables inherited from the parent process.
Each element should be a string of the form ENVVARNAME=VALUE.
The elements must normally be decoded (using `locale-coding-system') for use. */);
Vinitial_environment = Qnil;
DEFVAR_LISP ("process-environment", Vprocess_environment,
doc: /* List of overridden environment variables for subprocesses to inherit.
Each element should be a string of the form ENVVARNAME=VALUE.
Entries in this list take precedence to those in the frame-local
environments. Therefore, let-binding `process-environment' is an easy
way to temporarily change the value of an environment variable,
irrespective of where it comes from. To use `process-environment' to
remove an environment variable, include only its name in the list,
without "=VALUE".
This variable is set to nil when Emacs starts.
If multiple entries define the same variable, the first one always
takes precedence.
Non-ASCII characters are encoded according to the initial value of
`locale-coding-system', i.e. the elements must normally be decoded for
use.
See `setenv' and `getenv'. */);
Vprocess_environment = Qnil;
defsubr (&Scall_process);
defsubr (&Sgetenv_internal);
defsubr (&Scall_process_region);
}