GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
# include <sys/stropts.h>
#endif
-#ifdef HAVE_RES_INIT
-#include <arpa/nameser.h>
-#include <resolv.h>
-#endif
-
#ifdef HAVE_UTIL_H
#include <util.h>
#endif
#endif
#endif
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+/* This is 0.1s in nanoseconds. */
+#define ASYNC_RETRY_NSEC 100000000
+#endif
+
#ifdef WINDOWSNT
extern int sys_select (int, fd_set *, fd_set *, fd_set *,
struct timespec *, void *);
/* Number of events for which the user or sentinel has been notified. */
static EMACS_INT update_tick;
-/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.
- The code can be simplified by assuming NON_BLOCKING_CONNECT once
- Emacs starts assuming POSIX 1003.1-2001 or later. */
-
-#if (defined HAVE_SELECT \
- && (defined GNU_LINUX || defined HAVE_GETPEERNAME) \
- && (defined EWOULDBLOCK || defined EINPROGRESS))
-# define NON_BLOCKING_CONNECT
-#endif
-
/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
this system. We need to read full packets, so we need a
"non-destructive" select. So we require either native select,
static fd_set write_mask;
-#ifdef NON_BLOCKING_CONNECT
/* Mask of bits indicating the descriptors that we wait for connect to
complete on. Once they complete, they are removed from this mask
and added to the input_wait_mask and non_keyboard_wait_mask. */
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
-#endif /* NON_BLOCKING_CONNECT */
/* The largest descriptor currently in use for a process object; -1 if none. */
static int max_process_desc;
/* 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 process, char *name);
+static void wait_for_socket_fds (Lisp_Object, char const *);
/* Alist of elements (NAME . PROCESS). */
static Lisp_Object Vprocess_alist;
/* Table of `partner address' for datagram sockets. */
static struct sockaddr_and_len {
struct sockaddr *sa;
- int len;
+ ptrdiff_t len;
} datagram_address[FD_SETSIZE];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
#define DATAGRAM_CONN_P(proc) \
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;
{
struct Lisp_Process *p = XPROCESS (proc);
- if (p->dns_requests[0]->ar_result)
- freeaddrinfo (p->dns_requests[0]->ar_result);
- xfree ((void *)p->dns_requests[0]->ar_request);
- xfree ((void *)p->dns_requests[0]->ar_name);
- xfree ((void *)p->dns_requests[0]->ar_service);
- xfree (p->dns_requests[0]);
- xfree (p->dns_requests);
- p->dns_requests = NULL;
+ if (p->dns_request->ar_result)
+ freeaddrinfo (p->dns_request->ar_result);
+ xfree (p->dns_request);
+ p->dns_request = NULL;
}
#endif
p = XPROCESS (process);
#ifdef HAVE_GETADDRINFO_A
- if (p->dns_requests)
+ if (p->dns_request)
{
- gai_cancel (p->dns_requests[0]);
- free_dns_request (process);
+ /* Cancel the request. Unless shutting down, wait until
+ completion. Free the request if completely canceled. */
+
+ bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
+ if (!canceled && !inhibit_sentinels)
+ {
+ struct gaicb const *req = p->dns_request;
+ while (gai_suspend (&req, 1, NULL) != 0)
+ continue;
+ canceled = true;
+ }
+ if (canceled)
+ free_dns_request (process);
}
#endif
This is a list of strings, the first string being the program executed
and the rest of the strings being the arguments given to it.
For a network or serial process, this is nil (process is running) or t
-(process is stopped). */)
+\(process is stopped). */)
(register Lisp_Object process)
{
CHECK_PROCESS (process);
- if `default-enable-multibyte-characters' is nil, it is a unibyte
string (the result of converting the decoded input multibyte
string to unibyte with `string-make-unibyte'). */)
- (register Lisp_Object process, Lisp_Object filter)
+ (Lisp_Object process, Lisp_Object filter)
{
- struct Lisp_Process *p;
-
CHECK_PROCESS (process);
-
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
/* Don't signal an error if the process's input file descriptor
is closed. This could make debugging Lisp more difficult,
connection. If KEY is t, the complete contact information for the
connection is returned, else the specific value for the keyword KEY is
returned. See `make-network-process' or `make-serial-process' for a
-list of keywords. */)
- (register Lisp_Object process, Lisp_Object key)
+list of keywords.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
+ (Lisp_Object process, Lisp_Object key)
{
Lisp_Object contact;
DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
2, 2, 0,
- doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
- (register Lisp_Object process, Lisp_Object plist)
+ doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
+ (Lisp_Object process, Lisp_Object plist)
{
CHECK_PROCESS (process);
CHECK_LIST (plist);
An 8 or 9 element vector represents an IPv6 address (with port number).
If optional second argument OMIT-PORT is non-nil, don't include a port
number in the string, even when present in ADDRESS.
-Returns nil if format of ADDRESS is invalid. */)
+Return nil if format of ADDRESS is invalid. */)
(Lisp_Object address, Lisp_Object omit_port)
{
if (NILP (address))
The address family of sa is not included in the result. */
Lisp_Object
-conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
+conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
{
Lisp_Object address;
- int i;
+ ptrdiff_t i;
unsigned char *cp;
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
/* Workaround for a bug in getsockname on BSD: Names bound to
sockets in the UNIX domain are inaccessible; getsockname returns
/* Get family and required size for sockaddr structure to hold ADDRESS. */
-static int
+static ptrdiff_t
get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
{
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
if (VECTORP (address))
{
#ifdef DATAGRAM_SOCKETS
DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
1, 1, 0,
- doc: /* Get the current datagram address associated with PROCESS. */)
+ doc: /* Get the current datagram address associated with PROCESS.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process)
{
int channel;
DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2, 2, 0,
doc: /* Set the datagram address for PROCESS to ADDRESS.
-Returns nil upon error setting address, ADDRESS otherwise. */)
+Return nil upon error setting address, ADDRESS otherwise.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object address)
{
int channel;
- int family, len;
+ int family;
+ ptrdiff_t len;
CHECK_PROCESS (process);
/* Set option OPT to value VAL on socket S.
- Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
+ Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
Signals an error if setting a known option fails.
*/
doc: /* For network process PROCESS set option OPTION to value VALUE.
See `make-network-process' for a list of options and values.
If optional fourth arg NO-ERROR is non-nil, don't signal an error if
-OPTION is not a supported option, return nil instead; otherwise return t. */)
+OPTION is not a supported option, return nil instead; otherwise return t.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
{
int s;
:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
flowcontrol to be used, which is either nil (don't use flowcontrol),
the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
-(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
+\(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
flowcontrol is used.
`serial-process-configure' is called by `make-serial-process' for the
Examples:
-(serial-process-configure :process "/dev/ttyS0" :speed 1200)
+\(serial-process-configure :process "/dev/ttyS0" :speed 1200)
-(serial-process-configure
+\(serial-process-configure
:buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
-(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
+\(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
usage: (serial-process-configure &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
Examples:
-(make-serial-process :port "/dev/ttyS0" :speed 9600)
+\(make-serial-process :port "/dev/ttyS0" :speed 9600)
-(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
+\(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
-(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
+\(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
-(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
+\(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
usage: (make-serial-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
return proc;
}
-void set_network_socket_coding_system (Lisp_Object proc,
- Lisp_Object host,
- Lisp_Object service,
- Lisp_Object name)
+static void
+set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
+ Lisp_Object service, Lisp_Object name)
{
Lisp_Object tem;
struct Lisp_Process *p = XPROCESS (proc);
}
else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
- else if ((!NILP (p->buffer) &&
- NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
- || (NILP (p->buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
+ else if ((!NILP (p->buffer)
+ && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
+ || (NILP (p->buffer)
+ && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
/* We dare not decode end-of-line format by setting VAL to
Qraw_text, because the existing Emacs Lisp libraries
assume that they receive bare code including a sequence of
}
#ifdef HAVE_GNUTLS
-void
+static void
finish_after_tls_connection (Lisp_Object proc)
{
struct Lisp_Process *p = XPROCESS (proc);
}
#endif
-void
-connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+static void
+connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses,
+ Lisp_Object use_external_socket_p)
{
ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t count1;
int family;
struct sockaddr *sa = NULL;
int ret;
- int addrlen;
+ ptrdiff_t addrlen;
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 ();
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;
+ s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
}
#ifdef DATAGRAM_SOCKETS
break;
#endif /* DATAGRAM_SOCKETS */
-#ifdef NON_BLOCKING_CONNECT
if (p->is_non_blocking_client)
{
ret = fcntl (s, F_SETFL, O_NONBLOCK);
continue;
}
}
-#endif
/* 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
Lisp_Object service;
service = make_number (ntohs (sa1.sin_port));
contact = Fplist_put (contact, QCservice, service);
- // Save the port number so that we can stash it in
- // the process object later.
+ /* Save the port number so that we can stash it in
+ the process object later. */
((struct sockaddr_in *)sa)->sin_port = sa1.sin_port;
}
}
break;
}
-#ifdef NON_BLOCKING_CONNECT
-#ifdef EINPROGRESS
if (p->is_non_blocking_client && xerrno == EINPROGRESS)
break;
-#else
-#ifdef EWOULDBLOCK
- if (p->is_non_blocking_client && xerrno == EWOULDBLOCK)
- break;
-#endif
-#endif
-#endif
#ifndef WINDOWSNT
if (xerrno == EINTR)
memset (datagram_address[s].sa, 0, addrlen);
if (remote = Fplist_get (contact, QCremote), !NILP (remote))
{
- int rfamily, rlen;
- rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
+ int rfamily;
+ ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
if (rlen != 0 && rfamily == family
&& rlen == addrlen)
conv_lisp_to_sockaddr (rfamily, remote,
BUF_ZV (XBUFFER (p->buffer)),
BUF_ZV_BYTE (XBUFFER (p->buffer)));
-#ifdef NON_BLOCKING_CONNECT
if (p->is_non_blocking_client)
{
/* We may get here if connect did succeed immediately. However,
}
}
else
-#endif
/* A server may have a client filter setting of Qt, but it must
still listen for incoming connects unless it is stopped. */
if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
}
-#ifndef HAVE_GETADDRINFO
-static Lisp_Object
-conv_numerical_to_lisp (unsigned char *number, unsigned int length, int port)
-{
- Lisp_Object address = Fmake_vector (make_number (length + 1), Qnil);
- register struct Lisp_Vector *p = XVECTOR (address);
- int i;
-
- p->contents[length] = make_number (port);
- for (i = 0; i < length; i++)
- p->contents[i] = make_number (*(number + i));
-
- return address;
-}
-#endif
-
/* Create a network stream/datagram client/server process. Treated
exactly like a normal process when reading and writing. Primary
differences are in status display and process deletion. A network
:service SERVICE -- SERVICE is name of the service desired, or an
integer specifying a port number to connect to. If SERVICE is t,
-a random port number is selected for the server. (If Emacs was
-compiled with getaddrinfo, a port number can also be specified as a
-string, e.g. "80", as well as an integer. This is not portable.)
+a random port number is selected for the server. A port number can
+be specified as an integer string, e.g., "80", as well as an integer.
:type TYPE -- TYPE is the type of connection. The default (nil) is a
stream type connection, `datagram' creates a datagram type connection,
(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.
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
-#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETADDRINFO_A)
- struct addrinfo *hints;
const char *portstring;
- char portbuf[128];
-#endif
+ ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+ char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
- int port = 0;
+ EMACS_INT port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
- Lisp_Object filter, sentinel;
+ Lisp_Object filter, sentinel, use_external_socket_p;
Lisp_Object ip_addresses = Qnil;
int socktype;
int family = -1;
int ai_protocol = 0;
#ifdef HAVE_GETADDRINFO_A
- struct gaicb **dns_requests = NULL;
+ struct gaicb *dns_request = NULL;
#endif
ptrdiff_t count = SPECPDL_INDEX ();
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);
if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ip_addresses = Fcons (address, Qnil);
+ ip_addresses = list1 (address);
goto open_socket;
}
tem = Fplist_get (contact, QCfamily);
if (NILP (tem))
{
-#if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
+#ifdef AF_INET6
family = AF_UNSPEC;
#else
family = AF_INET;
CHECK_STRING (service);
if (sizeof address_un.sun_path <= SBYTES (service))
error ("Service name too long");
- ip_addresses = Fcons (service, Qnil);
+ ip_addresses = list1 (service);
goto open_socket;
}
#endif
}
#endif
-#if defined (HAVE_GETADDRINFO) || defined (HAVE_GETADDRINFO_A)
if (!NILP (host))
{
-
/* SERVICE can either be a string or int.
Convert to a C string for later use by getaddrinfo. */
if (EQ (service, Qt))
- portstring = "0";
+ {
+ portstring = "0";
+ portstringlen = 1;
+ }
else if (INTEGERP (service))
{
- sprintf (portbuf, "%"pI"d", XINT (service));
portstring = portbuf;
+ portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
}
else
{
CHECK_STRING (service);
portstring = SSDATA (service);
+ portstringlen = SBYTES (service);
}
-
- hints = xzalloc (sizeof (struct addrinfo));
- hints->ai_flags = 0;
- hints->ai_family = family;
- hints->ai_socktype = socktype;
- hints->ai_protocol = 0;
}
-#endif
-
#ifdef HAVE_GETADDRINFO_A
- if (!NILP (Fplist_get (contact, QCnowait)) &&
- !NILP (host))
+ if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
{
- int ret;
-
- printf("Async DNS for '%s'\n", SSDATA (host));
- dns_requests = xmalloc (sizeof (struct gaicb*));
- dns_requests[0] = xmalloc (sizeof (struct gaicb));
- dns_requests[0]->ar_name = strdup (SSDATA (host));
- dns_requests[0]->ar_service = strdup (portstring);
- dns_requests[0]->ar_request = hints;
- dns_requests[0]->ar_result = NULL;
-
- ret = getaddrinfo_a (GAI_NOWAIT, dns_requests, 1, NULL);
+ ptrdiff_t hostlen = SBYTES (host);
+ struct req
+ {
+ struct gaicb gaicb;
+ struct addrinfo hints;
+ char str[FLEXIBLE_ARRAY_MEMBER];
+ } *req = xmalloc (offsetof (struct req, str)
+ + hostlen + 1 + portstringlen + 1);
+ dns_request = &req->gaicb;
+ dns_request->ar_name = req->str;
+ dns_request->ar_service = req->str + hostlen + 1;
+ dns_request->ar_request = &req->hints;
+ dns_request->ar_result = NULL;
+ memset (&req->hints, 0, sizeof req->hints);
+ req->hints.ai_family = family;
+ req->hints.ai_socktype = socktype;
+ strcpy (req->str, SSDATA (host));
+ strcpy (req->str + hostlen + 1, portstring);
+
+ int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
if (ret)
error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
goto open_socket;
- }
+ }
#endif /* HAVE_GETADDRINFO_A */
-#ifdef HAVE_GETADDRINFO
/* If we have a host, use getaddrinfo to resolve both host and service.
Otherwise, use getservbyname to lookup the service. */
immediate_quit = 1;
QUIT;
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
+ struct addrinfo hints;
+ memset (&hints, 0, sizeof hints);
+ hints.ai_family = family;
+ hints.ai_socktype = socktype;
- ret = getaddrinfo (SSDATA (host), portstring, hints, &res);
+ ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
if (ret)
#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
+ {
+ synchronize_system_messages_locale ();
+ char const *str = gai_strerror (ret);
+ if (! NILP (Vlocale_coding_system))
+ str = SSDATA (code_convert_string_norecord
+ (build_string (str), Vlocale_coding_system, 0));
+ error ("%s/%s %s", SSDATA (host), portstring, str);
+ }
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
ip_addresses = Fnreverse (ip_addresses);
freeaddrinfo (res);
- xfree (hints);
goto open_socket;
}
-#endif /* HAVE_GETADDRINFO */
- /* We end up here if getaddrinfo is not defined, or in case no hostname
- has been specified (e.g. for a local server process). */
+ /* No hostname has been specified (e.g., a local server process). */
if (EQ (service, Qt))
port = 0;
else if (INTEGERP (service))
- port = (unsigned short) XINT (service);
+ port = XINT (service);
else
{
- struct servent *svc_info;
CHECK_STRING (service);
- svc_info = getservbyname (SSDATA (service),
- (socktype == SOCK_DGRAM ? "udp" : "tcp"));
- if (svc_info == 0)
- error ("Unknown service: %s", SDATA (service));
- port = ntohs (svc_info->s_port);
- }
-
-#ifndef HAVE_GETADDRINFO
- if (!NILP (host))
- {
- struct hostent *host_info_ptr;
-
- /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
- as it may `hang' Emacs for a very long time. */
- immediate_quit = 1;
- QUIT;
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- host_info_ptr = gethostbyname ((const char *) SDATA (host));
- immediate_quit = 0;
-
- if (host_info_ptr)
+ port = -1;
+ if (SBYTES (service) != 0)
{
- ip_addresses = Fcons (conv_numerical_to_lisp
- ((unsigned char *) host_info_ptr->h_addr,
- host_info_ptr->h_length,
- port),
- Qnil);
- }
- else
- /* Attempt to interpret host as numeric inet address. This
- only works for IPv4 addresses. */
- {
- unsigned long numeric_addr = inet_addr (SSDATA (host));
-
- if (numeric_addr == -1)
- error ("Unknown host \"%s\"", SDATA (host));
-
- ip_addresses = Fcons (conv_numerical_to_lisp
- ((unsigned char *) &numeric_addr, 4, port),
- Qnil);
+ /* Allow the service to be a string containing the port number,
+ because that's allowed if you have getaddrbyname. */
+ char *service_end;
+ long int lport = strtol (SSDATA (service), &service_end, 10);
+ if (service_end == SSDATA (service) + SBYTES (service))
+ port = lport;
+ else
+ {
+ struct servent *svc_info
+ = getservbyname (SSDATA (service),
+ socktype == SOCK_DGRAM ? "udp" : "tcp");
+ if (svc_info)
+ port = ntohs (svc_info->s_port);
+ }
}
+ }
+ if (! (0 <= port && port < 1 << 16))
+ {
+ AUTO_STRING (unknown_service, "Unknown service: %s");
+ xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
}
-#endif /* not HAVE_GETADDRINFO */
open_socket:
pset_command (p, Qt);
p->pid = 0;
p->backlog = 5;
- p->is_non_blocking_client = 0;
- p->is_server = 0;
+ p->is_non_blocking_client = false;
+ p->is_server = false;
p->port = port;
p->socktype = socktype;
p->ai_protocol = ai_protocol;
#ifdef HAVE_GETADDRINFO_A
- p->dns_requests = NULL;
+ p->dns_request = NULL;
#endif
#ifdef HAVE_GNUTLS
tem = Fplist_get (contact, QCtls_parameters);
{
/* Don't support network sockets when non-blocking mode is
not available, since a blocked Emacs is not useful. */
- p->is_server = 1;
+ p->is_server = true;
if (TYPE_RANGED_INTEGERP (int, tem))
p->backlog = XINT (tem);
}
/* :nowait BOOL */
if (!p->is_server && socktype != SOCK_DGRAM
- && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
- {
-#ifndef NON_BLOCKING_CONNECT
- error ("Non-blocking connect not supported");
-#else
- p->is_non_blocking_client = 1;
-#endif
- }
+ && !NILP (Fplist_get (contact, QCnowait)))
+ p->is_non_blocking_client = true;
#ifdef HAVE_GETADDRINFO_A
- /* If we're doing async address resolution, the list of addresses
- here will be nil, so we postpone connecting to the server. */
+ /* With async address resolution, the list of addresses is empty, so
+ postpone connecting to the server. */
if (!p->is_server && NILP (ip_addresses))
{
- p->dns_requests = dns_requests;
+ p->dns_request = dns_request;
p->status = Qconnect;
+ return proc;
}
- else
- {
- connect_network_socket (proc, ip_addresses);
- }
-#else /* HAVE_GETADDRINFO_A */
- connect_network_socket (proc, ip_addresses);
#endif
+ connect_network_socket (proc, ip_addresses, 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
chan_process[inchannel] = Qnil;
FD_CLR (inchannel, &input_wait_mask);
FD_CLR (inchannel, &non_keyboard_wait_mask);
-#ifdef NON_BLOCKING_CONNECT
if (FD_ISSET (inchannel, &connect_wait_mask))
{
FD_CLR (inchannel, &connect_wait_mask);
if (--num_pending_connects < 0)
emacs_abort ();
}
-#endif
if (inchannel == max_process_desc)
{
/* We just closed the highest-numbered process input descriptor,
{
struct Lisp_Process *p = XPROCESS (proc);
Lisp_Object ip_addresses = Qnil;
- int ret = 0;
/* Sanity check. */
- if (! p->dns_requests)
+ if (! p->dns_request)
return Qnil;
- ret = gai_error (p->dns_requests[0]);
+ int ret = gai_error (p->dns_request);
if (ret == EAI_INPROGRESS)
return Qt;
{
struct addrinfo *res;
- for (res = p->dns_requests[0]->ar_result; res; res = res->ai_next)
+ 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),
pset_status (p, (list2
(Qfailed,
concat3 (build_string ("Name lookup of "),
- build_string (p->dns_requests[0]->ar_name),
+ build_string (p->dns_request->ar_name),
build_string (" failed")))));
}
#endif /* HAVE_GETADDRINFO_A */
static void
-wait_for_socket_fds (Lisp_Object process, char *name)
+wait_for_socket_fds (Lisp_Object process, char const *name)
{
- while (XPROCESS (process)->infd < 0 &&
- EQ (XPROCESS (process)->status, Qconnect))
+ while (XPROCESS (process)->infd < 0
+ && EQ (XPROCESS (process)->status, Qconnect))
{
- add_to_log ("Waiting for socket from %s...\n", name);
+ add_to_log ("Waiting for socket from %s...", build_string (name));
wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
}
}
{
while (EQ (XPROCESS (process)->status, Qconnect))
{
- add_to_log ("Waiting for connection...\n");
+ add_to_log ("Waiting for connection...");
wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
}
}
wait_for_tls_negotiation (Lisp_Object process)
{
#ifdef HAVE_GNUTLS
- while (XPROCESS (process)->gnutls_p &&
- XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
+ while (XPROCESS (process)->gnutls_p
+ && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
{
- add_to_log ("Waiting for TLS...\n");
+ add_to_log ("Waiting for TLS...");
wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
}
#endif
struct timespec got_output_end_time = invalid_timespec ();
enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
int got_some_output = -1;
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ bool retry_for_async;
+#endif
ptrdiff_t count = SPECPDL_INDEX ();
/* Close to the current time if known, an invalid timespec otherwise. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
-#if defined (HAVE_GETADDRINFO_A) || defined (HAVE_GNUTLS)
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
{
- Lisp_Object ip_addresses;
Lisp_Object process_list_head, aproc;
struct Lisp_Process *p;
+ retry_for_async = false;
FOR_EACH_PROCESS(process_list_head, aproc)
{
p = XPROCESS (aproc);
{
#ifdef HAVE_GETADDRINFO_A
/* Check for pending DNS requests. */
- if (p->dns_requests)
+ if (p->dns_request)
{
- ip_addresses = check_for_dns (aproc);
- if (!NILP (ip_addresses) &&
- !EQ (ip_addresses, Qt))
- connect_network_socket (aproc, ip_addresses);
+ Lisp_Object ip_addresses = check_for_dns (aproc);
+ if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt))
+ connect_network_socket (aproc, ip_addresses, Qnil);
+ else
+ retry_for_async = true;
}
#endif
#ifdef HAVE_GNUTLS
/* Continue TLS negotiation. */
- if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED &&
- p->is_non_blocking_client)
+ if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
+ && p->is_non_blocking_client)
{
gnutls_try_handshake (p);
p->gnutls_handshakes_tried++;
if (p->gnutls_initstage == GNUTLS_STAGE_READY)
{
- gnutls_verify_boot (proc, Qnil);
+ gnutls_verify_boot (aproc, Qnil);
finish_after_tls_connection (aproc);
}
- else if (p->gnutls_handshakes_tried >
- GNUTLS_EMACS_HANDSHAKES_LIMIT)
+ else
{
- deactivate_process (aproc);
- pset_status (p, list2 (Qfailed,
- build_string ("TLS negotiation failed")));
+ retry_for_async = true;
+ if (p->gnutls_handshakes_tried
+ > GNUTLS_EMACS_HANDSHAKES_LIMIT)
+ {
+ deactivate_process (aproc);
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ }
}
}
#endif
timeout = make_timespec (0, 0);
if ((pselect (max (max_process_desc, max_input_desc) + 1,
&Atemp,
-#ifdef NON_BLOCKING_CONNECT
(num_pending_connects > 0 ? &Ctemp : NULL),
-#else
- NULL,
-#endif
NULL, &timeout, NULL)
<= 0))
{
if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
now = invalid_timespec ();
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ if (retry_for_async
+ && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
+ {
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = ASYNC_RETRY_NSEC;
+ }
+#endif
+
#if defined (HAVE_NS)
nfds = ns_select
#elif defined (HAVE_GLIB)
list2 (Qexit, make_number (256)));
}
}
-#ifdef NON_BLOCKING_CONNECT
if (FD_ISSET (channel, &Writeok)
&& FD_ISSET (channel, &connect_wait_mask))
{
{
#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 (NILP (p->gnutls_boot_parameters)
+ && !p->gnutls_p)
#endif
{
pset_status (p, Qrun);
}
}
}
-#endif /* NON_BLOCKING_CONNECT */
} /* End for each file descriptor. */
} /* End while exit conditions not met. */
ssize_t rv;
struct coding_system *coding;
- if (NETCONN_P (proc)) {
- wait_while_connecting (proc);
- wait_for_tls_negotiation (proc);
- }
+ if (NETCONN_P (proc))
+ {
+ wait_while_connecting (proc);
+ wait_for_tls_negotiation (proc);
+ }
if (p->raw_status_new)
update_status (p);
Called from program, takes three arguments, PROCESS, START and END.
If the region is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter regions.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object start, Lisp_Object end)
{
Lisp_Object proc = get_process (process);
nil, indicating the current buffer's process.
If STRING is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter strings.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object string)
{
- Lisp_Object proc;
CHECK_STRING (string);
- proc = get_process (process);
-
+ Lisp_Object proc = get_process (process);
send_process (proc, SSDATA (string),
SBYTES (string), string);
return Qnil;
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- pid_t gid;
- Lisp_Object proc;
- struct Lisp_Process *p;
-
- proc = get_process (process);
- p = XPROCESS (proc);
+ Lisp_Object proc = get_process (process);
+ struct Lisp_Process *p = XPROCESS (proc);
if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
error ("Process %s is not active",
SDATA (p->name));
- gid = emacs_get_tty_pgrp (p);
+ pid_t gid = emacs_get_tty_pgrp (p);
if (gid == p->pid)
return Qnil;
break;
case SIGTSTP:
-#if defined (VSWTCH) && !defined (PREFER_VSUSP)
+#ifdef VSWTCH
sig_char = &t.c_cc[VSWTCH];
#else
sig_char = &t.c_cc[VSUSP];
Sset_process_coding_system, 1, 3, 0,
doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
DECODING will be used to decode subprocess output and ENCODING to
-encode subprocess input. */)
- (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
+encode subprocess input. */)
+ (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- if (NETCONN_P (process))
- wait_for_socket_fds (process, "set-process-coding-system");
-
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
- if (p->infd < 0)
- error ("Input file descriptor of %s closed", SDATA (p->name));
- if (p->outfd < 0)
- error ("Output file descriptor of %s closed", SDATA (p->name));
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
pset_decode_coding_system (p, decoding);
pset_encode_coding_system (p, encoding);
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
suppressed. */)
(Lisp_Object process, Lisp_Object flag)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- if (NETCONN_P (process))
- wait_for_socket_fds (process, "set-process-filter-multibyte");
-
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
if (NILP (flag))
pset_decode_coding_system
(p, raw_text_coding_system (p->decode_coding_system));
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
(Lisp_Object process)
{
- register struct Lisp_Process *p;
- struct coding_system *coding;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
if (p->infd < 0)
return Qnil;
- coding = proc_decode_coding_system[p->infd];
+ struct coding_system *coding = proc_decode_coding_system[p->infd];
return (CODING_FOR_UNIBYTE (coding) ? Qnil : 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));
-#ifdef NON_BLOCKING_CONNECT
FD_ZERO (&connect_wait_mask);
num_pending_connects = 0;
-#endif
process_output_delay_count = 0;
process_output_skip = 0;
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;
#define ADD_SUBFEATURE(key, val) \
subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
-#ifdef NON_BLOCKING_CONNECT
ADD_SUBFEATURE (QCnowait, Qt);
-#endif
#ifdef DATAGRAM_SOCKETS
ADD_SUBFEATURE (QCtype, Qdatagram);
#endif
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);
}