/* 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.
#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. */
/* 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 *));
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;
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;
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));
}
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;
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);
#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)
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
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. */
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;
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;
{
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;
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. */
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
}
}
- /* 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;
/* 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
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;
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
"__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)
{
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
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)
- && interrupt_input)
+ if (nfds > 0 && keyboard_bit_set (&Available)
+ && interrupt_input)
/* System sometimes fails to deliver SIGIO.
David J. Mackenzie says that Emacs doesn't compile under
do_pending_window_change (0);
/* Check for data from a process. */
+ if (no_avail || nfds == 0)
+ continue;
+
/* Really FIRST_PROC_DESC should be 0 on Unix,
but this is safer in the short run. */
for (channel = 0; channel <= max_process_desc; channel++)
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
+#ifdef NON_BLOCKING_CONNECT
+ if (check_connect && FD_ISSET (channel, &Connecting))
+ {
+ struct Lisp_Process *p;
+ struct sockaddr pname;
+ socklen_t pnamelen = sizeof(pname);
+
+ FD_CLR (channel, &connect_wait_mask);
+ if (--num_pending_connects < 0)
+ abort ();
+
+ proc = chan_process[channel];
+ if (NILP (proc))
+ continue;
+
+ p = XPROCESS (proc);
+
+#ifdef GNU_LINUX
+ /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
+ So only use it on systems where it is known to work. */
+ {
+ socklen_t xlen = sizeof(xerrno);
+ if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
+ xerrno = errno;
+ }
+#else
+ /* If connection failed, getpeername will fail. */
+ xerrno = 0;
+ if (getpeername(channel, &pname, &pnamelen) < 0)
+ {
+ /* Obtain connect failure code through error slippage. */
+ char dummy;
+ xerrno = errno;
+ if (errno == ENOTCONN && read(channel, &dummy, 1) < 0)
+ xerrno = errno;
+ }
+#endif
+ if (xerrno)
+ {
+ XSETINT (p->tick, ++process_tick);
+ p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
+ deactivate_process (proc);
+ }
+ else
+ {
+ p->status = Qrun;
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ if (!EQ (p->filter, Qt))
+ {
+ FD_SET (XINT (p->infd), &input_wait_mask);
+ FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
+ }
+ }
+ }
+#endif /* NON_BLOCKING_CONNECT */
} /* end for each file descriptor */
} /* end while exit conditions not met */
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
+ && ! EQ (p->status, Qconnect)
&& XINT (p->infd) >= 0
&& read_process_output (proc, XINT (p->infd)) > 0);
staticpro (&Qopen);
Qclosed = intern ("closed");
staticpro (&Qclosed);
+ Qconnect = intern ("connect");
+ staticpro (&Qconnect);
+ Qfailed = intern ("failed");
+ staticpro (&Qfailed);
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
HCoop / bpt / emacs.git / commitdiff