/* Asynchronous subprocess control for GNU Emacs.
-Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2013 Free Software
-Foundation, Inc.
+Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2014
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
-#define PROCESS_INLINE EXTERN_INLINE
-
#include <stdio.h>
#include <errno.h>
#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
#endif
#ifdef HAVE_RES_INIT
-#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>
#endif
#include <c-ctype.h>
#include <sig2str.h>
+#include <verify.h>
#endif /* subprocesses */
#endif
#ifdef WINDOWSNT
-extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- EMACS_TIME *, void *);
+extern int sys_select (int, fd_set *, fd_set *, fd_set *,
+ struct timespec *, void *);
#endif
/* Work around GCC 4.7.0 bug with strict overflow checking; see
#ifdef subprocesses
+#ifndef SOCK_CLOEXEC
+# define SOCK_CLOEXEC 0
+#endif
+
+#ifndef HAVE_ACCEPT4
+
+/* Emulate GNU/Linux accept4 and socket well enough for this module. */
+
+static int
+close_on_exec (int fd)
+{
+ if (0 <= fd)
+ fcntl (fd, F_SETFD, FD_CLOEXEC);
+ return fd;
+}
+
+static int
+accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
+{
+ return close_on_exec (accept (sockfd, addr, addrlen));
+}
+
+static int
+process_socket (int domain, int type, int protocol)
+{
+ return close_on_exec (socket (domain, type, protocol));
+}
+# undef socket
+# define socket(domain, type, protocol) process_socket (domain, type, protocol)
+#endif
+
Lisp_Object Qprocessp;
static Lisp_Object Qrun, Qstop, Qsignal;
static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
#endif
#ifdef ADAPTIVE_READ_BUFFERING
-#define READ_OUTPUT_DELAY_INCREMENT (EMACS_TIME_RESOLUTION / 100)
+#define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
static void create_process (Lisp_Object, char **, Lisp_Object);
#ifdef USABLE_SIGIO
-static bool keyboard_bit_set (SELECT_TYPE *);
+static bool keyboard_bit_set (fd_set *);
#endif
static void deactivate_process (Lisp_Object);
static void status_notify (struct Lisp_Process *);
/* Mask of bits indicating the descriptors that we wait for input on. */
-static SELECT_TYPE input_wait_mask;
+static fd_set input_wait_mask;
/* Mask that excludes keyboard input descriptor(s). */
-static SELECT_TYPE non_keyboard_wait_mask;
+static fd_set non_keyboard_wait_mask;
/* Mask that excludes process input descriptor(s). */
-static SELECT_TYPE non_process_wait_mask;
+static fd_set non_process_wait_mask;
/* Mask for selecting for write. */
-static SELECT_TYPE write_mask;
+static fd_set write_mask;
#ifdef NON_BLOCKING_CONNECT
/* Mask of bits indicating the descriptors that we wait for connect to
complete on. Once they complete, they are removed from this mask
and added to the input_wait_mask and non_keyboard_wait_mask. */
-static SELECT_TYPE connect_wait_mask;
+static fd_set connect_wait_mask;
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
#endif /* NON_BLOCKING_CONNECT */
-/* The largest descriptor currently in use for a process object. */
+/* The largest descriptor currently in use for a process object; -1 if none. */
static int max_process_desc;
-/* The largest descriptor currently in use for input. */
+/* The largest descriptor currently in use for input; -1 if none. */
static int max_input_desc;
/* Indexed by descriptor, gives the process (if any) for that descriptor */
-static Lisp_Object chan_process[MAXDESC];
+static Lisp_Object chan_process[FD_SETSIZE];
/* Alist of elements (NAME . PROCESS) */
static Lisp_Object Vprocess_alist;
output from the process is to read at least one char.
Always -1 on systems that support FIONREAD. */
-static int proc_buffered_char[MAXDESC];
+static int proc_buffered_char[FD_SETSIZE];
/* Table of `struct coding-system' for each process. */
-static struct coding_system *proc_decode_coding_system[MAXDESC];
-static struct coding_system *proc_encode_coding_system[MAXDESC];
+static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
+static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
#ifdef DATAGRAM_SOCKETS
/* Table of `partner address' for datagram sockets. */
static struct sockaddr_and_len {
struct sockaddr *sa;
int len;
-} datagram_address[MAXDESC];
+} datagram_address[FD_SETSIZE];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
-#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
+#define DATAGRAM_CONN_P(proc) \
+ (PROCESSP (proc) && \
+ XPROCESS (proc)->infd >= 0 && \
+ datagram_address[XPROCESS (proc)->infd].sa != 0)
#else
#define DATAGRAM_CHAN_P(chan) (0)
#define DATAGRAM_CONN_P(proc) (0)
#endif
+/* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
+ a `for' loop which iterates over processes from Vprocess_alist. */
+
+#define FOR_EACH_PROCESS(list_var, proc_var) \
+ FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
+
/* These setters are used only in this file, so they can be private. */
static void
pset_buffer (struct Lisp_Process *p, Lisp_Object val)
#define FOR_READ 1
#define FOR_WRITE 2
int condition; /* mask of the defines above. */
-} fd_callback_info[MAXDESC];
+} fd_callback_info[FD_SETSIZE];
/* Add a file descriptor FD to be monitored for when read is possible.
void
add_read_fd (int fd, fd_callback func, void *data)
{
- eassert (fd < MAXDESC);
+ eassert (fd < FD_SETSIZE);
add_keyboard_wait_descriptor (fd);
fd_callback_info[fd].func = func;
void
delete_read_fd (int fd)
{
- eassert (fd < MAXDESC);
+ eassert (fd < FD_SETSIZE);
delete_keyboard_wait_descriptor (fd);
fd_callback_info[fd].condition &= ~FOR_READ;
void
add_write_fd (int fd, fd_callback func, void *data)
{
- eassert (fd < MAXDESC);
+ eassert (fd < FD_SETSIZE);
FD_SET (fd, &write_mask);
if (fd > max_input_desc)
max_input_desc = fd;
fd_callback_info[fd].condition |= FOR_WRITE;
}
+/* FD is no longer an input descriptor; update max_input_desc accordingly. */
+
+static void
+delete_input_desc (int fd)
+{
+ if (fd == max_input_desc)
+ {
+ do
+ fd--;
+ while (0 <= fd && ! (FD_ISSET (fd, &input_wait_mask)
+ || FD_ISSET (fd, &write_mask)));
+
+ max_input_desc = fd;
+ }
+}
+
/* Stop monitoring file descriptor FD for when write is possible. */
void
delete_write_fd (int fd)
{
- int lim = max_input_desc;
-
- eassert (fd < MAXDESC);
+ eassert (fd < FD_SETSIZE);
FD_CLR (fd, &write_mask);
fd_callback_info[fd].condition &= ~FOR_WRITE;
if (fd_callback_info[fd].condition == 0)
{
fd_callback_info[fd].func = 0;
fd_callback_info[fd].data = 0;
-
- if (fd == max_input_desc)
- for (fd = lim; fd >= 0; fd--)
- if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
- {
- max_input_desc = fd;
- break;
- }
-
+ delete_input_desc (fd);
}
}
return Fcopy_sequence (Fsymbol_name (symbol));
}
\f
-#ifdef HAVE_PTYS
-
-/* The file name of the pty opened by allocate_pty. */
-static char pty_name[24];
+enum { PTY_NAME_SIZE = 24 };
/* Open an available pty, returning a file descriptor.
- Return -1 on failure.
- The file name of the terminal corresponding to the pty
- is left in the variable pty_name. */
+ Store into PTY_NAME the file name of the terminal corresponding to the pty.
+ Return -1 on failure. */
static int
-allocate_pty (void)
+allocate_pty (char pty_name[PTY_NAME_SIZE])
{
+#ifdef HAVE_PTYS
int fd;
#ifdef PTY_ITERATION
if (fd >= 0)
{
+#ifdef PTY_OPEN
+ /* Set FD's close-on-exec flag. This is needed even if
+ PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
+ doesn't require support for that combination.
+ Multithreaded platforms where posix_openpt ignores
+ O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
+ have a race condition between the PTY_OPEN and here. */
+ fcntl (fd, F_SETFD, FD_CLOEXEC);
+#endif
/* check to make certain that both sides are available
this avoids a nasty yet stupid bug in rlogins */
#ifdef PTY_TTY_NAME_SPRINTF
return fd;
}
}
+#endif /* HAVE_PTYS */
return -1;
}
-#endif /* HAVE_PTYS */
\f
static Lisp_Object
make_process (Lisp_Object name)
non-Lisp data, so do it only for slots which should not be zero. */
p->infd = -1;
p->outfd = -1;
+ for (i = 0; i < PROCESS_OPEN_FDS; i++)
+ p->open_fd[i] = -1;
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
else
obj = name;
- /* Now obj should be either a buffer object or a process object.
- */
+ /* Now obj should be either a buffer object or a process object. */
if (BUFFERP (obj))
{
+ if (NILP (BVAR (XBUFFER (obj), name)))
+ error ("Attempt to get process for a dead buffer");
proc = Fget_buffer_process (obj);
if (NILP (proc))
- error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
+ error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
}
else
{
treated by the SIGCHLD handler and waitpid has been invoked on them;
otherwise they might fill up the kernel's process table.
- Some processes created by call-process are also put onto this list. */
+ Some processes created by call-process are also put onto this list.
+
+ Members of this list are (process-ID . filename) pairs. The
+ process-ID is a number; the filename, if a string, is a file that
+ needs to be removed after the process exits. */
static Lisp_Object deleted_pid_list;
void
-record_deleted_pid (pid_t pid)
+record_deleted_pid (pid_t pid, Lisp_Object filename)
{
- deleted_pid_list = Fcons (make_fixnum_or_float (pid),
+ deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
/* GC treated elements set to nil. */
Fdelq (Qnil, deleted_pid_list));
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
- pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil)));
+ pset_status (p, list2 (Qexit, make_number (0)));
p->tick = ++process_tick;
status_notify (p);
redisplay_preserve_echo_area (13);
else
{
if (p->alive)
- record_kill_process (p);
+ record_kill_process (p, Qnil);
if (p->infd >= 0)
{
DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1, 1, 0,
doc: /* Return the buffer PROCESS is associated with.
-Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
+The default process filter inserts output from PROCESS into this buffer. */)
(register Lisp_Object process)
{
CHECK_PROCESS (process);
The filter gets two arguments: the process and the string of output.
The string argument is normally a multibyte string, except:
-- if the process' input coding system is no-conversion or raw-text,
+- if the process's input coding system is no-conversion or raw-text,
it is a unibyte string (the non-converted input), or else
- if `default-enable-multibyte-characters' is nil, it is a unibyte
string (the result of converting the decoded input multibyte
CHECK_PROCESS (process);
p = XPROCESS (process);
- /* Don't signal an error if the process' input file descriptor
+ /* Don't signal an error if the process's input file descriptor
is closed. This could make debugging Lisp more difficult,
for example when doing something like
DEFUN ("set-process-window-size", Fset_process_window_size,
Sset_process_window_size, 3, 3, 0,
doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
- (register Lisp_Object process, Lisp_Object height, Lisp_Object width)
+ (Lisp_Object process, Lisp_Object height, Lisp_Object width)
{
CHECK_PROCESS (process);
- CHECK_RANGED_INTEGER (height, 0, INT_MAX);
- CHECK_RANGED_INTEGER (width, 0, INT_MAX);
+
+ /* All known platforms store window sizes as 'unsigned short'. */
+ CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
+ CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
if (XPROCESS (process)->infd < 0
- || set_window_size (XPROCESS (process)->infd,
- XINT (height), XINT (width)) <= 0)
+ || (set_window_size (XPROCESS (process)->infd,
+ XINT (height), XINT (width))
+ < 0))
return Qnil;
else
return Qt;
if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
return contact;
if (NILP (key) && NETCONN_P (process))
- return Fcons (Fplist_get (contact, QChost),
- Fcons (Fplist_get (contact, QCservice), Qnil));
+ return list2 (Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
if (NILP (key) && SERIALCONN_P (process))
- return Fcons (Fplist_get (contact, QCport),
- Fcons (Fplist_get (contact, QCspeed), Qnil));
+ return list2 (Fplist_get (contact, QCport),
+ Fplist_get (contact, QCspeed));
return Fplist_get (contact, key);
}
}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
- doc: /* Return a list of all processes. */)
+ doc: /* Return a list of all processes that are Emacs sub-processes. */)
(void)
{
return Fmapcar (Qcdr, Vprocess_alist);
\f
/* Starting asynchronous inferior processes. */
-static Lisp_Object start_process_unwind (Lisp_Object proc);
+static void start_process_unwind (Lisp_Object proc);
DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for it.
function. The argument list is protected by the caller, so all
we really have to worry about is buffer. */
{
- struct gcpro gcpro1, gcpro2;
-
- current_dir = BVAR (current_buffer, directory);
-
- GCPRO2 (buffer, current_dir);
-
- current_dir = Funhandled_file_name_directory (current_dir);
- if (NILP (current_dir))
- /* If the file name handler says that current_dir is unreachable, use
- a sensible default. */
- current_dir = build_string ("~/");
- current_dir = expand_and_dir_to_file (current_dir, Qnil);
- if (NILP (Ffile_accessible_directory_p (current_dir)))
- report_file_error ("Setting current directory",
- Fcons (BVAR (current_buffer, directory), Qnil));
-
+ struct gcpro gcpro1;
+ GCPRO1 (buffer);
+ current_dir = encode_current_directory ();
UNGCPRO;
}
tem = Qnil;
GCPRO4 (name, program, buffer, current_dir);
- openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
+ openp (Vexec_path, program, Vexec_suffixes, &tem,
+ make_number (X_OK), false);
UNGCPRO;
if (NILP (tem))
- report_file_error ("Searching for program", Fcons (program, Qnil));
+ report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
}
else
/* Encode the file name and put it in NEW_ARGV.
That's where the child will use it to execute the program. */
- tem = Fcons (ENCODE_FILE (tem), Qnil);
+ tem = list1 (ENCODE_FILE (tem));
/* Here we encode arguments by the coding system used for sending
data to the process. We don't support using different coding
PROC doesn't have its pid set, then we know someone has signaled
an error and the process wasn't started successfully, so we should
remove it from the process list. */
-static Lisp_Object
+static void
start_process_unwind (Lisp_Object proc)
{
if (!PROCESSP (proc))
-2 is used for a pty with no process, eg for gdb. */
if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
remove_process (proc);
-
- return Qnil;
}
+/* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
+
static void
-create_process_1 (struct atimer *timer)
+close_process_fd (int *fd_addr)
{
- /* Nothing to do. */
+ int fd = *fd_addr;
+ if (0 <= fd)
+ {
+ *fd_addr = -1;
+ emacs_close (fd);
+ }
}
+/* Indexes of file descriptors in open_fds. */
+enum
+ {
+ /* The pipe from Emacs to its subprocess. */
+ SUBPROCESS_STDIN,
+ WRITE_TO_SUBPROCESS,
+
+ /* The main pipe from the subprocess to Emacs. */
+ READ_FROM_SUBPROCESS,
+ SUBPROCESS_STDOUT,
+
+ /* The pipe from the subprocess to Emacs that is closed when the
+ subprocess execs. */
+ READ_FROM_EXEC_MONITOR,
+ EXEC_MONITOR_OUTPUT
+ };
+
+verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
static void
create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
{
+ struct Lisp_Process *p = XPROCESS (process);
int inchannel, outchannel;
pid_t pid;
- int sv[2];
-#ifndef WINDOWSNT
- int wait_child_setup[2];
-#endif
+ int vfork_errno;
int forkin, forkout;
bool pty_flag = 0;
+ char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
- Lisp_Object encoded_current_dir;
+ sigset_t oldset;
inchannel = outchannel = -1;
-#ifdef HAVE_PTYS
if (!NILP (Vprocess_connection_type))
- outchannel = inchannel = allocate_pty ();
+ outchannel = inchannel = allocate_pty (pty_name);
if (inchannel >= 0)
{
+ p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
if (forkin < 0)
report_file_error ("Opening pty", Qnil);
+ p->open_fd[SUBPROCESS_STDIN] = forkin;
#else
forkin = forkout = -1;
#endif /* not USG, or USG_SUBTTY_WORKS */
lisp_pty_name = build_string (pty_name);
}
else
-#endif /* HAVE_PTYS */
{
- int tem;
- tem = pipe (sv);
- if (tem < 0)
+ if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
+ || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
report_file_error ("Creating pipe", Qnil);
- inchannel = sv[0];
- forkout = sv[1];
- tem = pipe (sv);
- if (tem < 0)
- {
- emacs_close (inchannel);
- emacs_close (forkout);
- report_file_error ("Creating pipe", Qnil);
- }
- outchannel = sv[1];
- forkin = sv[0];
+ forkin = p->open_fd[SUBPROCESS_STDIN];
+ outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+ inchannel = p->open_fd[READ_FROM_SUBPROCESS];
+ forkout = p->open_fd[SUBPROCESS_STDOUT];
}
#ifndef WINDOWSNT
- {
- int tem;
-
- tem = pipe (wait_child_setup);
- if (tem < 0)
- report_file_error ("Creating pipe", Qnil);
- tem = fcntl (wait_child_setup[1], F_GETFD, 0);
- if (tem >= 0)
- tem = fcntl (wait_child_setup[1], F_SETFD, tem | FD_CLOEXEC);
- if (tem < 0)
- {
- emacs_close (wait_child_setup[0]);
- emacs_close (wait_child_setup[1]);
- report_file_error ("Setting file descriptor flags", Qnil);
- }
- }
+ if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
+ report_file_error ("Creating pipe", Qnil);
#endif
fcntl (inchannel, F_SETFL, O_NONBLOCK);
fcntl (outchannel, F_SETFL, O_NONBLOCK);
- /* Record this as an active process, with its channels.
- As a result, child_setup will close Emacs's side of the pipes. */
+ /* Record this as an active process, with its channels. */
chan_process[inchannel] = process;
- XPROCESS (process)->infd = inchannel;
- XPROCESS (process)->outfd = outchannel;
+ p->infd = inchannel;
+ p->outfd = outchannel;
/* Previously we recorded the tty descriptor used in the subprocess.
It was only used for getting the foreground tty process, so now
we just reopen the device (see emacs_get_tty_pgrp) as this is
more portable (see USG_SUBTTY_WORKS above). */
- XPROCESS (process)->pty_flag = pty_flag;
- pset_status (XPROCESS (process), Qrun);
+ p->pty_flag = pty_flag;
+ pset_status (p, Qrun);
FD_SET (inchannel, &input_wait_mask);
FD_SET (inchannel, &non_keyboard_wait_mask);
/* This may signal an error. */
setup_process_coding_systems (process);
- encoded_current_dir = ENCODE_FILE (current_dir);
-
block_input ();
- block_child_signal ();
+ block_child_signal (&oldset);
#ifndef WINDOWSNT
/* vfork, and prevent local vars from being clobbered by the vfork. */
{
- Lisp_Object volatile encoded_current_dir_volatile = encoded_current_dir;
+ Lisp_Object volatile current_dir_volatile = current_dir;
Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
- Lisp_Object volatile process_volatile = process;
- bool volatile pty_flag_volatile = pty_flag;
char **volatile new_argv_volatile = new_argv;
int volatile forkin_volatile = forkin;
int volatile forkout_volatile = forkout;
- int volatile wait_child_setup_0_volatile = wait_child_setup[0];
- int volatile wait_child_setup_1_volatile = wait_child_setup[1];
+ struct Lisp_Process *p_volatile = p;
pid = vfork ();
- encoded_current_dir = encoded_current_dir_volatile;
+ current_dir = current_dir_volatile;
lisp_pty_name = lisp_pty_name_volatile;
- process = process_volatile;
- pty_flag = pty_flag_volatile;
new_argv = new_argv_volatile;
forkin = forkin_volatile;
forkout = forkout_volatile;
- wait_child_setup[0] = wait_child_setup_0_volatile;
- wait_child_setup[1] = wait_child_setup_1_volatile;
+ p = p_volatile;
+
+ pty_flag = p->pty_flag;
}
if (pid == 0)
tcgetattr (xforkin, &t);
t.c_lflag = LDISC1;
if (tcsetattr (xforkin, TCSANOW, &t) < 0)
- emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
+ emacs_perror ("create_process/tcsetattr LDISC1");
}
#else
#if defined (NTTYDISC) && defined (TIOCSETD)
if (pty_flag)
{
- /* I wonder if emacs_close (emacs_open (pty_name, ...))
+ /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
would work? */
if (xforkin >= 0)
emacs_close (xforkin);
- xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
+ xforkout = xforkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
if (xforkin < 0)
{
- emacs_write (1, "Couldn't open the pty terminal ", 31);
- emacs_write (1, pty_name, strlen (pty_name));
- emacs_write (1, "\n", 1);
- _exit (1);
+ emacs_perror (SSDATA (lisp_pty_name));
+ _exit (EXIT_CANCELED);
}
}
SETUP_SLAVE_PTY;
}
#endif /* SETUP_SLAVE_PTY */
-#ifdef AIX
- /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
- Now reenable it in the child, so it will die when we want it to. */
- if (pty_flag)
- signal (SIGHUP, SIG_DFL);
-#endif
#endif /* HAVE_PTYS */
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);
/* Stop blocking SIGCHLD in the child. */
- unblock_child_signal ();
+ unblock_child_signal (&oldset);
if (pty_flag)
child_setup_tty (xforkout);
#ifdef WINDOWSNT
- pid = child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
#else /* not WINDOWSNT */
- emacs_close (wait_child_setup[0]);
- child_setup (xforkin, xforkout, xforkout,
- new_argv, 1, encoded_current_dir);
+ child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
}
/* Back in the parent process. */
- XPROCESS (process)->pid = pid;
+ vfork_errno = errno;
+ p->pid = pid;
if (pid >= 0)
- XPROCESS (process)->alive = 1;
+ p->alive = 1;
/* Stop blocking in the parent. */
- unblock_child_signal ();
+ unblock_child_signal (&oldset);
unblock_input ();
if (pid < 0)
- {
- if (forkin >= 0)
- emacs_close (forkin);
- if (forkin != forkout && forkout >= 0)
- emacs_close (forkout);
- }
+ report_file_errno ("Doing vfork", Qnil, vfork_errno);
else
{
/* vfork succeeded. */
+ /* Close the pipe ends that the child uses, or the child's pty. */
+ close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
+ close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
+
#ifdef WINDOWSNT
register_child (pid, inchannel);
#endif /* WINDOWSNT */
- /* If the subfork execv fails, and it exits,
- this close hangs. I don't know why.
- So have an interrupt jar it loose. */
- {
- struct atimer *timer;
- EMACS_TIME offset = make_emacs_time (1, 0);
-
- stop_polling ();
- timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
-
- if (forkin >= 0)
- emacs_close (forkin);
-
- cancel_atimer (timer);
- start_polling ();
- }
-
- if (forkin != forkout && forkout >= 0)
- emacs_close (forkout);
-
- pset_tty_name (XPROCESS (process), lisp_pty_name);
+ pset_tty_name (p, lisp_pty_name);
#ifndef WINDOWSNT
/* Wait for child_setup to complete in case that vfork is
- actually defined as fork. The descriptor wait_child_setup[1]
+ actually defined as fork. The descriptor
+ XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
of a pipe is closed at the child side either by close-on-exec
on successful execve or the _exit call in child_setup. */
{
char dummy;
- emacs_close (wait_child_setup[1]);
- emacs_read (wait_child_setup[0], &dummy, 1);
- emacs_close (wait_child_setup[0]);
+ close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
+ emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
+ close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
}
#endif
}
-
- /* Now generate the error if vfork failed. */
- if (pid < 0)
- report_file_error ("Doing vfork", Qnil);
}
-void
+static void
create_pty (Lisp_Object process)
{
- int inchannel, outchannel;
- bool pty_flag = 0;
-
- inchannel = outchannel = -1;
-
-#ifdef HAVE_PTYS
- if (!NILP (Vprocess_connection_type))
- outchannel = inchannel = allocate_pty ();
+ struct Lisp_Process *p = XPROCESS (process);
+ char pty_name[PTY_NAME_SIZE];
+ int pty_fd = NILP (Vprocess_connection_type) ? -1 : allocate_pty (pty_name);
- if (inchannel >= 0)
+ if (pty_fd >= 0)
{
+ p->open_fd[SUBPROCESS_STDIN] = pty_fd;
#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
/* On most USG systems it does not work to open the pty's tty here,
then close it and reopen it in the child. */
int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
if (forkout < 0)
report_file_error ("Opening pty", Qnil);
+ p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
#if defined (DONT_REOPEN_PTY)
/* In the case that vfork is defined as fork, the parent process
(Emacs) may send some data before the child process completes
child_setup_tty (forkout);
#endif /* DONT_REOPEN_PTY */
#endif /* not USG, or USG_SUBTTY_WORKS */
- pty_flag = 1;
- }
-#endif /* HAVE_PTYS */
- fcntl (inchannel, F_SETFL, O_NONBLOCK);
- fcntl (outchannel, F_SETFL, O_NONBLOCK);
+ fcntl (pty_fd, F_SETFL, O_NONBLOCK);
- /* Record this as an active process, with its channels.
- As a result, child_setup will close Emacs's side of the pipes. */
- chan_process[inchannel] = process;
- XPROCESS (process)->infd = inchannel;
- XPROCESS (process)->outfd = outchannel;
+ /* Record this as an active process, with its channels.
+ As a result, child_setup will close Emacs's side of the pipes. */
+ chan_process[pty_fd] = process;
+ p->infd = pty_fd;
+ p->outfd = pty_fd;
- /* Previously we recorded the tty descriptor used in the subprocess.
- It was only used for getting the foreground tty process, so now
- we just reopen the device (see emacs_get_tty_pgrp) as this is
- more portable (see USG_SUBTTY_WORKS above). */
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
- XPROCESS (process)->pty_flag = pty_flag;
- pset_status (XPROCESS (process), Qrun);
- setup_process_coding_systems (process);
+ p->pty_flag = 1;
+ pset_status (p, Qrun);
+ setup_process_coding_systems (process);
- FD_SET (inchannel, &input_wait_mask);
- FD_SET (inchannel, &non_keyboard_wait_mask);
- if (inchannel > max_process_desc)
- max_process_desc = inchannel;
+ FD_SET (pty_fd, &input_wait_mask);
+ FD_SET (pty_fd, &non_keyboard_wait_mask);
+ if (pty_fd > max_process_desc)
+ max_process_desc = pty_fd;
- XPROCESS (process)->pid = -2;
-#ifdef HAVE_PTYS
- if (pty_flag)
- pset_tty_name (XPROCESS (process), build_string (pty_name));
- else
-#endif
- pset_tty_name (XPROCESS (process), Qnil);
+ pset_tty_name (p, build_string (pty_name));
+ }
+
+ p->pid = -2;
}
\f
/* Convert an internal struct sockaddr to a lisp object (vector or string).
The address family of sa is not included in the result. */
-static Lisp_Object
+#ifndef WINDOWSNT
+static
+#endif
+Lisp_Object
conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
{
Lisp_Object address;
case AF_LOCAL:
{
struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
- for (i = 0; i < sizeof (sockun->sun_path); i++)
- if (sockun->sun_path[i] == 0)
- break;
- return make_unibyte_string (sockun->sun_path, i);
+ ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
+ /* If the first byte is NUL, the name is a Linux abstract
+ socket name, and the name can contain embedded NULs. If
+ it's not, we have a NUL-terminated string. Be careful not
+ to walk past the end of the object looking for the name
+ terminator, however. */
+ if (name_length > 0 && sockun->sun_path[0] != '\0')
+ {
+ const char *terminator
+ = memchr (sockun->sun_path, '\0', name_length);
+
+ if (terminator)
+ name_length = terminator - (const char *) sockun->sun_path;
+ }
+
+ return make_unibyte_string (sockun->sun_path, name_length);
}
#endif
default:
}
if (ret < 0)
- report_file_error ("Cannot set network option",
- Fcons (opt, Fcons (val, Qnil)));
+ {
+ int setsockopt_errno = errno;
+ report_file_errno ("Cannot set network option", list2 (opt, val),
+ setsockopt_errno);
+ }
+
return (1 << sopt->optbit);
}
return Qnil;
}
-/* Used by make-serial-process to recover from errors. */
-static Lisp_Object
-make_serial_process_unwind (Lisp_Object proc)
-{
- if (!PROCESSP (proc))
- emacs_abort ();
- remove_process (proc);
- return Qnil;
-}
-
DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
0, MANY, 0,
doc: /* Create and return a serial port process.
CHECK_STRING (name);
proc = make_process (name);
specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (make_serial_process_unwind, proc);
+ record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
- fd = serial_open (SSDATA (port));
+ fd = serial_open (port);
+ p->open_fd[SUBPROCESS_STDIN] = fd;
p->infd = fd;
p->outfd = fd;
if (fd > max_process_desc)
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
- p->pty_flag = 0;
+ eassert (! p->pty_flag);
if (!EQ (p->command, Qt))
{
is the server process, CLIENT is the new process for the connection,
and MESSAGE is a string.
-:plist PLIST -- Install PLIST as the new process' initial plist.
+:plist PLIST -- Install PLIST as the new process's initial plist.
:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
for the connection with the following parameters:
- The client's process name is constructed by concatenating the server
-process' NAME and a client identification string.
+process's NAME and a client identification string.
- If the FILTER argument is non-nil, the client process will not get a
separate process buffer; otherwise, the client's process buffer is a newly
-created buffer named after the server process' BUFFER name or process
+created buffer named after the server process's BUFFER name or process
NAME concatenated with the client identification string.
- The connection type and the process filter and sentinel parameters are
-inherited from the server process' TYPE, FILTER and SENTINEL.
-- The client process' contact info is set according to the client's
+inherited from the server process's TYPE, FILTER and SENTINEL.
+- The client process's contact info is set according to the client's
addressing information (typically an IP address and a port number).
-- The client process' plist is initialized from the server's plist.
+- The client process's plist is initialized from the server's plist.
Notice that the FILTER and SENTINEL args are never used directly by
the server process. Also, the BUFFER argument is not used directly by
the server process, but via the optional :log function, accepted (and
-failed) connections may be logged in the server process' buffer.
+failed) connections may be logged in the server process's buffer.
The original argument list, modified with the actual connection
information, is available via the `process-contact' function.
#ifdef POLL_FOR_INPUT
if (socktype != SOCK_DGRAM)
{
- record_unwind_protect (unwind_stop_other_atimers, Qnil);
+ record_unwind_protect_void (run_all_atimers);
bind_polling_period (10);
}
#endif
retry_connect:
#endif
- s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
+ s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC,
+ lres->ai_protocol);
if (s < 0)
{
xerrno = errno;
#endif
/* Make us close S if quit. */
- record_unwind_protect (close_file_unwind, make_number (s));
+ record_unwind_protect_int (close_file_unwind, s);
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
wait for completion is pselect(). */
int sc;
socklen_t len;
- SELECT_TYPE fdset;
+ fd_set fdset;
retry_select:
FD_ZERO (&fdset);
FD_SET (s, &fdset);
if (errno == EINTR)
goto retry_select;
else
- report_file_error ("select failed", Qnil);
+ report_file_error ("Failed select", Qnil);
}
eassert (sc > 0);
len = sizeof xerrno;
eassert (FD_ISSET (s, &fdset));
- if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) == -1)
- report_file_error ("getsockopt failed", Qnil);
+ if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
+ report_file_error ("Failed getsockopt", Qnil);
if (xerrno)
- errno = xerrno, report_file_error ("error during connect", Qnil);
- else
- break;
+ report_file_errno ("Failed connect", Qnil, xerrno);
+ break;
}
#endif /* !WINDOWSNT */
}
#endif
- /* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
-
- /* Unwind bind_polling_period and request_sigio. */
- unbind_to (count, Qnil);
-
if (s < 0)
{
/* If non-blocking got this far - and failed - assume non-blocking is
if (is_non_blocking_client)
return Qnil;
- errno = xerrno;
- if (is_server)
- report_file_error ("make server process failed", contact);
- else
- report_file_error ("make client process failed", contact);
+ report_file_errno ((is_server
+ ? "make server process failed"
+ : "make client process failed"),
+ contact, xerrno);
}
inch = s;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
pset_command (p, Qt);
p->pid = 0;
+
+ p->open_fd[SUBPROCESS_STDIN] = inch;
p->infd = inch;
p->outfd = outch;
+
+ /* Discard the unwind protect for closing S, if any. */
+ specpdl_ptr = specpdl + count1;
+
+ /* Unwind bind_polling_period and request_sigio. */
+ unbind_to (count, Qnil);
+
if (is_server && socktype != SOCK_DGRAM)
pset_status (p, Qlisten);
}
\f
-#if defined (HAVE_NET_IF_H)
+#ifdef HAVE_NET_IF_H
#ifdef SIOCGIFCONF
-DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
- doc: /* Return an alist of all network interfaces and their network address.
-Each element is a cons, the car of which is a string containing the
-interface name, and the cdr is the network address in internal
-format; see the description of ADDRESS in `make-network-process'. */)
- (void)
+static Lisp_Object
+network_interface_list (void)
{
struct ifconf ifconf;
struct ifreq *ifreq;
ptrdiff_t buf_size = 512;
int s;
Lisp_Object res;
+ ptrdiff_t count;
- s = socket (AF_INET, SOCK_STREAM, 0);
+ s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
do
{
ifconf.ifc_len = buf_size;
if (ioctl (s, SIOCGIFCONF, &ifconf))
{
- close (s);
+ emacs_close (s);
xfree (buf);
return Qnil;
}
}
while (ifconf.ifc_len == buf_size);
- close (s);
-
- res = Qnil;
+ res = unbind_to (count, Qnil);
ifreq = ifconf.ifc_req;
while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
{
{ 0, 0 }
};
-DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
- doc: /* Return information about network interface named IFNAME.
-The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
-where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
-NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
-FLAGS is the current flags of the interface. */)
- (Lisp_Object ifname)
+static Lisp_Object
+network_interface_info (Lisp_Object ifname)
{
struct ifreq rq;
Lisp_Object res = Qnil;
Lisp_Object elt;
int s;
bool any = 0;
+ ptrdiff_t count;
#if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
&& defined HAVE_GETIFADDRS && defined LLADDR)
struct ifaddrs *ifap;
error ("interface name too long");
strcpy (rq.ifr_name, SSDATA (ifname));
- s = socket (AF_INET, SOCK_STREAM, 0);
+ s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
elt = Qnil;
#if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
any = 1;
for (n = 0; n < 6; n++)
- p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
+ p->contents[n] = make_number (((unsigned char *)
+ &rq.ifr_hwaddr.sa_data[0])
+ [n]);
elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
}
#elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
#endif
res = Fcons (elt, res);
- close (s);
+ return unbind_to (count, any ? res : Qnil);
+}
+#endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
+#endif /* defined (HAVE_NET_IF_H) */
+
+DEFUN ("network-interface-list", Fnetwork_interface_list,
+ Snetwork_interface_list, 0, 0, 0,
+ doc: /* Return an alist of all network interfaces and their network address.
+Each element is a cons, the car of which is a string containing the
+interface name, and the cdr is the network address in internal
+format; see the description of ADDRESS in `make-network-process'.
- return any ? res : Qnil;
+If the information is not available, return nil. */)
+ (void)
+{
+#if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
+ return network_interface_list ();
+#else
+ return Qnil;
+#endif
}
+
+DEFUN ("network-interface-info", Fnetwork_interface_info,
+ Snetwork_interface_info, 1, 1, 0,
+ doc: /* Return information about network interface named IFNAME.
+The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
+where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
+NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
+FLAGS is the current flags of the interface.
+
+Data that is unavailable is returned as nil. */)
+ (Lisp_Object ifname)
+{
+#if ((defined HAVE_NET_IF_H \
+ && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
+ || defined SIOCGIFFLAGS)) \
+ || defined WINDOWSNT)
+ return network_interface_info (ifname);
+#else
+ return Qnil;
#endif
-#endif /* defined (HAVE_NET_IF_H) */
+}
+
/* Turn off input and output for process PROC. */
static void
deactivate_process (Lisp_Object proc)
{
- register int inchannel, outchannel;
- register struct Lisp_Process *p = XPROCESS (proc);
+ int inchannel;
+ struct Lisp_Process *p = XPROCESS (proc);
+ int i;
#ifdef HAVE_GNUTLS
/* Delete GnuTLS structures in PROC, if any. */
emacs_gnutls_deinit (proc);
#endif /* HAVE_GNUTLS */
- inchannel = p->infd;
- outchannel = p->outfd;
-
#ifdef ADAPTIVE_READ_BUFFERING
if (p->read_output_delay > 0)
{
}
#endif
+ /* Beware SIGCHLD hereabouts. */
+
+ for (i = 0; i < PROCESS_OPEN_FDS; i++)
+ close_process_fd (&p->open_fd[i]);
+
+ inchannel = p->infd;
if (inchannel >= 0)
{
- /* Beware SIGCHLD hereabouts. */
- flush_pending_output (inchannel);
- emacs_close (inchannel);
- if (outchannel >= 0 && outchannel != inchannel)
- emacs_close (outchannel);
-
p->infd = -1;
p->outfd = -1;
#ifdef DATAGRAM_SOCKETS
#endif
if (inchannel == max_process_desc)
{
- int i;
/* We just closed the highest-numbered process input descriptor,
so recompute the highest-numbered one now. */
- max_process_desc = 0;
- for (i = 0; i < MAXDESC; i++)
- if (!NILP (chan_process[i]))
- max_process_desc = i;
+ int i = inchannel;
+ do
+ i--;
+ while (0 <= i && NILP (chan_process[i]));
+
+ max_process_desc = i;
}
}
}
DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
0, 4, 0,
doc: /* Allow any pending output from subprocesses to be read by Emacs.
-It is read into the process' buffers or given to their filter functions.
+It is given to their filter functions.
Non-nil arg PROCESS means do not return until some output has been received
from PROCESS.
{
if (XFLOAT_DATA (seconds) > 0)
{
- EMACS_TIME t = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (seconds));
- secs = min (EMACS_SECS (t), WAIT_READING_MAX);
- nsecs = EMACS_NSECS (t);
+ struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
+ secs = min (t.tv_sec, WAIT_READING_MAX);
+ nsecs = t.tv_nsec;
}
}
else
#endif
} saddr;
socklen_t len = sizeof saddr;
+ ptrdiff_t count;
- s = accept (channel, &saddr.sa, &len);
+ s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
if (s < 0)
{
return;
}
+ count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, s);
+
connect_counter++;
/* Setup a new process to handle the connection. */
pset_filter (p, ps->filter);
pset_command (p, Qnil);
p->pid = 0;
+
+ /* Discard the unwind protect for closing S. */
+ specpdl_ptr = specpdl + count;
+
+ p->open_fd[SUBPROCESS_STDIN] = s;
p->infd = s;
p->outfd = s;
pset_status (p, Qrun);
when not inside wait_reading_process_output. */
static int waiting_for_user_input_p;
-static Lisp_Object
-wait_reading_process_output_unwind (Lisp_Object data)
+static void
+wait_reading_process_output_unwind (int data)
{
- waiting_for_user_input_p = XINT (data);
- return Qnil;
+ waiting_for_user_input_p = data;
}
/* This is here so breakpoints can be put on it. */
struct Lisp_Process *wait_proc, int just_wait_proc)
{
int channel, nfds;
- SELECT_TYPE Available;
- SELECT_TYPE Writeok;
+ fd_set Available;
+ fd_set Writeok;
bool check_write;
int check_delay;
bool no_avail;
int xerrno;
Lisp_Object proc;
- EMACS_TIME timeout, end_time;
+ struct timespec timeout, end_time;
int wait_channel = -1;
bool got_some_input = 0;
ptrdiff_t count = SPECPDL_INDEX ();
if (wait_proc != NULL)
wait_channel = wait_proc->infd;
- record_unwind_protect (wait_reading_process_output_unwind,
- make_number (waiting_for_user_input_p));
+ record_unwind_protect_int (wait_reading_process_output_unwind,
+ waiting_for_user_input_p);
waiting_for_user_input_p = read_kbd;
if (time_limit < 0)
compute the absolute time to return at. */
if (time_limit || nsecs > 0)
{
- timeout = make_emacs_time (time_limit, nsecs);
- end_time = add_emacs_time (current_emacs_time (), timeout);
+ timeout = make_timespec (time_limit, nsecs);
+ end_time = timespec_add (current_timespec (), timeout);
}
while (1)
gobble output available now
but don't wait at all. */
- timeout = make_emacs_time (0, 0);
+ timeout = make_timespec (0, 0);
}
else if (time_limit || nsecs > 0)
{
- EMACS_TIME now = current_emacs_time ();
- if (EMACS_TIME_LE (end_time, now))
+ struct timespec now = current_timespec ();
+ if (timespec_cmp (end_time, now) <= 0)
break;
- timeout = sub_emacs_time (end_time, now);
+ timeout = timespec_sub (end_time, now);
}
else
{
- timeout = make_emacs_time (100000, 0);
+ timeout = make_timespec (100000, 0);
}
/* Normally we run timers here.
if (NILP (wait_for_cell)
&& just_wait_proc >= 0)
{
- EMACS_TIME timer_delay;
+ struct timespec timer_delay;
do
{
/* A negative timeout means do not wait at all. */
if (nsecs >= 0)
{
- if (EMACS_TIME_VALID_P (timer_delay))
+ if (timespec_valid_p (timer_delay))
{
- if (EMACS_TIME_LT (timer_delay, timeout))
+ if (timespec_cmp (timer_delay, timeout) < 0)
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
timeout to get our attention. */
if (update_tick != process_tick)
{
- SELECT_TYPE Atemp;
- SELECT_TYPE Ctemp;
+ fd_set Atemp;
+ fd_set Ctemp;
if (kbd_on_hold_p ())
FD_ZERO (&Atemp);
Atemp = input_wait_mask;
Ctemp = write_mask;
- timeout = make_emacs_time (0, 0);
+ timeout = make_timespec (0, 0);
if ((pselect (max (max_process_desc, max_input_desc) + 1,
&Atemp,
#ifdef NON_BLOCKING_CONNECT
Vprocess_adaptive_read_buffering is nil. */
if (process_output_skip && check_delay > 0)
{
- int nsecs = EMACS_NSECS (timeout);
- if (EMACS_SECS (timeout) > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
+ int nsecs = timeout.tv_nsec;
+ if (timeout.tv_sec > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
nsecs = READ_OUTPUT_DELAY_MAX;
for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
{
nsecs = XPROCESS (proc)->read_output_delay;
}
}
- timeout = make_emacs_time (0, nsecs);
+ timeout = make_timespec (0, nsecs);
process_output_skip = 0;
}
#endif
#endif
(max (max_process_desc, max_input_desc) + 1,
&Available,
- (check_write ? &Writeok : (SELECT_TYPE *)0),
+ (check_write ? &Writeok : 0),
NULL, &timeout, NULL);
#ifdef HAVE_GNUTLS
the gnutls library -- 2.12.14 has been confirmed
to need it. See
http://comments.gmane.org/gmane.emacs.devel/145074 */
- for (channel = 0; channel < MAXDESC; ++channel)
+ for (channel = 0; channel < FD_SETSIZE; ++channel)
if (! NILP (chan_process[channel]))
{
struct Lisp_Process *p =
XPROCESS (chan_process[channel]);
- if (p && p->gnutls_p && p->infd
+ if (p && p->gnutls_p && p->gnutls_state && p->infd
&& ((emacs_gnutls_record_check_pending
(p->gnutls_state))
> 0))
{
/* Check this specific channel. */
if (wait_proc->gnutls_p /* Check for valid process. */
+ && wait_proc->gnutls_state
/* Do we have pending data? */
&& ((emacs_gnutls_record_check_pending
(wait_proc->gnutls_state))
if (xerrno == EINTR)
no_avail = 1;
else if (xerrno == EBADF)
- {
-#ifdef AIX
- /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
- the child's closure of the pts gives the parent a SIGHUP, and
- the ptc file descriptor is automatically closed,
- yielding EBADF here or at select() call above.
- So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
- in m/ibmrt-aix.h), and here we just ignore the select error.
- Cleanup occurs c/o status_notify after SIGCHLD. */
- no_avail = 1; /* Cannot depend on values returned */
-#else
- emacs_abort ();
-#endif
- }
+ emacs_abort ();
else
- error ("select error: %s", emacs_strerror (xerrno));
+ report_file_errno ("Failed select", Qnil, xerrno);
}
if (no_avail)
#else
{
struct sockaddr pname;
- int pnamelen = sizeof (pname);
+ socklen_t pnamelen = sizeof (pname);
/* If connection failed, getpeername will fail. */
xerrno = 0;
proc_buffered_char[channel] = -1;
}
#ifdef HAVE_GNUTLS
- if (p->gnutls_p)
+ if (p->gnutls_p && p->gnutls_state)
nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
readmax - buffered);
else
sometimes it's simply wrong to wrap (e.g. when called from
accept-process-output). */
internal_condition_case_1 (read_process_output_call,
- Fcons (outstream,
- Fcons (make_lisp_proc (p),
- Fcons (text, Qnil))),
+ list3 (outstream, make_lisp_proc (p), text),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
Sinternal_default_process_filter, 2, 2, 0,
- doc: /* Function used as default process filter. */)
+ doc: /* Function used as default process filter.
+This inserts the process's output into its buffer, if there is one.
+Otherwise it discards the output. */)
(Lisp_Object proc, Lisp_Object text)
{
struct Lisp_Process *p;
bset_read_only (current_buffer, Qnil);
- /* Insert new output into buffer
- at the current end-of-output marker,
- thus preserving logical ordering of input and output. */
+ /* Insert new output into buffer at the current end-of-output
+ marker, thus preserving logical ordering of input and output. */
if (XMARKER (p->mark)->buffer)
- SET_PT_BOTH (clip_to_bounds (BEGV,
- marker_position (p->mark), ZV),
- clip_to_bounds (BEGV_BYTE,
- marker_byte_position (p->mark),
- ZV_BYTE));
+ set_point_from_marker (p->mark);
else
SET_PT_BOTH (ZV, ZV_BYTE);
before = PT;
else
set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
- update_mode_lines++;
+ update_mode_lines = 23;
/* Make sure opoint and the old restrictions
float ahead of any new text just as point would. */
if (front)
pset_write_queue (p, Fcons (entry, p->write_queue));
else
- pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil)));
+ pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
}
/* Remove the first element in the write_queue of process P, put its
if (rv >= 0)
written = rv;
else if (errno == EMSGSIZE)
- report_file_error ("sending datagram", Fcons (proc, Qnil));
+ report_file_error ("Sending datagram", proc);
}
else
#endif
{
#ifdef HAVE_GNUTLS
- if (p->gnutls_p)
+ if (p->gnutls_p && p->gnutls_state)
written = emacs_gnutls_write (p, cur_buf, cur_len);
else
#endif
- written = emacs_write (outfd, cur_buf, cur_len);
+ written = emacs_write_sig (outfd, cur_buf, cur_len);
rv = (written ? 0 : -1);
#ifdef ADAPTIVE_READ_BUFFERING
if (p->read_output_delay > 0
}
else
/* This is a real error. */
- report_file_error ("writing to process", Fcons (proc, Qnil));
+ report_file_error ("Writing to process", proc);
}
cur_buf += written;
cur_len -= written;
return;
}
- switch (signo)
- {
#ifdef SIGCONT
- case SIGCONT:
+ if (signo == SIGCONT)
+ {
p->raw_status_new = 0;
pset_status (p, Qrun);
p->tick = ++process_tick;
status_notify (NULL);
redisplay_preserve_echo_area (13);
}
- break;
-#endif /* ! defined (SIGCONT) */
- case SIGINT:
- case SIGQUIT:
- case SIGKILL:
- flush_pending_output (p->infd);
- break;
}
+#endif
/* If we don't have process groups, send the signal to the immediate
subprocess. That isn't really right, but it's better than any
(Lisp_Object process)
{
Lisp_Object proc;
- struct coding_system *coding;
+ struct coding_system *coding = NULL;
+ int outfd;
if (DATAGRAM_CONN_P (process))
return process;
proc = get_process (process);
- coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
+ outfd = XPROCESS (proc)->outfd;
+ if (outfd >= 0)
+ coding = proc_encode_coding_system[outfd];
/* Make sure the process is really alive. */
if (XPROCESS (proc)->raw_status_new)
if (! EQ (XPROCESS (proc)->status, Qrun))
error ("Process %s not running", SDATA (XPROCESS (proc)->name));
- if (CODING_REQUIRE_FLUSHING (coding))
+ if (coding && CODING_REQUIRE_FLUSHING (coding))
{
coding->mode |= CODING_MODE_LAST_BLOCK;
send_process (proc, "", 0, Qnil);
{
#ifndef WINDOWSNT
if (tcdrain (XPROCESS (proc)->outfd) != 0)
- error ("tcdrain() failed: %s", emacs_strerror (errno));
+ report_file_error ("Failed tcdrain", Qnil);
#endif /* not WINDOWSNT */
/* Do nothing on Windows because writes are blocking. */
}
else
{
- int old_outfd, new_outfd;
+ struct Lisp_Process *p = XPROCESS (proc);
+ int old_outfd = p->outfd;
+ int new_outfd;
#ifdef HAVE_SHUTDOWN
/* If this is a network connection, or socketpair is used
for communication with the subprocess, call shutdown to cause EOF.
(In some old system, shutdown to socketpair doesn't work.
Then we just can't win.) */
- if (EQ (XPROCESS (proc)->type, Qnetwork)
- || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
- shutdown (XPROCESS (proc)->outfd, 1);
- /* In case of socketpair, outfd == infd, so don't close it. */
- if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
- emacs_close (XPROCESS (proc)->outfd);
-#else /* not HAVE_SHUTDOWN */
- emacs_close (XPROCESS (proc)->outfd);
-#endif /* not HAVE_SHUTDOWN */
+ if (EQ (p->type, Qnetwork)
+ || p->infd == old_outfd)
+ shutdown (old_outfd, 1);
+#endif
+ close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
if (new_outfd < 0)
- emacs_abort ();
- old_outfd = XPROCESS (proc)->outfd;
+ report_file_error ("Opening null device", Qnil);
+ p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
+ p->outfd = new_outfd;
if (!proc_encode_coding_system[new_outfd])
proc_encode_coding_system[new_outfd]
= xmalloc (sizeof (struct coding_system));
- *proc_encode_coding_system[new_outfd]
- = *proc_encode_coding_system[old_outfd];
- memset (proc_encode_coding_system[old_outfd], 0,
- sizeof (struct coding_system));
-
- XPROCESS (proc)->outfd = new_outfd;
+ if (old_outfd >= 0)
+ {
+ *proc_encode_coding_system[new_outfd]
+ = *proc_encode_coding_system[old_outfd];
+ memset (proc_encode_coding_system[old_outfd], 0,
+ sizeof (struct coding_system));
+ }
+ else
+ setup_coding_system (p->encode_coding_system,
+ proc_encode_coding_system[new_outfd]);
}
return process;
}
static void
handle_child_signal (int sig)
{
- Lisp_Object tail;
+ Lisp_Object tail, proc;
/* Find the process that signaled us, and record its status. */
bool all_pids_are_fixnums
= (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
&& TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
- Lisp_Object xpid = XCAR (tail);
+ Lisp_Object head = XCAR (tail);
+ Lisp_Object xpid;
+ if (! CONSP (head))
+ continue;
+ xpid = XCAR (head);
if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
{
pid_t deleted_pid;
else
deleted_pid = XFLOAT_DATA (xpid);
if (child_status_changed (deleted_pid, 0, 0))
- XSETCAR (tail, Qnil);
+ {
+ if (STRINGP (XCDR (head)))
+ unlink (SSDATA (XCDR (head)));
+ XSETCAR (tail, Qnil);
+ }
}
}
/* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_PROCESS (tail, proc)
{
- Lisp_Object proc = XCDR (XCAR (tail));
struct Lisp_Process *p = XPROCESS (proc);
int status;
lib_child_handler (sig);
#ifdef NS_IMPL_GNUSTEP
- /* NSTask in GNUStep sets its child handler each time it is called.
+ /* NSTask in GNUstep sets its child handler each time it is called.
So we must re-set ours. */
catch_child_signal();
#endif
running_asynch_code = 1;
internal_condition_case_1 (read_process_output_call,
- Fcons (sentinel,
- Fcons (proc, Fcons (reason, Qnil))),
+ list3 (sentinel, proc, reason),
!NILP (Vdebug_on_error) ? Qnil : Qerror,
exec_sentinel_error_handler);
that we run, we get called again to handle their status changes. */
update_tick = process_tick;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
+ FOR_EACH_PROCESS (tail, proc)
{
Lisp_Object symbol;
- register struct Lisp_Process *p;
-
- proc = Fcdr (XCAR (tail));
- p = XPROCESS (proc);
+ register struct Lisp_Process *p = XPROCESS (proc);
if (p->tick != p->update_tick)
{
}
} /* end for */
- update_mode_lines++; /* In case buffers use %s in mode-line-format. */
+ update_mode_lines = 24; /* In case buffers use %s in mode-line-format. */
UNGCPRO;
}
DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
Sinternal_default_process_sentinel, 2, 2, 0,
- doc: /* Function used as default sentinel for processes. */)
+ doc: /* Function used as default sentinel for processes.
+This inserts a status message into the process's buffer, if there is one. */)
(Lisp_Object proc, Lisp_Object msg)
{
Lisp_Object buffer, symbol;
#else /* not subprocesses */
/* Defined on msdos.c. */
-extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
- EMACS_TIME *, void *);
+extern int sys_select (int, fd_set *, fd_set *, fd_set *,
+ struct timespec *, void *);
/* Implementation of wait_reading_process_output, assuming that there
are no subprocesses. Used only by the MS-DOS build.
struct Lisp_Process *wait_proc, int just_wait_proc)
{
register int nfds;
- EMACS_TIME end_time, timeout;
+ struct timespec end_time, timeout;
if (time_limit < 0)
{
/* What does time_limit really mean? */
if (time_limit || nsecs > 0)
{
- timeout = make_emacs_time (time_limit, nsecs);
- end_time = add_emacs_time (current_emacs_time (), timeout);
+ timeout = make_timespec (time_limit, nsecs);
+ end_time = timespec_add (current_timespec (), timeout);
}
/* Turn off periodic alarms (in case they are in use)
while (1)
{
bool timeout_reduced_for_timers = 0;
- SELECT_TYPE waitchannels;
+ fd_set waitchannels;
int xerrno;
/* If calling from keyboard input, do not quit
gobble output available now
but don't wait at all. */
- timeout = make_emacs_time (0, 0);
+ timeout = make_timespec (0, 0);
}
else if (time_limit || nsecs > 0)
{
- EMACS_TIME now = current_emacs_time ();
- if (EMACS_TIME_LE (end_time, now))
+ struct timespec now = current_timespec ();
+ if (timespec_cmp (end_time, now) <= 0)
break;
- timeout = sub_emacs_time (end_time, now);
+ timeout = timespec_sub (end_time, now);
}
else
{
- timeout = make_emacs_time (100000, 0);
+ timeout = make_timespec (100000, 0);
}
/* If our caller will not immediately handle keyboard events,
call timer_delay on their own.) */
if (NILP (wait_for_cell))
{
- EMACS_TIME timer_delay;
+ struct timespec timer_delay;
do
{
&& requeued_events_pending_p ())
break;
- if (EMACS_TIME_VALID_P (timer_delay) && nsecs >= 0)
+ if (timespec_valid_p (timer_delay) && nsecs >= 0)
{
- if (EMACS_TIME_LT (timer_delay, timeout))
+ if (timespec_cmp (timer_delay, timeout) < 0)
{
timeout = timer_delay;
timeout_reduced_for_timers = 1;
if (xerrno == EINTR)
FD_ZERO (&waitchannels);
else
- error ("select error: %s", emacs_strerror (xerrno));
+ report_file_errno ("Failed select", Qnil, xerrno);
}
/* Check for keyboard input */
delete_keyboard_wait_descriptor (int desc)
{
#ifdef subprocesses
- int fd;
- int lim = max_input_desc;
-
FD_CLR (desc, &input_wait_mask);
FD_CLR (desc, &non_process_wait_mask);
-
- if (desc == max_input_desc)
- for (fd = 0; fd < lim; fd++)
- if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
- max_input_desc = fd;
+ delete_input_desc (desc);
#endif
}
#endif
}
-/* Close all descriptors currently in use for communication
- with subprocess. This is used in a newly-forked subprocess
- to get rid of irrelevant descriptors. */
-
-void
-close_process_descs (void)
-{
-#ifndef DOS_NT
- int i;
- for (i = 0; i < MAXDESC; i++)
- {
- Lisp_Object process;
- process = chan_process[i];
- if (!NILP (process))
- {
- int in = XPROCESS (process)->infd;
- int out = XPROCESS (process)->outfd;
- if (in >= 0)
- emacs_close (in);
- if (out >= 0 && in != out)
- emacs_close (out);
- }
- }
-#endif
-}
-
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
doc: /* Return the (or a) process associated with BUFFER.
BUFFER may be a buffer or the name of one. */)
buf = Fget_buffer (buffer);
if (NILP (buf)) return Qnil;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = Fcdr (XCAR (tail));
- if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
- return proc;
- }
+ FOR_EACH_PROCESS (tail, proc)
+ if (EQ (XPROCESS (proc)->buffer, buf))
+ return proc;
#endif /* subprocesses */
return Qnil;
}
#ifdef subprocesses
Lisp_Object tail, proc;
- for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
- {
- proc = XCDR (XCAR (tail));
- if (PROCESSP (proc)
- && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
- {
- if (NETCONN_P (proc) || SERIALCONN_P (proc))
- Fdelete_process (proc);
- else if (XPROCESS (proc)->infd >= 0)
- process_send_signal (proc, SIGHUP, Qnil, 1);
- }
- }
+ FOR_EACH_PROCESS (tail, proc)
+ if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
+ {
+ if (NETCONN_P (proc) || SERIALCONN_P (proc))
+ Fdelete_process (proc);
+ else if (XPROCESS (proc)->infd >= 0)
+ process_send_signal (proc, SIGHUP, Qnil, 1);
+ }
#else /* subprocesses */
/* Since we have no subprocesses, this does nothing. */
#endif /* subprocesses */
return system_process_attributes (pid);
}
+#ifdef subprocesses
/* Arrange to catch SIGCHLD if this hasn't already been arranged.
Invoke this after init_process_emacs, and after glib and/or GNUstep
futz with the SIGCHLD handler, but before Emacs forks any children.
catch_child_signal (void)
{
struct sigaction action, old_action;
+ sigset_t oldset;
emacs_sigaction_init (&action, deliver_child_signal);
- block_child_signal ();
+ block_child_signal (&oldset);
sigaction (SIGCHLD, &action, &old_action);
eassert (! (old_action.sa_flags & SA_SIGINFO));
= (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
? dummy_handler
: old_action.sa_handler);
- unblock_child_signal ();
+ unblock_child_signal (&oldset);
}
+#endif /* subprocesses */
\f
/* This is not called "init_process" because that is the name of a
FD_ZERO (&non_keyboard_wait_mask);
FD_ZERO (&non_process_wait_mask);
FD_ZERO (&write_mask);
- max_process_desc = 0;
+ max_process_desc = max_input_desc = -1;
memset (fd_callback_info, 0, sizeof (fd_callback_info));
#ifdef NON_BLOCKING_CONNECT
Vprocess_alist = Qnil;
deleted_pid_list = Qnil;
- for (i = 0; i < MAXDESC; i++)
+ for (i = 0; i < FD_SETSIZE; i++)
{
chan_process[i] = Qnil;
proc_buffered_char[i] = -1;
DEFSYM (Qcutime, "cutime");
DEFSYM (Qcstime, "cstime");
DEFSYM (Qctime, "ctime");
+#ifdef subprocesses
DEFSYM (Qinternal_default_process_sentinel,
"internal-default-process-sentinel");
DEFSYM (Qinternal_default_process_filter,
"internal-default-process-filter");
+#endif
DEFSYM (Qpri, "pri");
DEFSYM (Qnice, "nice");
DEFSYM (Qthcount, "thcount");
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);
-#if defined (HAVE_NET_IF_H)
-#ifdef SIOCGIFCONF
defsubr (&Snetwork_interface_list);
-#endif
-#if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
defsubr (&Snetwork_interface_info);
-#endif
-#endif /* defined (HAVE_NET_IF_H) */
#ifdef DATAGRAM_SOCKETS
defsubr (&Sprocess_datagram_address);
defsubr (&Sset_process_datagram_address);
HCoop / bpt / emacs.git / blobdiff