# 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 *);
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
-#ifdef HAVE_GETADDRINFO_A
-/* Pending DNS requests. */
-static Lisp_Object dns_process[FD_SETSIZE];
-#endif
+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) \
p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
}
static void
-pset_status (struct Lisp_Process *p, Lisp_Object val)
-{
- p->status = val;
-}
-static void
pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
{
p->tty_name = val;
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
+ p->gnutls_boot_parameters = Qnil;
#endif
/* If name is already in use, modify it until it is unused. */
deactivate_process (proc);
}
+#ifdef HAVE_GETADDRINFO_A
+static void
+free_dns_request (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+
+ if (p->dns_request->ar_result)
+ freeaddrinfo (p->dns_request->ar_result);
+ xfree (p->dns_request);
+ p->dns_request = NULL;
+}
+#endif
+
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
process = get_process (process);
p = XPROCESS (process);
+#ifdef HAVE_GETADDRINFO_A
+ if (p->dns_request)
+ {
+ int ret;
+
+ gai_cancel (p->dns_request);
+ ret = gai_error (p->dns_request);
+ if (ret == EAI_CANCELED || ret == 0)
+ free_dns_request (process);
+ else
+ {
+ /* If we're called during shutdown, we don't really about
+ freeing all the resources. Otherwise wait until
+ completion, and then free the request. */
+ if (! inhibit_sentinels)
+ {
+ gai_suspend ((struct gaicb const **) &p->dns_request, 1, NULL);
+ free_dns_request (process);
+ }
+ }
+ }
+#endif
+
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
return XPROCESS (process)->mark;
}
+static void
+set_process_filter_masks (struct Lisp_Process *p)
+{
+ if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
+ {
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
+ }
+ else if (EQ (p->filter, Qt)
+ /* Network or serial process not stopped: */
+ && !EQ (p->command, Qt))
+ {
+ FD_SET (p->infd, &input_wait_mask);
+ FD_SET (p->infd, &non_keyboard_wait_mask);
+ }
+}
+
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means default.
- 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,
if (NILP (filter))
filter = Qinternal_default_process_filter;
+ pset_filter (p, filter);
+
if (p->infd >= 0)
- {
- if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
- {
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
- }
- else if (EQ (p->filter, Qt)
- /* Network or serial process not stopped: */
- && !EQ (p->command, Qt))
- {
- FD_SET (p->infd, &input_wait_mask);
- FD_SET (p->infd, &non_keyboard_wait_mask);
- }
- }
+ set_process_filter_masks (p);
- pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
- if (XPROCESS (process)->infd < 0
+ if (NETCONN_P (process)
+ || XPROCESS (process)->infd < 0
|| (set_window_size (XPROCESS (process)->infd,
XINT (height), XINT (width))
< 0))
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;
contact = XPROCESS (process)->childp;
#ifdef DATAGRAM_SOCKETS
+
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-contact");
+
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
contact = Fplist_put (contact, QCremote,
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))
{
{
struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
- len = sizeof (sin6->sin6_addr) + 1;
+ len = sizeof (sin6->sin6_addr) / 2 + 1;
hostport = XINT (p->contents[--len]);
sin6->sin6_port = htons (hostport);
for (i = 0; i < len; i++)
#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;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
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);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "set-process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
/* 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;
if (!NETCONN1_P (p))
error ("Process is not a network process");
+ wait_for_socket_fds (process, "set-network-process-option");
+
s = p->infd;
if (s < 0)
error ("Process is not running");
return proc;
}
-void set_network_socket_coding_system (Lisp_Object proc)
+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);
Lisp_Object contact = p->childp;
- Lisp_Object service, host, name;
Lisp_Object coding_systems = Qt;
Lisp_Object val;
- service = Fplist_get (contact, QCservice);
- host = Fplist_get (contact, QChost);
- name = Fplist_get (contact, QCname);
-
tem = Fplist_member (contact, QCcoding);
if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
tem = Qnil; /* No error message (too late!). */
}
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
}
pset_encode_coding_system (p, val);
- setup_process_coding_systems (proc);
-
pset_decoding_buf (p, empty_unibyte_string);
p->decoding_carryover = 0;
pset_encoding_buf (p, empty_unibyte_string);
= !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
}
-void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+#ifdef HAVE_GNUTLS
+static void
+finish_after_tls_connection (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object result = Qt;
+
+ if (!NILP (Ffboundp (Qnsm_verify_connection)))
+ result = call3 (Qnsm_verify_connection,
+ proc,
+ Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
+
+ if (NILP (result))
+ {
+ pset_status (p, list2 (Qfailed,
+ build_string ("The Network Security Manager stopped the connections")));
+ deactivate_process (proc);
+ }
+ else
+ {
+ /* If we cleared the connection wait mask before we did
+ the TLS setup, then we have to say that the process
+ is finally "open" here. */
+ if (! FD_ISSET (p->outfd, &connect_wait_mask))
+ {
+ pset_status (p, 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"));
+ }
+ }
+}
+#endif
+
+static void
+connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
{
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;
while (!NILP (ip_addresses))
{
- ip_address = Fcar (ip_addresses);
- ip_addresses = Fcdr (ip_addresses);
+ ip_address = XCAR (ip_addresses);
+ ip_addresses = XCDR (ip_addresses);
#ifdef WINDOWSNT
retry_connect:
{
Lisp_Object params = contact, key, val;
- while (!NILP (params)) {
- key = Fcar (params);
- params = Fcdr (params);
- val = Fcar (params);
- params = Fcdr (params);
- optbits |= set_socket_option (s, key, val);
- }
+ while (!NILP (params))
+ {
+ key = XCAR (params);
+ params = XCDR (params);
+ val = XCAR (params);
+ params = XCDR (params);
+ optbits |= set_socket_option (s, key, val);
+ }
}
if (p->is_server)
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. */
+ ((struct sockaddr_in *)sa)->sin_port = sa1.sin_port;
}
}
#endif
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,
}
#endif
- contact = Fplist_put (contact, p->is_server? QCremote: QClocal,
+ contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
conv_sockaddr_to_lisp (sa, addrlen));
#ifdef HAVE_GETSOCKNAME
if (!p->is_server)
if (inch > max_process_desc)
max_process_desc = inch;
- set_network_socket_coding_system (proc);
+ /* Set up the masks based on the process filter. */
+ set_process_filter_masks (p);
+
+ setup_process_coding_systems (proc);
+
+#ifdef HAVE_GNUTLS
+ /* Continue the asynchronous connection. */
+ if (!NILP (p->gnutls_boot_parameters))
+ {
+ Lisp_Object boot, params = p->gnutls_boot_parameters;
+
+ boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
+ p->gnutls_boot_parameters = Qnil;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ /* Run sentinels, etc. */
+ finish_after_tls_connection (proc);
+ else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
+ {
+ deactivate_process (proc);
+ if (NILP (boot))
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ else
+ pset_status (p, list2 (Qfailed, boot));
+ }
+ }
+#endif
+
}
+#ifndef HAVE_GETADDRINFO
+static Lisp_Object
+conv_numerical_to_lisp (unsigned char *number, int length, int port)
+{
+ Lisp_Object address = Fmake_vector (make_number (length + 1), Qnil);
+ struct Lisp_Vector *p = XVECTOR (address);
+
+ p->contents[length] = make_number (port);
+ for (int 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
is a cons (DECODING . ENCODING), DECODING is used for reading, and
ENCODING is used for writing.
-:nowait BOOL -- If BOOL is non-nil for a stream type client process,
-return without waiting for the connection to complete; instead, the
-sentinel function will be called with second arg matching "open" (if
-successful) or "failed" when the connect completes. Default is to use
-a blocking connect (i.e. wait) for stream type connections.
+:nowait BOOL -- If NOWAIT is non-nil for a stream type client
+process, return without waiting for the connection to complete;
+instead, the sentinel function will be called with second arg matching
+"open" (if successful) or "failed" when the connect completes.
+Default is to use a blocking connect (i.e. wait) for stream type
+connections.
:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
running when Emacs is exited.
:plist PLIST -- Install PLIST as the new process's initial plist.
+:tls-parameters LIST -- is a list that should be supplied if you're
+opening a TLS connection. The first element is the TLS type (either
+`gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
+be a keyword list accepted by gnutls-boot (as returned by
+`gnutls-boot-parameters').
+
:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
If QLEN is an integer, it is used as the max. length of the server's
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
-#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETADDRINFO_A)
- struct addrinfo *hints;
+#if defined HAVE_GETADDRINFO || defined HAVE_GETADDRINFO_A
const char *portstring;
- char portbuf[128];
+ ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+ char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
#endif
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
- int port = 0;
- int ret = 0;
+ EMACS_INT port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
int family = -1;
int ai_protocol = 0;
#ifdef HAVE_GETADDRINFO_A
- struct gaicb **dns_requests;
+ struct gaicb *dns_request = NULL;
#endif
ptrdiff_t count = SPECPDL_INDEX ();
if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ip_addresses = Fcons (address, Qnil);
+ ip_addresses = list1 (address);
goto open_socket;
}
{
/* The "connection" function gets it bind info from the address we're
given, so use this dummy address if nothing is specified. */
- host = build_string ("127.0.0.1");
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ host = build_string ("127.0.0.1");
}
else
{
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 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))
- {
- 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);
+ if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
+ {
+ 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 (!NILP (host))
{
struct addrinfo *res, *lres;
+ int ret;
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));
ip_addresses = Fnreverse (ip_addresses);
freeaddrinfo (res);
- xfree (hints);
goto open_socket;
}
if (EQ (service, Qt))
port = 0;
else if (INTEGERP (service))
- port = htons ((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 = svc_info->s_port;
+
+ port = -1;
+ if (SBYTES (service) != 0)
+ {
+ /* 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));
}
#ifndef HAVE_GETADDRINFO
if (!NILP (host))
{
struct hostent *host_info_ptr;
+ unsigned char *addr;
+ int addrlen;
/* 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 (SDATA (host));
+ host_info_ptr = gethostbyname ((const char *) SDATA (host));
immediate_quit = 0;
if (host_info_ptr)
{
- ip_addresses = Ncons (make_number (host_info_ptr->h_addr,
- host_info_ptr->h_length),
- Qnil);
+ addr = (unsigned char *) host_info_ptr->h_addr;
+ addrlen = host_info_ptr->h_length;
}
else
- /* Attempt to interpret host as numeric inet address. */
+ /* Attempt to interpret host as numeric inet address. This
+ only works for IPv4 addresses. */
{
- unsigned long numeric_addr;
- numeric_addr = inet_addr (SSDATA (host));
+ unsigned long numeric_addr = inet_addr (SSDATA (host));
+
if (numeric_addr == -1)
error ("Unknown host \"%s\"", SDATA (host));
- ip_addresses = Ncons (make_number (numeric_addr), Qnil);
+ addr = (unsigned char *) &numeric_addr;
+ addrlen = 4;
}
+ ip_addresses = list1 (conv_numerical_to_lisp (addr, addrlen, port));
}
#endif /* not HAVE_GETADDRINFO */
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);
+ CHECK_LIST (tem);
+ p->gnutls_boot_parameters = tem;
+#endif
+
+ set_network_socket_coding_system (proc, service, host, name);
unbind_to (count, Qnil);
here will be nil, so we postpone connecting to the server. */
if (!p->is_server && NILP (ip_addresses))
{
- int channel;
-
- p->dns_requests = dns_requests;
+ p->dns_request = dns_request;
p->status = Qconnect;
- for (channel = 0; channel < FD_SETSIZE; ++channel)
- if (NILP (dns_process[channel]))
- {
- dns_process[channel] = proc;
- break;
- }
}
else
{
connect_network_socket (proc, ip_addresses);
}
-#endif /* HAVE_GETADDRINFO_A */
-
+#else /* HAVE_GETADDRINFO_A */
connect_network_socket (proc, ip_addresses);
+#endif
return proc;
}
}
#ifdef HAVE_GETADDRINFO_A
-static int
+static Lisp_Object
check_for_dns (Lisp_Object proc)
{
struct Lisp_Process *p = XPROCESS (proc);
Lisp_Object ip_addresses = Qnil;
int ret = 0;
- ret = gai_error (p->dns_requests[0]);
+ /* Sanity check. */
+ if (! p->dns_request)
+ return Qnil;
+
+ ret = gai_error (p->dns_request);
if (ret == EAI_INPROGRESS)
- return 0;
+ return Qt;
/* We got a response. */
if (ret == 0)
{
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),
}
ip_addresses = Fnreverse (ip_addresses);
- freeaddrinfo (p->dns_requests[0]->ar_result);
- connect_network_socket (proc, ip_addresses);
}
- else
- pset_status (p, Qfailed);
+ /* The DNS lookup failed. */
+ else if (EQ (p->status, Qconnect))
+ {
+ deactivate_process (proc);
+ pset_status (p, (list2
+ (Qfailed,
+ concat3 (build_string ("Name lookup of "),
+ build_string (p->dns_request->ar_name),
+ build_string (" failed")))));
+ }
- xfree ((void *)p->dns_requests[0]->ar_request);
- xfree (p->dns_requests[0]);
- xfree (p->dns_requests);
- return 1;
+ free_dns_request (proc);
+
+ /* This process should not already be connected (or killed). */
+ if (!EQ (p->status, Qconnect))
+ return Qnil;
+
+ return ip_addresses;
}
+
#endif /* HAVE_GETADDRINFO_A */
+static void
+wait_for_socket_fds (Lisp_Object process, char const *name)
+{
+ while (XPROCESS (process)->infd < 0
+ && EQ (XPROCESS (process)->status, Qconnect))
+ {
+ 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))
+ {
+ add_to_log ("Waiting for connection...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+}
+
+static void
+wait_for_tls_negotiation (Lisp_Object process)
+{
+#ifdef HAVE_GNUTLS
+ while (XPROCESS (process)->gnutls_p
+ && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
+ {
+ add_to_log ("Waiting for TLS...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+#endif
+}
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether Emacs was waiting
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
+ {
+ Lisp_Object process_list_head, aproc;
+ struct Lisp_Process *p;
+
+ retry_for_async = false;
+ FOR_EACH_PROCESS(process_list_head, aproc)
+ {
+ p = XPROCESS (aproc);
+
+ if (! wait_proc || p == wait_proc)
+ {
#ifdef HAVE_GETADDRINFO_A
- for (channel = 0; channel < FD_SETSIZE; ++channel)
- {
- if (! NILP (dns_process[channel]))
- {
- struct Lisp_Process *p = XPROCESS (dns_process[channel]);
- if (p && p->dns_requests &&
- (! wait_proc || p == wait_proc) &&
- check_for_dns (dns_process[channel]))
- {
- dns_process[channel] = Qnil;
- }
- }
- }
-#endif /* HAVE_GETADDRINFO_A */
+ /* 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);
+ 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)
+ {
+ gnutls_try_handshake (p);
+ p->gnutls_handshakes_tried++;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ {
+ gnutls_verify_boot (aproc, Qnil);
+ finish_after_tls_connection (aproc);
+ }
+ else
+ {
+ 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
+ }
+ }
+ }
+#endif /* GETADDRINFO_A or GNUTLS */
/* Compute time from now till when time limit is up. */
/* Exit if already run out. */
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)
}
else
{
- pset_status (p, 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"));
+#ifdef HAVE_GNUTLS
+ /* If we have an incompletely set up TLS connection,
+ then defer the sentinel signalling until
+ later. */
+ if (NILP (p->gnutls_boot_parameters)
+ && !p->gnutls_p)
+#endif
+ {
+ pset_status (p, 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 (0 <= p->infd && !EQ (p->filter, Qt)
&& !EQ (p->command, Qt))
{
ssize_t rv;
struct coding_system *coding;
+ if (NETCONN_P (proc))
+ {
+ wait_while_connecting (proc);
+ wait_for_tls_negotiation (proc);
+ }
+
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
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);
if (XINT (start) < GPT && XINT (end) > GPT)
move_gap_both (XINT (start), start_byte);
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
end_byte - start_byte, Fcurrent_buffer ());
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;
struct coding_system *coding = NULL;
int outfd;
- if (DATAGRAM_CONN_P (process))
+ proc = get_process (process);
+
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
+ if (DATAGRAM_CONN_P (proc))
return process;
- proc = get_process (process);
+
outfd = XPROCESS (proc)->outfd;
if (outfd >= 0)
coding = proc_encode_coding_system[outfd];
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);
- 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));
+
+ struct Lisp_Process *p = XPROCESS (process);
+
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);
- 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);
}
{
chan_process[i] = Qnil;
proc_buffered_char[i] = -1;
-#ifdef HAVE_GETADDRINFO_A
- dns_process[i] = Qnil;
-#endif
}
memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
DEFSYM (QCserver, ":server");
DEFSYM (QCnowait, ":nowait");
DEFSYM (QCsentinel, ":sentinel");
+ DEFSYM (QCtls_parameters, ":tls-parameters");
+ DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
DEFSYM (QClog, ":log");
DEFSYM (QCnoquery, ":noquery");
DEFSYM (QCstop, ":stop");