Commit dd2a17ab authored by Kim F. Storm's avatar Kim F. Storm
Browse files

(Qconnect, Qfailed): New variables.

(syms_of_process): Intern and staticpro them.
[NON_BLOCKING_CONNECT]: New conditional.
(connect_wait_mask, num_pending_connects): New variables.
(status_message): Convert Qfailed status.
(Fopen_network_stream): Added support for non-blocking connect.
New optional args: filter, sentinel, non_blocking.  Doc updated.
[HAVE_GETADDRINFO, !HAVE_GETADDRINFO]:  Merged common code.
(deactivate_process): Handle pending non-blocking connect.
(wait_reading_process_input): Poll for status of non-blocking
connects.  Exec sentinel directly when connect succeeds.
(status_notify): Don't read process output if not yet connected.
parent 8bfb170b
/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001
Free Software Foundation, Inc.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
2001, 2002 Free Software Foundation, Inc.
This file is part of GNU Emacs.
......@@ -112,7 +112,8 @@ Boston, MA 02111-1307, USA. */
#include "atimer.h"
Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed;
Lisp_Object Qlast_nonmenu_event;
/* Qexit is declared and initialized in eval.c. */
......@@ -173,6 +174,30 @@ int process_tick;
/* Number of events for which the user or sentinel has been notified. */
int update_tick;
/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
#ifdef BROKEN_NON_BLOCKING_CONNECT
#undef NON_BLOCKING_CONNECT
#else
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SOCKETS
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
#if defined (O_NONBLOCK) || defined (O_NDELAY)
#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
#define NON_BLOCKING_CONNECT
#endif /* EWOULDBLOCK || EINPROGRESS */
#endif /* O_NONBLOCK || O_NDELAY */
#endif /* HAVE_GETPEERNAME || GNU_LINUX */
#endif /* HAVE_SELECT */
#endif /* HAVE_SOCKETS */
#endif /* NON_BLOCKING_CONNECT */
#endif /* BROKEN_NON_BLOCKING_CONNECT */
#ifdef TERM
#undef NON_BLOCKING_CONNECT
#endif
#include "sysselect.h"
extern int keyboard_bit_set P_ ((SELECT_TYPE *));
......@@ -195,6 +220,15 @@ static SELECT_TYPE non_keyboard_wait_mask;
static SELECT_TYPE non_process_wait_mask;
/* 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;
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
/* The largest descriptor currently in use for a process object. */
static int max_process_desc;
......@@ -224,6 +258,7 @@ static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
static Lisp_Object get_process ();
static void exec_sentinel ();
extern EMACS_TIME timer_check ();
extern int timers_run;
......@@ -335,6 +370,13 @@ status_message (status)
return concat2 (build_string ("exited abnormally with code "),
concat2 (string, string2));
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
string2 = build_string ("\n");
return concat2 (build_string ("failed with code "),
concat2 (string, string2));
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
}
......@@ -1741,28 +1783,37 @@ create_process (process, new_argv, current_dir)
deactivate and close it via delete-process */
DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream,
4, 4, 0,
4, 7, 0,
doc: /* Open a TCP connection for a service to a host.
Returns a subprocess-object to represent the connection.
Returns nil if a non-blocking connect is attempted on a system which
cannot support that; in that case, the caller should attempt a
normal connect instead.
Input and output work as for subprocesses; `delete-process' closes it.
Args are NAME BUFFER HOST SERVICE.
Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING.
NAME is name for process. It is modified if necessary to make it unique.
BUFFER is the buffer (or buffer-name) to associate with the process.
Process output goes at end of that buffer, unless you specify
an output stream or filter function to handle the output.
BUFFER may be also nil, meaning that this process is not associated
with any buffer
Third arg is name of the host to connect to, or its IP address.
Fourth arg SERVICE is name of the service desired, or an integer
specifying a port number to connect to. */)
(name, buffer, host, service)
Lisp_Object name, buffer, host, service;
with any buffer.
HOST is name of the host to connect to, or its IP address.
SERVICE is name of the service desired, or an integer specifying a
port number to connect to.
FILTER and SENTINEL are optional args specifying the filter and
sentinel functions associated with the network stream.
NON-BLOCKING is optional arg requesting an non-blocking connect.
When non-nil, open-network-stream will return immediately without
waiting for the connection to be made. Instead, the sentinel function
will be called with second matching "open" (if successful) or
"failed" when the connect completes. */)
(name, buffer, host, service, filter, sentinel, non_blocking)
Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking;
{
Lisp_Object proc;
#ifdef HAVE_GETADDRINFO
struct addrinfo hints, *res, *lres;
int ret = 0;
int xerrno = 0;
char *portstring, portbuf[128];
#else /* HAVE_GETADDRINFO */
struct sockaddr_in address;
......@@ -1771,19 +1822,43 @@ specifying a port number to connect to. */)
char *(addr_list[2]);
IN_ADDR numeric_addr;
int port;
struct _emacs_addrinfo
{
int ai_family;
int ai_socktype;
int ai_protocol;
int ai_addrlen;
struct sockaddr *ai_addr;
struct _emacs_addrinfo *ai_next;
} ai, *res, *lres;
#endif /* HAVE_GETADDRINFO */
int ret = 0;
int xerrno = 0;
int s = -1, outch, inch;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
int retry = 0;
int count = specpdl_ptr - specpdl;
int count1;
int is_non_blocking = 0;
if (!NILP (non_blocking))
{
#ifndef NON_BLOCKING_CONNECT
return Qnil;
#else
non_blocking = Qt; /* Instead of GCPRO */
is_non_blocking = 1;
#endif
}
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
init_winsock (TRUE);
#endif
GCPRO4 (name, buffer, host, service);
/* Can only GCPRO 5 variables */
sentinel = Fcons (sentinel, filter);
GCPRO5 (name, buffer, host, service, sentinel);
CHECK_STRING (name);
CHECK_STRING (host);
......@@ -1841,87 +1916,6 @@ specifying a port number to connect to. */)
#endif
immediate_quit = 0;
/* Do this in case we never enter the for-loop below. */
count1 = specpdl_ptr - specpdl;
s = -1;
for (lres = res; lres; lres = lres->ai_next)
{
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
if (s < 0)
{
xerrno = errno;
continue;
}
/* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
when connect is interrupted. So let's not let it get interrupted.
Note we do not turn off polling, because polling is only used
when not interrupt_input, and thus not normally used on the systems
which have this bug. On systems which use polling, there's no way
to quit if polling is turned off. */
if (interrupt_input)
unrequest_sigio ();
/* Make us close S if quit. */
count1 = specpdl_ptr - specpdl;
record_unwind_protect (close_file_unwind, make_number (s));
loop:
immediate_quit = 1;
QUIT;
/* This turns off all alarm-based interrupts; the
bind_polling_period call above doesn't always turn all the
short-interval ones off, especially if interrupt_input is
set.
It'd be nice to be able to control the connect timeout
though. Would non-blocking connect calls be portable? */
turn_on_atimers (0);
ret = connect (s, lres->ai_addr, lres->ai_addrlen);
xerrno = errno;
turn_on_atimers (1);
if (ret == 0 || xerrno == EISCONN)
/* The unwind-protect will be discarded afterwards.
Likewise for immediate_quit. */
break;
immediate_quit = 0;
if (xerrno == EINTR)
goto loop;
if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
and it is harmless, since this retrying takes time anyway
and should be infrequent. */
Fsleep_for (make_number (1), Qnil);
retry++;
goto loop;
}
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
count1 = specpdl_ptr - specpdl;
emacs_close (s);
s = -1;
}
freeaddrinfo (res);
if (s < 0)
{
if (interrupt_input)
request_sigio ();
errno = xerrno;
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
#else /* not HAVE_GETADDRINFO */
while (1)
......@@ -1973,37 +1967,109 @@ specifying a port number to connect to. */)
address.sin_family = host_info_ptr->h_addrtype;
address.sin_port = port;
s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0);
if (s < 0)
report_file_error ("error creating socket", Fcons (name, Qnil));
/* Emulate HAVE_GETADDRINFO for the loop over `res' below. */
ai.ai_family = host_info_ptr->h_addrtype;
ai.ai_socktype = SOCK_STREAM;
ai.ai_protocol = 0;
ai.ai_addr = (struct sockaddr *) &address;
ai.ai_addrlen = sizeof address;
ai.ai_next = NULL;
res = &ai;
#endif /* not HAVE_GETADDRINFO */
/* Do this in case we never enter the for-loop below. */
count1 = specpdl_ptr - specpdl;
record_unwind_protect (close_file_unwind, make_number (s));
/* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
when connect is interrupted. So let's not let it get interrupted.
Note we do not turn off polling, because polling is only used
when not interrupt_input, and thus not normally used on the systems
which have this bug. On systems which use polling, there's no way
to quit if polling is turned off. */
if (interrupt_input)
unrequest_sigio ();
s = -1;
loop:
for (lres = res; lres; lres = lres->ai_next)
{
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
if (s < 0)
{
xerrno = errno;
continue;
}
immediate_quit = 1;
QUIT;
#ifdef NON_BLOCKING_CONNECT
if (is_non_blocking)
{
#ifdef O_NONBLOCK
ret = fcntl (s, F_SETFL, O_NONBLOCK);
#else
ret = fcntl (s, F_SETFL, O_NDELAY);
#endif
if (ret < 0)
{
xerrno = errno;
emacs_close (s);
s = -1;
continue;
}
}
#endif
if (connect (s, (struct sockaddr *) &address, sizeof address) == -1
&& errno != EISCONN)
{
int xerrno = errno;
/* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
when connect is interrupted. So let's not let it get interrupted.
Note we do not turn off polling, because polling is only used
when not interrupt_input, and thus not normally used on the systems
which have this bug. On systems which use polling, there's no way
to quit if polling is turned off. */
if (interrupt_input)
unrequest_sigio ();
/* Make us close S if quit. */
count1 = specpdl_ptr - specpdl;
record_unwind_protect (close_file_unwind, make_number (s));
loop:
immediate_quit = 1;
QUIT;
/* This turns off all alarm-based interrupts; the
bind_polling_period call above doesn't always turn all the
short-interval ones off, especially if interrupt_input is
set.
It'd be nice to be able to control the connect timeout
though. Would non-blocking connect calls be portable?
This used to be conditioned by HAVE_GETADDRINFO. Why? */
if (!is_non_blocking)
turn_on_atimers (0);
ret = connect (s, lres->ai_addr, lres->ai_addrlen);
xerrno = errno;
if (!is_non_blocking)
turn_on_atimers (1);
if (ret == 0 || xerrno == EISCONN)
{
is_non_blocking = 0;
/* The unwind-protect will be discarded afterwards.
Likewise for immediate_quit. */
break;
}
#ifdef NON_BLOCKING_CONNECT
#ifdef EINPROGRESS
if (is_non_blocking && xerrno == EINPROGRESS)
break;
#else
#ifdef EWOULDBLOCK
if (is_non_blocking && xerrno == EWOULDBLOCK)
break;
#endif
#endif
#endif
immediate_quit = 0;
if (errno == EINTR)
if (xerrno == EINTR)
goto loop;
if (errno == EADDRINUSE && retry < 20)
if (xerrno == EADDRINUSE && retry < 20)
{
/* A delay here is needed on some FreeBSD systems,
and it is harmless, since this retrying takes time anyway
......@@ -2013,21 +2079,40 @@ specifying a port number to connect to. */)
goto loop;
}
/* Discard the unwind protect. */
/* Discard the unwind protect closing S. */
specpdl_ptr = specpdl + count1;
count1 = specpdl_ptr - specpdl;
emacs_close (s);
s = -1;
}
#ifdef HAVE_GETADDRINFO
freeaddrinfo (res);
#endif
if (s < 0)
{
if (interrupt_input)
request_sigio ();
/* If non-blocking got this far - and failed - assume non-blocking is
not supported after all. This is probably a wrong assumption, but
the normal blocking calls to open-network-stream handles this error
better. */
if (is_non_blocking)
{
#ifdef POLL_FOR_INPUT
unbind_to (count, Qnil);
#endif
return Qnil;
}
errno = xerrno;
report_file_error ("connection failed",
Fcons (host, Fcons (name, Qnil)));
}
#endif /* not HAVE_GETADDRINFO */
immediate_quit = 0;
/* Discard the unwind protect, if any. */
......@@ -2068,15 +2153,35 @@ specifying a port number to connect to. */)
XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil));
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->sentinel = XCAR (sentinel);
XPROCESS (proc)->filter = XCDR (sentinel);
XPROCESS (proc)->command = Qnil;
XPROCESS (proc)->pid = Qnil;
XSETINT (XPROCESS (proc)->infd, inch);
XSETINT (XPROCESS (proc)->outfd, outch);
XPROCESS (proc)->status = Qrun;
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
#ifdef NON_BLOCKING_CONNECT
if (!NILP (non_blocking))
{
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
XPROCESS (proc)->status = Qconnect;
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
num_pending_connects++;
}
}
else
#endif
if (!EQ (XPROCESS (proc)->filter, Qt))
{
FD_SET (inch, &input_wait_mask);
FD_SET (inch, &non_keyboard_wait_mask);
}
if (inch > max_process_desc)
max_process_desc = inch;
......@@ -2194,6 +2299,12 @@ deactivate_process (proc)
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
if (FD_ISSET (inchannel, &connect_wait_mask))
{
FD_CLR (inchannel, &connect_wait_mask);
if (--num_pending_connects < 0)
abort ();
}
if (inchannel == max_process_desc)
{
int i;
......@@ -2358,10 +2469,11 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
{
register int channel, nfds;
static SELECT_TYPE Available;
static SELECT_TYPE Connecting;
int check_connect, no_avail;
int xerrno;
Lisp_Object proc;
EMACS_TIME timeout, end_time;
SELECT_TYPE Atemp;
int wait_channel = -1;
struct Lisp_Process *wait_proc = 0;
int got_some_input = 0;
......@@ -2370,6 +2482,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
Lisp_Object wait_for_cell = Qnil;
FD_ZERO (&Available);
FD_ZERO (&Connecting);
/* If read_kbd is a process to watch, set wait_proc and wait_channel
accordingly. */
......@@ -2511,11 +2624,15 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
timeout to get our attention. */
if (update_tick != process_tick && do_display)
{
SELECT_TYPE Atemp, Ctemp;
Atemp = input_wait_mask;
Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
&Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
&timeout)
&Atemp,
(num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
(SELECT_TYPE *)0, &timeout)
<= 0))
{
/* It's okay for us to do this and then continue with
......@@ -2525,11 +2642,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
}
}
/* Don't wait for output from a non-running process. */
/* Don't wait for output from a non-running process. Just
read whatever data has already been received. */
if (wait_proc != 0 && !NILP (wait_proc->raw_status_low))
update_status (wait_proc);
if (wait_proc != 0
&& ! EQ (wait_proc->status, Qrun))
&& ! EQ (wait_proc->status, Qrun)
&& ! EQ (wait_proc->status, Qconnect))
{
int nread, total_nread = 0;
......@@ -2568,11 +2687,18 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
/* Wait till there is something to do */
if (!NILP (wait_for_cell))
Available = non_process_wait_mask;
else if (! XINT (read_kbd))
Available = non_keyboard_wait_mask;
{
Available = non_process_wait_mask;
check_connect = 0;
}
else
Available = input_wait_mask;
{
if (! XINT (read_kbd))
Available = non_keyboard_wait_mask;
else
Available = input_wait_mask;
check_connect = (num_pending_connects > 0);
}
/* If frame size has changed or the window is newly mapped,
redisplay now, before we start to wait. There is a race
......@@ -2587,15 +2713,21 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
set_waiting_for_input (&timeout);
}
no_avail = 0;
if (XINT (read_kbd) && detect_input_pending ())
{
nfds = 0;
FD_ZERO (&Available);
no_avail = 1;
}
else
nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
&Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
&timeout);
{
if (check_connect)
Connecting = connect_wait_mask;
nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
&Available,
(check_connect ? &Connecting : (SELECT_TYPE *)0),
(SELECT_TYPE *)0, &timeout);
}
xerrno = errno;
......@@ -2611,7 +2743,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
if (nfds < 0)
{
if (xerrno == EINTR)
FD_ZERO (&Available);
no_avail = 1;
#ifdef ultrix
/* Ultrix select seems to return ENOMEM when it is
interrupted. Treat it just like EINTR. Bleah. Note
......@@ -2619,13 +2751,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
"__ultrix__"; the latter is only defined under GCC, but
not by DEC's bundled CC. -JimB */
else if (xerrno == ENOMEM)
FD_ZERO (&Available);
no_avail = 1;
#endif
#ifdef ALLIANT
/* This happens for no known reason on ALLIANT.
I am guessing that this is the right response. -- RMS. */
else if (xerrno == EFAULT)
FD_ZERO (&Available);
no_avail = 1;
#endif
else if (xerrno == EBADF)
{
......@@ -2637,7 +2769,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
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 SIGCLD. */
FD_ZERO (&Available); /* Cannot depend on values returned */
no_avail = 1; /* Cannot depend on values returned */
#else
abort ();
#endif
......@@ -2645,9 +2777,16 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
else
error ("select error: %s", emacs_strerror (xerrno));
}
if (no_avail)
{
FD_ZERO (&Available);
check_connect = 0;
}
#if defined(sun) && !defined(USG5_4)
else if (nfds > 0 && keyboard_bit_set (&Available)