struct timespec *, void *);
#endif
-/* Work around GCC 4.7.0 bug with strict overflow checking; see
+/* Work around GCC 4.3.0 bug with strict overflow checking; see
<http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
This bug appears to be fixed in GCC 5.1, so don't work around it there. */
-#if __GNUC__ == 4 && __GNUC_MINOR__ >= 3
+#if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
# pragma GCC diagnostic ignored "-Wstrict-overflow"
#endif
\f
#ifndef SOCK_CLOEXEC
# define SOCK_CLOEXEC 0
#endif
+#ifndef SOCK_NONBLOCK
+# define SOCK_NONBLOCK 0
+#endif
+
+/* True if ERRNUM represents an error where the system call would
+ block if a blocking variant were used. */
+static bool
+would_block (int errnum)
+{
+#ifdef EWOULDBLOCK
+ if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
+ return true;
+#endif
+ return errnum == EAGAIN;
+}
#ifndef HAVE_ACCEPT4
/* The largest descriptor currently in use for input; -1 if none. */
static int max_input_desc;
+/* Set the external socket descriptor for Emacs to use when
+ `make-network-process' is called with a non-nil
+ `:use-external-socket' option. The value should be either -1, or
+ the file descriptor of a socket that is already bound. */
+static int external_sock_fd;
+
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
static void wait_for_socket_fds (Lisp_Object, char const *);
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
return Qrun;
}
+/* True if STATUS is that of a process attempting connection. */
+
+static bool
+connecting_status (Lisp_Object status)
+{
+ return CONSP (status) && EQ (XCAR (status), Qconnect);
+}
+
/* Given a status-list, extract the three pieces of information
and store them individually through the three pointers. */
static void
-decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, bool *coredump)
+decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
+ bool *coredump)
{
Lisp_Object tem;
+ if (connecting_status (l))
+ l = XCAR (l);
+
if (SYMBOLP (l))
{
*symbol = l;
- *code = 0;
+ *code = make_number (0);
*coredump = 0;
}
else
{
*symbol = XCAR (l);
tem = XCDR (l);
- *code = XFASTINT (XCAR (tem));
+ *code = XCAR (tem);
tem = XCDR (tem);
*coredump = !NILP (tem);
}
status_message (struct Lisp_Process *p)
{
Lisp_Object status = p->status;
- Lisp_Object symbol;
- int code;
+ Lisp_Object symbol, code;
bool coredump;
Lisp_Object string;
{
char const *signame;
synchronize_system_messages_locale ();
- signame = strsignal (code);
+ signame = strsignal (XFASTINT (code));
if (signame == 0)
string = build_string ("unknown");
else
else if (EQ (symbol, Qexit))
{
if (NETCONN1_P (p))
- return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
- if (code == 0)
+ return build_string (XFASTINT (code) == 0
+ ? "deleted\n"
+ : "connection broken by remote peer\n");
+ if (XFASTINT (code) == 0)
return build_string ("finished\n");
AUTO_STRING (prefix, "exited abnormally with code ");
- string = Fnumber_to_string (make_number (code));
+ string = Fnumber_to_string (code);
AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
return concat3 (prefix, string, suffix);
}
else if (EQ (symbol, Qfailed))
{
- AUTO_STRING (prefix, "failed with code ");
- string = Fnumber_to_string (make_number (code));
- AUTO_STRING (suffix, "\n");
- return concat3 (prefix, string, suffix);
+ AUTO_STRING (format, "failed with code %s\n");
+ return CALLN (Fformat, format, code);
}
else
return Fcopy_sequence (Fsymbol_name (symbol));
static Lisp_Object
make_process (Lisp_Object name)
{
- register Lisp_Object val, tem, name1;
- register struct Lisp_Process *p;
- char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)];
- printmax_t i;
-
- p = allocate_process ();
+ struct Lisp_Process *p = allocate_process ();
/* Initialize Lisp data. Note that allocate_process initializes all
Lisp data to nil, so do it only for slots which should not be nil. */
pset_status (p, Qrun);
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++)
+ for (int i = 0; i < PROCESS_OPEN_FDS; i++)
p->open_fd[i] = -1;
#ifdef HAVE_GNUTLS
/* If name is already in use, modify it until it is unused. */
- name1 = name;
- for (i = 1; ; i++)
+ Lisp_Object name1 = name;
+ for (printmax_t i = 1; ; i++)
{
- tem = Fget_process (name1);
- if (NILP (tem)) break;
- name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i));
+ Lisp_Object tem = Fget_process (name1);
+ if (NILP (tem))
+ break;
+ char const suffix_fmt[] = "<%"pMd">";
+ char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
+ AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
+ name1 = concat2 (name, lsuffix);
}
name = name1;
pset_name (p, name);
pset_sentinel (p, Qinternal_default_process_sentinel);
pset_filter (p, Qinternal_default_process_filter);
+ Lisp_Object val;
XSETPROCESS (val, p);
Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
return val;
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. */)
+ doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
+Value is t if PROCESS was successfully told about the window size,
+nil otherwise. */)
(Lisp_Object process, Lisp_Object height, Lisp_Object width)
{
CHECK_PROCESS (process);
return address;
}
+/* Convert an internal struct addrinfo to a Lisp object. */
+
+static Lisp_Object
+conv_addrinfo_to_lisp (struct addrinfo *res)
+{
+ Lisp_Object protocol = make_number (res->ai_protocol);
+ eassert (XINT (protocol) == res->ai_protocol);
+ return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
+}
+
/* Get family and required size for sockaddr structure to hold ADDRESS. */
#endif
static void
-connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
+ Lisp_Object use_external_socket_p)
{
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t count1;
int s = -1, outch, inch;
int xerrno = 0;
- Lisp_Object ip_address;
int family;
struct sockaddr *sa = NULL;
int ret;
struct Lisp_Process *p = XPROCESS (proc);
Lisp_Object contact = p->childp;
int optbits = 0;
+ int socket_to_use = -1;
+
+ if (!NILP (use_external_socket_p))
+ {
+ socket_to_use = external_sock_fd;
+
+ /* Ensure we don't consume the external socket twice. */
+ external_sock_fd = -1;
+ }
/* Do this in case we never enter the while-loop below. */
count1 = SPECPDL_INDEX ();
s = -1;
- while (!NILP (ip_addresses))
+ while (!NILP (addrinfos))
{
- ip_address = XCAR (ip_addresses);
- ip_addresses = XCDR (ip_addresses);
+ Lisp_Object addrinfo = XCAR (addrinfos);
+ addrinfos = XCDR (addrinfos);
+ int protocol = XINT (XCAR (addrinfo));
+ Lisp_Object ip_address = XCDR (addrinfo);
#ifdef WINDOWSNT
retry_connect:
sa = xmalloc (addrlen);
conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
- s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol);
+ s = socket_to_use;
if (s < 0)
{
- xerrno = errno;
- continue;
+ int socktype = p->socktype | SOCK_CLOEXEC;
+ if (p->is_non_blocking_client)
+ socktype |= SOCK_NONBLOCK;
+ s = socket (family, socktype, protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
}
-#ifdef DATAGRAM_SOCKETS
- if (!p->is_server && p->socktype == SOCK_DGRAM)
- break;
-#endif /* DATAGRAM_SOCKETS */
-
- if (p->is_non_blocking_client)
+ if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
{
ret = fcntl (s, F_SETFL, O_NONBLOCK);
if (ret < 0)
}
}
+#ifdef DATAGRAM_SOCKETS
+ if (!p->is_server && p->socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
+
/* Make us close S if quit. */
record_unwind_protect_int (close_file_unwind, s);
report_file_error ("Cannot set reuse option on server socket", Qnil);
}
- if (bind (s, sa, addrlen))
+ /* If passed a socket descriptor, it should be already bound. */
+ if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
report_file_error ("Cannot bind server socket", Qnil);
#ifdef HAVE_GETSOCKNAME
eassert (FD_ISSET (s, &fdset));
if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
report_file_error ("Failed getsockopt", Qnil);
- if (xerrno)
+ if (xerrno == 0)
+ break;
+ if (NILP (addrinfos))
report_file_errno ("Failed connect", Qnil, xerrno);
- break;
}
#endif /* !WINDOWSNT */
/* We may get here if connect did succeed immediately. However,
in that case, we still need to signal this like a non-blocking
connection. */
- pset_status (p, Qconnect);
+ if (! (connecting_status (p->status)
+ && EQ (XCDR (p->status), addrinfos)))
+ pset_status (p, Fcons (Qconnect, addrinfos));
if (!FD_ISSET (inch, &connect_wait_mask))
{
FD_SET (inch, &connect_wait_mask);
(this is allowed by default for a server process).
:bindtodevice NAME -- bind to interface NAME. Using this may require
special privileges on some systems.
+:use-external-socket BOOL -- Use any pre-allocated sockets that have
+ been passed to Emacs. If Emacs wasn't
+ passed a socket, this option is silently
+ ignored.
+
Consult the relevant system programmer's manual pages for more
information on using these options.
EMACS_INT port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
- Lisp_Object filter, sentinel;
- Lisp_Object ip_addresses = Qnil;
+ Lisp_Object filter, sentinel, use_external_socket_p;
+ Lisp_Object addrinfos = Qnil;
int socktype;
int family = -1;
- int ai_protocol = 0;
+ enum { any_protocol = 0 };
#ifdef HAVE_GETADDRINFO_A
struct gaicb *dns_request = NULL;
#endif
buffer = Fplist_get (contact, QCbuffer);
filter = Fplist_get (contact, QCfilter);
sentinel = Fplist_get (contact, QCsentinel);
+ use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
CHECK_STRING (name);
/* :local ADDRESS or :remote ADDRESS */
tem = Fplist_get (contact, QCserver);
- if (!NILP (tem))
+ if (NILP (tem))
address = Fplist_get (contact, QCremote);
else
address = Fplist_get (contact, QClocal);
if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ip_addresses = list1 (address);
+ addrinfos = list1 (Fcons (make_number (any_protocol), address));
goto open_socket;
}
CHECK_STRING (service);
if (sizeof address_un.sun_path <= SBYTES (service))
error ("Service name too long");
- ip_addresses = list1 (service);
+ addrinfos = list1 (Fcons (make_number (any_protocol), service));
goto open_socket;
}
#endif
immediate_quit = 0;
for (lres = res; lres; lres = lres->ai_next)
- {
- ip_addresses = Fcons (conv_sockaddr_to_lisp
- (lres->ai_addr, lres->ai_addrlen),
- ip_addresses);
- ai_protocol = lres->ai_protocol;
- }
+ addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
- ip_addresses = Fnreverse (ip_addresses);
+ addrinfos = Fnreverse (addrinfos);
freeaddrinfo (res);
p->is_server = false;
p->port = port;
p->socktype = socktype;
- p->ai_protocol = ai_protocol;
#ifdef HAVE_GETADDRINFO_A
p->dns_request = NULL;
#endif
p->gnutls_boot_parameters = tem;
#endif
- set_network_socket_coding_system (proc, service, host, name);
+ set_network_socket_coding_system (proc, host, service, name);
unbind_to (count, Qnil);
#ifdef HAVE_GETADDRINFO_A
/* With async address resolution, the list of addresses is empty, so
postpone connecting to the server. */
- if (!p->is_server && NILP (ip_addresses))
+ if (!p->is_server && NILP (addrinfos))
{
p->dns_request = dns_request;
- p->status = Qconnect;
+ p->status = list1 (Qconnect);
return proc;
}
#endif
- connect_network_socket (proc, ip_addresses);
+ connect_network_socket (proc, addrinfos, use_external_socket_p);
return proc;
}
#endif
}
-/* If program file NAME starts with /: for quoting a magic
- name, remove that, preserving the multibyteness of NAME. */
-
-Lisp_Object
-remove_slash_colon (Lisp_Object name)
-{
- return
- ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
- ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
- SBYTES (name) - 2, STRING_MULTIBYTE (name))
- : name);
-}
-
/* Turn off input and output for process PROC. */
static void
if (s < 0)
{
int code = errno;
-
- if (code == EAGAIN)
- return;
-#ifdef EWOULDBLOCK
- if (code == EWOULDBLOCK)
- return;
-#endif
-
- if (!NILP (ps->log))
+ if (!would_block (code) && !NILP (ps->log))
call3 (ps->log, server, Qnil,
concat3 (build_string ("accept failed with code"),
Fnumber_to_string (make_number (code)),
check_for_dns (Lisp_Object proc)
{
struct Lisp_Process *p = XPROCESS (proc);
- Lisp_Object ip_addresses = Qnil;
+ Lisp_Object addrinfos = Qnil;
/* Sanity check. */
if (! p->dns_request)
struct addrinfo *res;
for (res = p->dns_request->ar_result; res; res = res->ai_next)
- {
- ip_addresses = Fcons (conv_sockaddr_to_lisp
- (res->ai_addr, res->ai_addrlen),
- ip_addresses);
- }
+ addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
- ip_addresses = Fnreverse (ip_addresses);
+ addrinfos = Fnreverse (addrinfos);
}
/* The DNS lookup failed. */
- else if (EQ (p->status, Qconnect))
+ else if (connecting_status (p->status))
{
deactivate_process (proc);
pset_status (p, (list2
free_dns_request (proc);
/* This process should not already be connected (or killed). */
- if (!EQ (p->status, Qconnect))
+ if (! connecting_status (p->status))
return Qnil;
- return ip_addresses;
+ return addrinfos;
}
#endif /* HAVE_GETADDRINFO_A */
wait_for_socket_fds (Lisp_Object process, char const *name)
{
while (XPROCESS (process)->infd < 0
- && EQ (XPROCESS (process)->status, Qconnect))
+ && connecting_status (XPROCESS (process)->status))
{
add_to_log ("Waiting for socket from %s...", build_string (name));
wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
static void
wait_while_connecting (Lisp_Object process)
{
- while (EQ (XPROCESS (process)->status, Qconnect))
+ while (connecting_status (XPROCESS (process)->status))
{
add_to_log ("Waiting for connection...");
wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
/* Check for pending DNS requests. */
if (p->dns_request)
{
- Lisp_Object ip_addresses = check_for_dns (aproc);
- if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt))
- connect_network_socket (aproc, ip_addresses);
+ Lisp_Object addrinfos = check_for_dns (aproc);
+ if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
+ connect_network_socket (aproc, addrinfos, Qnil);
else
retry_for_async = true;
}
update_status (wait_proc);
if (wait_proc
&& ! EQ (wait_proc->status, Qrun)
- && ! EQ (wait_proc->status, Qconnect))
+ && ! connecting_status (wait_proc->status))
{
bool read_some_bytes = false;
int nread = read_process_output (proc, wait_proc->infd);
if (nread < 0)
{
- if (errno == EIO || errno == EAGAIN)
- break;
-#ifdef EWOULDBLOCK
- if (errno == EWOULDBLOCK)
- break;
-#endif
+ if (errno == EIO || would_block (errno))
+ break;
}
else
{
haven't lowered our timeout due to timers or SIGIO and
have waited a long amount of time due to repeated
timers. */
+ struct timespec huge_timespec
+ = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
+ struct timespec cmp_time = huge_timespec;
if (wait < TIMEOUT)
break;
- struct timespec cmp_time
- = (wait == TIMEOUT
- ? end_time
- : (!process_skipped && got_some_output > 0
- && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
- ? got_output_end_time
- : invalid_timespec ());
- if (timespec_valid_p (cmp_time))
+ if (wait == TIMEOUT)
+ cmp_time = end_time;
+ if (!process_skipped && got_some_output > 0
+ && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
+ {
+ if (!timespec_valid_p (got_output_end_time))
+ break;
+ if (timespec_cmp (got_output_end_time, cmp_time) < 0)
+ cmp_time = got_output_end_time;
+ }
+ if (timespec_cmp (cmp_time, huge_timespec) < 0)
{
now = current_timespec ();
if (timespec_cmp (cmp_time, now) <= 0)
if (do_display)
redisplay_preserve_echo_area (12);
}
-#ifdef EWOULDBLOCK
- else if (nread == -1 && errno == EWOULDBLOCK)
- ;
-#endif
- else if (nread == -1 && errno == EAGAIN)
+ else if (nread == -1 && would_block (errno))
;
#ifdef WINDOWSNT
/* FIXME: Is this special case still needed? */
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. */
+#ifndef WINDOWSNT
{
socklen_t xlen = sizeof (xerrno);
if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
xerrno = errno;
}
#else
+ /* On MS-Windows, getsockopt clears the error for the
+ entire process, which may not be the right thing; see
+ w32.c. Use getpeername instead. */
{
struct sockaddr pname;
socklen_t pnamelen = sizeof (pname);
#endif
if (xerrno)
{
- p->tick = ++process_tick;
- pset_status (p, list2 (Qfailed, make_number (xerrno)));
+ Lisp_Object addrinfos
+ = connecting_status (p->status) ? XCDR (p->status) : Qnil;
+ if (!NILP (addrinfos))
+ XSETCDR (p->status, XCDR (addrinfos));
+ else
+ {
+ p->tick = ++process_tick;
+ pset_status (p, list2 (Qfailed, make_number (xerrno)));
+ }
deactivate_process (proc);
+ if (!NILP (addrinfos))
+ connect_network_socket (proc, addrinfos, Qnil);
}
else
{
#ifdef HAVE_GNUTLS
/* If we have an incompletely set up TLS connection,
- then defer the sentinel signalling until
+ then defer the sentinel signaling until
later. */
if (NILP (p->gnutls_boot_parameters)
&& !p->gnutls_p)
if (rv < 0)
{
- if (errno == EAGAIN
-#ifdef EWOULDBLOCK
- || errno == EWOULDBLOCK
-#endif
- )
+ if (would_block (errno))
/* Buffer is full. Wait, accepting input;
that may allow the program
to finish doing output and read more. */
/* If process is still active, read any output that remains. */
while (! EQ (p->filter, Qt)
- && ! EQ (p->status, Qconnect)
+ && ! connecting_status (p->status)
&& ! EQ (p->status, Qlisten)
/* Network or serial process not stopped: */
&& ! EQ (p->command, Qt)
#endif /* HAVE_TIMERFD */
+/* If program file NAME starts with /: for quoting a magic
+ name, remove that, preserving the multibyteness of NAME. */
+
+Lisp_Object
+remove_slash_colon (Lisp_Object name)
+{
+ return
+ ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
+ ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
+ SBYTES (name) - 2, STRING_MULTIBYTE (name))
+ : name);
+}
+
/* Add DESC to the set of keyboard input descriptors. */
void
/* This is not called "init_process" because that is the name of a
Mach system call, so it would cause problems on Darwin systems. */
void
-init_process_emacs (void)
+init_process_emacs (int sockfd)
{
#ifdef subprocesses
- register int i;
+ int i;
inhibit_sentinels = 0;
FD_ZERO (&non_process_wait_mask);
FD_ZERO (&write_mask);
max_process_desc = max_input_desc = -1;
+ external_sock_fd = sockfd;
memset (fd_callback_info, 0, sizeof (fd_callback_info));
FD_ZERO (&connect_wait_mask);
DEFSYM (QCserver, ":server");
DEFSYM (QCnowait, ":nowait");
DEFSYM (QCsentinel, ":sentinel");
+ DEFSYM (QCuse_external_socket, ":use-external-socket");
DEFSYM (QCtls_parameters, ":tls-parameters");
DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
DEFSYM (QClog, ":log");
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);
-
{
Lisp_Object subfeatures = Qnil;
const struct socket_options *sopt;
Fprovide (intern_c_string ("make-network-process"), subfeatures);
}
+#endif /* subprocesses */
+
+ defsubr (&Sget_buffer_process);
+ defsubr (&Sprocess_inherit_coding_system_flag);
+ defsubr (&Slist_system_processes);
+ defsubr (&Sprocess_attributes);
}