/* 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. */
struct timespec *, void *);
#endif
+/* Work around GCC 4.7.0 bug with strict overflow checking; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
+ These lines can be removed once the GCC bug is fixed. */
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
+# pragma GCC diagnostic ignored "-Wstrict-overflow"
+#endif
+
+Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
+Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
+Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
+Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
+Lisp_Object QCname, QCtype;
+\f
+/* True if keyboard input is on hold, zero otherwise. */
+
+static bool kbd_is_on_hold;
+
+/* Nonzero means don't run process sentinels. This is used
+ when exiting. */
+bool inhibit_sentinels;
+
+#ifdef subprocesses
+
#ifndef SOCK_CLOEXEC
# define SOCK_CLOEXEC 0
#endif
# define socket(domain, type, protocol) process_socket (domain, type, protocol)
#endif
-/* Work around GCC 4.7.0 bug with strict overflow checking; see
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
- These lines can be removed once the GCC bug is fixed. */
-#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
-# pragma GCC diagnostic ignored "-Wstrict-overflow"
-#endif
-
-Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
-Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
-Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
-Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
-Lisp_Object QCname, QCtype;
-\f
-/* True if keyboard input is on hold, zero otherwise. */
-
-static bool kbd_is_on_hold;
-
-/* Nonzero means don't run process sentinels. This is used
- when exiting. */
-bool inhibit_sentinels;
-
-#ifdef subprocesses
-
Lisp_Object Qprocessp;
static Lisp_Object Qrun, Qstop, Qsignal;
static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
/* Only W32 has this, it really means that select can't take write mask. */
#ifdef BROKEN_NON_BLOCKING_CONNECT
#undef NON_BLOCKING_CONNECT
-#define SELECT_CANT_DO_WRITE_MASK
+enum { SELECT_CAN_DO_WRITE_MASK = false };
#else
+enum { SELECT_CAN_DO_WRITE_MASK = true };
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
static bool keyboard_bit_set (fd_set *);
#endif
static void deactivate_process (Lisp_Object);
-static void status_notify (struct Lisp_Process *);
+static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
static void handle_child_signal (int);
static void create_pty (Lisp_Object);
-/* If we support a window system, turn on the code to poll periodically
- to detect C-g. It isn't actually used when doing interrupt input. */
-#ifdef HAVE_WINDOW_SYSTEM
-#define POLL_FOR_INPUT
-#endif
-
static Lisp_Object get_process (register Lisp_Object name);
static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
int len;
} 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)
void
add_read_fd (int fd, fd_callback func, void *data)
{
- eassert (fd < FD_SETSIZE);
add_keyboard_wait_descriptor (fd);
fd_callback_info[fd].func = func;
void
delete_read_fd (int fd)
{
- 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 < FD_SETSIZE);
FD_SET (fd, &write_mask);
if (fd > max_input_desc)
max_input_desc = fd;
void
delete_write_fd (int fd)
{
- eassert (fd < FD_SETSIZE);
FD_CLR (fd, &write_mask);
fd_callback_info[fd].condition &= ~FOR_WRITE;
if (fd_callback_info[fd].condition == 0)
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
{
{
pset_status (p, list2 (Qexit, make_number (0)));
p->tick = ++process_tick;
- status_notify (p);
+ status_notify (p, NULL);
redisplay_preserve_echo_area (13);
}
else
pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
p->tick = ++process_tick;
- status_notify (p);
+ status_notify (p, NULL);
redisplay_preserve_echo_area (13);
}
}
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
Lisp_Object buffer, name, program, proc, current_dir, tem;
register unsigned char **new_argv;
ptrdiff_t i;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
buffer = args[1];
if (!NILP (buffer))
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", program);
else
create_pty (proc);
- return unbind_to (count, proc);
+ dynwind_end ();
+ return proc;
}
/* This function is the unwind_protect form for Fstart_process. If
bool pty_flag = 0;
char pty_name[PTY_NAME_SIZE];
Lisp_Object lisp_pty_name = Qnil;
+ sigset_t oldset;
inchannel = outchannel = -1;
setup_process_coding_systems (process);
block_input ();
- block_child_signal ();
+ block_child_signal (&oldset);
#ifndef WINDOWSNT
/* vfork, and prevent local vars from being clobbered by the vfork. */
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);
p->alive = 1;
/* Stop blocking in the parent. */
- unblock_child_signal ();
+ unblock_child_signal (&oldset);
unblock_input ();
if (pid < 0)
/* 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
+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:
name = port;
CHECK_STRING (name);
proc = make_process (name);
- specpdl_count = SPECPDL_INDEX ();
- record_unwind_protect (remove_process, proc);
+ dynwind_begin ();
+ record_unwind_protect_1 (remove_process, proc, false);
p = XPROCESS (proc);
fd = serial_open (port);
Fserial_process_configure (nargs, args);
- specpdl_ptr = specpdl + specpdl_count;
+ dynwind_end ();
UNGCPRO;
return proc;
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.
int xerrno = 0;
int s = -1, outch, inch;
struct gcpro gcpro1;
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count1;
- Lisp_Object QCaddress; /* one of QClocal or QCremote */
+ Lisp_Object colon_address; /* Either QClocal or QCremote. */
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
if (nargs == 0)
return Qnil;
+ dynwind_begin ();
+
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
GCPRO1 (contact);
backlog = XINT (tem);
}
- /* Make QCaddress an alias for :local (server) or :remote (client). */
- QCaddress = is_server ? QClocal : QCremote;
+ /* Make colon_address an alias for :local (server) or :remote (client). */
+ colon_address = is_server ? QClocal : QCremote;
/* :nowait BOOL */
if (!is_server && socktype != SOCK_DGRAM
res = &ai;
/* :local ADDRESS or :remote ADDRESS */
- address = Fplist_get (contact, QCaddress);
+ address = Fplist_get (contact, colon_address);
if (!NILP (address))
{
host = service = Qnil;
open_socket:
/* Do this in case we never enter the for-loop below. */
- count1 = SPECPDL_INDEX ();
+ dynwind_begin ();
s = -1;
for (lres = res; lres; lres = lres->ai_next)
#endif
/* Make us close S if quit. */
- record_unwind_protect_int (close_file_unwind, s);
+ record_unwind_protect_int_1 (close_file_unwind, s, false);
/* Parse network options in the arg list.
We simply ignore anything which isn't a known option (including other keywords).
immediate_quit = 0;
- /* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
+ dynwind_end ();
+ dynwind_begin ();
emacs_close (s);
s = -1;
memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
}
#endif
- contact = Fplist_put (contact, QCaddress,
+ contact = Fplist_put (contact, colon_address,
conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
#ifdef HAVE_GETSOCKNAME
if (!is_server)
the normal blocking calls to open-network-stream handles this error
better. */
if (is_non_blocking_client)
+ {
+ dynwind_end ();
+ dynwind_end ();
return Qnil;
+ }
report_file_errno ((is_server
? "make server process failed"
p->infd = inch;
p->outfd = outch;
- /* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
+ dynwind_end ();
/* Unwind bind_polling_period and request_sigio. */
- unbind_to (count, Qnil);
+ dynwind_end ();
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;
void *buf = NULL;
ptrdiff_t buf_size = 512;
int s;
- Lisp_Object res;
+ Lisp_Object res = Qnil;
ptrdiff_t count;
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
- count = SPECPDL_INDEX ();
+ dynwind_begin ();
record_unwind_protect_int (close_file_unwind, s);
do
{
emacs_close (s);
xfree (buf);
+ dynwind_end ();
return Qnil;
}
}
while (ifconf.ifc_len == buf_size);
- res = unbind_to (count, Qnil);
+ dynwind_end ();
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;
s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
if (s < 0)
return Qnil;
- count = SPECPDL_INDEX ();
+ dynwind_begin ();
record_unwind_protect_int (close_file_unwind, s);
elt = Qnil;
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);
- return unbind_to (count, any ? res : Qnil);
+ Lisp_Object tem0 = any ? res : Qnil;
+ dynwind_end ();
+ return tem0;
}
-#endif
+#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'.
+
+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
+}
+
+
/* Turn off input and output for process PROC. */
static void
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.
-Non-nil arg PROCESS means do not return until some output has been received
-from PROCESS.
+It is given to their filter functions.
+Optional argument PROCESS means do not return until output has been
+received from PROCESS.
-Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
-and milliseconds to wait; return after that much time whether or not
-there is any subprocess output. If SECONDS is a floating point number,
+Optional second argument SECONDS and third argument MILLISEC
+specify a timeout; return after that much time even if there is
+no subprocess output. If SECONDS is a floating point number,
it specifies a fractional number of seconds to wait.
The MILLISEC argument is obsolete and should be avoided.
-If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
-from PROCESS, suspending reading output from other processes.
+If optional fourth argument JUST-THIS-ONE is non-nil, accept output
+from PROCESS only, suspending reading output from other processes.
If JUST-THIS-ONE is an integer, don't run any timers either.
-Return non-nil if we received any output before the timeout expired. */)
+Return non-nil if we received any output from PROCESS (or, if PROCESS
+is nil, from any process) before the timeout expired. */)
(register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one)
{
intmax_t secs;
nsecs = 0;
return
- (wait_reading_process_output (secs, nsecs, 0, 0,
+ ((wait_reading_process_output (secs, nsecs, 0, 0,
Qnil,
!NILP (process) ? XPROCESS (process) : NULL,
NILP (just_this_one) ? 0 :
!INTEGERP (just_this_one) ? 1 : -1)
- ? Qt : Qnil);
+ <= 0)
+ ? Qnil : Qt);
}
/* Accept a connection for server process SERVER on CHANNEL. */
return;
}
- count = SPECPDL_INDEX ();
- record_unwind_protect_int (close_file_unwind, s);
+ dynwind_begin ();
+ record_unwind_protect_int_1 (close_file_unwind, s, false);
connect_counter++;
pset_command (p, Qnil);
p->pid = 0;
- /* Discard the unwind protect for closing S. */
- specpdl_ptr = specpdl + count;
+ dynwind_end ();
p->open_fd[SUBPROCESS_STDIN] = s;
p->infd = s;
(and gobble terminal input into the buffer if any arrives).
If WAIT_PROC is specified, wait until something arrives from that
- process. The return value is true if we read some input from
- that process.
+ process.
If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
(suspending output from other processes). A negative value
means don't run any timers either.
- If WAIT_PROC is specified, then the function returns true if we
- received input from that process before the timeout elapsed.
- Otherwise, return true if we received input from any process. */
+ Return positive if we received input from WAIT_PROC (or from any
+ process if WAIT_PROC is null), zero if we attempted to receive
+ input but got none, and negative if we didn't even try. */
-bool
+int
wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
bool do_display,
Lisp_Object wait_for_cell,
int xerrno;
Lisp_Object proc;
struct timespec timeout, end_time;
- int wait_channel = -1;
- bool got_some_input = 0;
- ptrdiff_t count = SPECPDL_INDEX ();
+ int got_some_input = -1;
+ dynwind_begin ();
FD_ZERO (&Available);
FD_ZERO (&Writeok);
&& EQ (XCAR (wait_proc->status), Qexit)))
message1 ("Blocking call to accept-process-output with quit inhibited!!");
- /* If wait_proc is a process to watch, set wait_channel accordingly. */
- if (wait_proc != NULL)
- wait_channel = wait_proc->infd;
-
record_unwind_protect_int (wait_reading_process_output_unwind,
waiting_for_user_input_p);
waiting_for_user_input_p = read_kbd;
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
+ /* After reading input, vacuum up any leftovers without waiting. */
+ if (0 <= got_some_input)
+ nsecs = -1;
+
/* Compute time from now till when time limit is up. */
/* Exit if already run out. */
if (nsecs < 0)
/* It's okay for us to do this and then continue with
the loop, since timeout has already been zeroed out. */
clear_waiting_for_input ();
- status_notify (NULL);
+ got_some_input = status_notify (NULL, wait_proc);
if (do_display) redisplay_preserve_echo_area (13);
}
}
while (wait_proc->infd >= 0)
{
int nread = read_process_output (proc, wait_proc->infd);
-
- if (nread == 0)
- break;
-
- if (nread > 0)
- got_some_input = read_some_bytes = 1;
- else if (nread == -1 && (errno == EIO || errno == EAGAIN))
- break;
+ if (nread < 0)
+ {
+ if (errno == EIO || errno == EAGAIN)
+ break;
#ifdef EWOULDBLOCK
- else if (nread == -1 && EWOULDBLOCK == errno)
- break;
+ if (errno == EWOULDBLOCK)
+ break;
#endif
+ }
+ else
+ {
+ if (got_some_input < nread)
+ got_some_input = nread;
+ if (nread == 0)
+ break;
+ read_some_bytes = true;
+ }
}
if (read_some_bytes && do_display)
redisplay_preserve_echo_area (10);
else
Available = input_wait_mask;
Writeok = write_mask;
-#ifdef SELECT_CANT_DO_WRITE_MASK
- check_write = 0;
-#else
- check_write = 1;
-#endif
- check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
+ check_delay = wait_proc ? 0 : process_output_delay_count;
+ check_write = SELECT_CAN_DO_WRITE_MASK;
}
/* If frame size has changed or the window is newly mapped,
{
nfds = read_kbd ? 0 : 1;
no_avail = 1;
+ FD_ZERO (&Available);
}
if (!no_avail)
/* Set the timeout for adaptive read buffering if any
process has non-zero read_output_skip and non-zero
read_output_delay, and we are not reading output for a
- specific wait_channel. It is not executed if
+ specific process. It is not executed if
Vprocess_adaptive_read_buffering is nil. */
if (process_output_skip && check_delay > 0)
{
#endif
#if defined (HAVE_NS)
- nfds = ns_select
+# define SELECT ns_select
#elif defined (HAVE_GLIB)
- nfds = xg_select
+# define SELECT xg_select
#else
- nfds = pselect
+# define SELECT pselect
#endif
+ nfds = SELECT
(max (max_process_desc, max_input_desc) + 1,
&Available,
(check_write ? &Writeok : 0),
NULL, &timeout, NULL);
+#undef SELECT
#ifdef HAVE_GNUTLS
/* GnuTLS buffers data internally. In lowat mode it leaves
{
struct Lisp_Process *p =
XPROCESS (chan_process[channel]);
- if (p && p->gnutls_p && p->infd
+ if (p && p->gnutls_p && p->gnutls_state
&& ((emacs_gnutls_record_check_pending
(p->gnutls_state))
> 0))
{
nfds++;
+ eassert (p->infd == channel);
FD_SET (p->infd, &Available);
}
}
{
/* 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))
report_file_errno ("Failed select", Qnil, xerrno);
}
- if (no_avail)
- {
- FD_ZERO (&Available);
- check_write = 0;
- }
-
/* Check for keyboard input */
/* If there is any, return immediately
to give it higher priority than subprocesses */
handle_input_available_signal (SIGIO);
#endif
- if (! wait_proc)
- got_some_input |= nfds > 0;
-
/* If checking input just got us a size-change event from X,
obey it now if we should. */
if (read_kbd || ! NILP (wait_for_cell))
/* If waiting for this channel, arrange to return as
soon as no more input to be processed. No more
waiting. */
- if (wait_channel == channel)
- {
- wait_channel = -1;
- nsecs = -1;
- got_some_input = 1;
- }
proc = chan_process[channel];
if (NILP (proc))
continue;
buffered-ahead character if we have one. */
nread = read_process_output (proc, channel);
+ if ((!wait_proc || wait_proc == XPROCESS (proc)) && got_some_input < nread)
+ got_some_input = nread;
if (nread > 0)
{
/* Since read_process_output can run a filter,
#else
{
struct sockaddr pname;
- int pnamelen = sizeof (pname);
+ socklen_t pnamelen = sizeof (pname);
/* If connection failed, getpeername will fail. */
xerrno = 0;
} /* End for each file descriptor. */
} /* End while exit conditions not met. */
- unbind_to (count, Qnil);
+ dynwind_end ();
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
struct coding_system *coding = proc_decode_coding_system[channel];
int carryover = p->decoding_carryover;
int readmax = 4096;
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
Lisp_Object odeactivate;
chars = alloca (carryover + readmax);
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
(including the one in proc_buffered_char[channel]). */
if (nbytes <= 0)
{
- if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
- return nbytes;
+ if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK) {
+ dynwind_end ();
+ return nbytes;
+ }
coding->mode |= CODING_MODE_LAST_BLOCK;
}
/* Handling the process output should not deactivate the mark. */
Vdeactivate_mark = odeactivate;
- unbind_to (count, Qnil);
+ dynwind_end ();
return nbytes;
}
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;
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. */
#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
p->tick = ++process_tick;
if (!nomsg)
{
- status_notify (NULL);
+ status_notify (NULL, NULL);
redisplay_preserve_echo_area (13);
}
}
#endif
+#ifdef TIOCSIGSEND
+ /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
+ We don't know whether the bug is fixed in later HP-UX versions. */
+ if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
+ return;
+#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
obvious alternative. */
- if (no_pgrp)
- {
- kill (p->pid, signo);
- return;
- }
+ pid_t pid = no_pgrp ? gid : - gid;
- /* gid may be a pid, or minus a pgrp's number */
-#ifdef TIOCSIGSEND
- if (!NILP (current_group))
- {
- if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
- kill (-gid, signo);
- }
- else
- {
- gid = - p->pid;
- kill (gid, signo);
- }
-#else /* ! defined (TIOCSIGSEND) */
- kill (-gid, signo);
-#endif /* ! defined (TIOCSIGSEND) */
+ /* Do not kill an already-reaped process, as that could kill an
+ innocent bystander that happens to have the same process ID. */
+ sigset_t oldset;
+ block_child_signal (&oldset);
+ if (p->alive)
+ kill (pid, signo);
+ unblock_child_signal (&oldset);
}
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
(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);
}
else
{
- int old_outfd = XPROCESS (proc)->outfd;
+ struct Lisp_Process *p = XPROCESS (proc);
+ int old_outfd = p->outfd;
int new_outfd;
#ifdef HAVE_SHUTDOWN
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)->infd == old_outfd)
+ if (EQ (p->type, Qnetwork)
+ || p->infd == old_outfd)
shutdown (old_outfd, 1);
#endif
- close_process_fd (&XPROCESS (proc)->open_fd[WRITE_TO_SUBPROCESS]);
+ close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
if (new_outfd < 0)
report_file_error ("Opening null device", Qnil);
- XPROCESS (proc)->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
- XPROCESS (proc)->outfd = new_outfd;
+ 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));
+ 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;
}
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
{
Lisp_Object sentinel, odeactivate;
struct Lisp_Process *p = XPROCESS (proc);
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
- if (inhibit_sentinels)
+ if (inhibit_sentinels) {
+ dynwind_end ();
return;
+ }
/* No need to gcpro these, because all we do with them later
is test them for EQness, and none of them should be a string. */
if (waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
- unbind_to (count, Qnil);
+ dynwind_end ();
}
/* Report all recent events of a change in process status
(either run the sentinel or output a message).
This is usually done while Emacs is waiting for keyboard input
- but can be done at other times. */
+ but can be done at other times.
-static void
-status_notify (struct Lisp_Process *deleting_process)
+ Return positive if any input was received from WAIT_PROC (or from
+ any process if WAIT_PROC is null), zero if input was attempted but
+ none received, and negative if we didn't even try. */
+
+static int
+status_notify (struct Lisp_Process *deleting_process,
+ struct Lisp_Process *wait_proc)
{
- register Lisp_Object proc;
+ Lisp_Object proc;
Lisp_Object tail, msg;
struct gcpro gcpro1, gcpro2;
+ int got_some_input = -1;
tail = Qnil;
msg = Qnil;
/* Network or serial process not stopped: */
&& ! EQ (p->command, Qt)
&& p->infd >= 0
- && p != deleting_process
- && read_process_output (proc, p->infd) > 0);
+ && p != deleting_process)
+ {
+ int nread = read_process_output (proc, p->infd);
+ if (got_some_input < nread)
+ got_some_input = nread;
+ if (nread <= 0)
+ break;
+ }
/* Get the text to use for the message. */
if (p->raw_status_new)
}
} /* 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;
+ return got_some_input;
}
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;
DO_DISPLAY means redisplay should be done to show subprocess
output that arrives.
- Return true if we received input from any process. */
+ Return positive if we received input from WAIT_PROC (or from any
+ process if WAIT_PROC is null), zero if we attempted to receive
+ input but got none, and negative if we didn't even try. */
-bool
+int
wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
bool do_display,
Lisp_Object wait_for_cell,
start_polling ();
- return 0;
+ return -1;
}
#endif /* not 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.
This function's caller should block SIGCHLD. */
-#ifndef NS_IMPL_GNUSTEP
-static
-#endif
void
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
void
syms_of_process (void)
{
+#include "process.x"
+
#ifdef subprocesses
DEFSYM (Qprocessp, "processp");
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");
The variable takes effect when `start-process' is called. */);
Vprocess_adaptive_read_buffering = Qt;
#endif
-
- defsubr (&Sprocessp);
- defsubr (&Sget_process);
- defsubr (&Sdelete_process);
- defsubr (&Sprocess_status);
- defsubr (&Sprocess_exit_status);
- defsubr (&Sprocess_id);
- defsubr (&Sprocess_name);
- defsubr (&Sprocess_tty_name);
- defsubr (&Sprocess_command);
- defsubr (&Sset_process_buffer);
- defsubr (&Sprocess_buffer);
- defsubr (&Sprocess_mark);
- defsubr (&Sset_process_filter);
- defsubr (&Sprocess_filter);
- defsubr (&Sset_process_sentinel);
- defsubr (&Sprocess_sentinel);
- defsubr (&Sset_process_window_size);
- defsubr (&Sset_process_inherit_coding_system_flag);
- defsubr (&Sset_process_query_on_exit_flag);
- defsubr (&Sprocess_query_on_exit_flag);
- defsubr (&Sprocess_contact);
- defsubr (&Sprocess_plist);
- defsubr (&Sset_process_plist);
- defsubr (&Sprocess_list);
- defsubr (&Sstart_process);
- defsubr (&Sserial_process_configure);
- defsubr (&Smake_serial_process);
- 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);
-#endif
- defsubr (&Saccept_process_output);
- defsubr (&Sprocess_send_region);
- defsubr (&Sprocess_send_string);
- defsubr (&Sinterrupt_process);
- defsubr (&Skill_process);
- defsubr (&Squit_process);
- defsubr (&Sstop_process);
- defsubr (&Scontinue_process);
- defsubr (&Sprocess_running_child_p);
- defsubr (&Sprocess_send_eof);
- defsubr (&Ssignal_process);
- defsubr (&Swaiting_for_user_input_p);
- defsubr (&Sprocess_type);
- defsubr (&Sinternal_default_process_sentinel);
- defsubr (&Sinternal_default_process_filter);
- defsubr (&Sset_process_coding_system);
- defsubr (&Sprocess_coding_system);
- defsubr (&Sset_process_filter_multibyte);
- defsubr (&Sprocess_filter_multibyte_p);
-
#endif /* subprocesses */
-
- defsubr (&Sget_buffer_process);
- defsubr (&Sprocess_inherit_coding_system_flag);
- defsubr (&Slist_system_processes);
- defsubr (&Sprocess_attributes);
}
HCoop / bpt / emacs.git / blobdiff