/* Asynchronous subprocess control for GNU Emacs.
-Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2015 Free Software
+Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2016 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#include "coding.h"
#include "process.h"
#include "frame.h"
-#include "termhooks.h"
#include "termopts.h"
-#include "commands.h"
#include "keyboard.h"
#include "blockinput.h"
-#include "dispextern.h"
-#include "composite.h"
#include "atimer.h"
#include "sysselect.h"
#include "syssignal.h"
/* 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);
/* Alist of elements (NAME . PROCESS). */
static Lisp_Object Vprocess_alist;
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_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;
+}
+#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_requests)
+ {
+ gai_cancel (p->dns_requests[0]);
+ free_dns_request (process);
+ }
+#endif
+
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
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);
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.
struct Lisp_Process *p;
CHECK_PROCESS (process);
+
p = XPROCESS (process);
/* Don't signal an error if the process's input file descriptor
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. */)
+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. */)
(register 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,
Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
Lisp_Object xstderr, stderrproc;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1;
USE_SAFE_ALLOCA;
if (nargs == 0)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
- GCPRO1 (contact);
buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
/* Make sure that the child will be able to chdir to the current
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
- chdir, since it's in a vfork.
-
- We have to GCPRO around this because Fexpand_file_name and
- Funhandled_file_name_directory might call a file name handling
- function. The argument list is protected by the caller, so all
- we really have to worry about is buffer. */
- {
- struct gcpro gcpro1;
- GCPRO1 (buffer);
- current_dir = encode_current_directory ();
- UNGCPRO;
- }
+ chdir, since it's in a vfork. */
+ current_dir = encode_current_directory ();
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
}
else if (!NILP (xstderr))
{
- struct gcpro gcpro1, gcpro2;
CHECK_STRING (program);
- GCPRO2 (buffer, current_dir);
stderrproc = CALLN (Fmake_pipe_process,
QCname,
concat2 (name, build_string (" stderr")),
QCbuffer,
Fget_buffer_create (xstderr));
- UNGCPRO;
}
proc = make_process (name);
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
- struct gcpro gcpro1, gcpro2;
tem = Fplist_get (contact, QCcoding);
if (!NILP (tem))
args2[i++] = buffer;
for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
args2[i++] = XCAR (tem2);
- GCPRO2 (proc, current_dir);
if (!NILP (program))
coding_systems = Ffind_operation_coding_system (nargs2, args2);
- UNGCPRO;
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
args2[i++] = buffer;
for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
args2[i++] = XCAR (tem2);
- GCPRO2 (proc, current_dir);
if (!NILP (program))
coding_systems = Ffind_operation_coding_system (nargs2, args2);
- UNGCPRO;
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
&& !(SCHARS (program) > 1
&& IS_DEVICE_SEP (SREF (program, 1))))
{
- struct gcpro gcpro1, gcpro2;
-
tem = Qnil;
- GCPRO2 (buffer, current_dir);
openp (Vexec_path, program, Vexec_suffixes, &tem,
make_number (X_OK), false);
- UNGCPRO;
if (NILP (tem))
report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
tem = remove_slash_colon (tem);
Lisp_Object arg_encoding = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tem);
/* Encode the file name and put it in NEW_ARGV.
That's where the child will use it to execute the program. */
new_argc++;
}
- UNGCPRO;
-
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
char **new_argv;
else
create_pty (proc);
- UNGCPRO;
SAFE_FREE ();
return unbind_to (count, proc);
}
{
Lisp_Object proc, contact;
struct Lisp_Process *p;
- struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem;
ptrdiff_t specpdl_count;
return Qnil;
contact = Flist (nargs, args);
- GCPRO1 (contact);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
specpdl_ptr = specpdl + specpdl_count;
- UNGCPRO;
return proc;
}
{
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. */)
+Returns 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;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "set-process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
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");
: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
- :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
+(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)
struct Lisp_Process *p;
Lisp_Object contact = Qnil;
Lisp_Object proc = Qnil;
- struct gcpro gcpro1;
contact = Flist (nargs, args);
- GCPRO1 (contact);
proc = Fplist_get (contact, QCprocess);
if (NILP (proc))
error ("Not a serial process");
if (NILP (Fplist_get (p->childp, QCspeed)))
- {
- UNGCPRO;
- return Qnil;
- }
+ return Qnil;
serial_configure (p, contact);
-
- UNGCPRO;
return Qnil;
}
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)
int fd = -1;
Lisp_Object proc, contact, port;
struct Lisp_Process *p;
- struct gcpro gcpro1;
Lisp_Object name, buffer;
Lisp_Object tem, val;
ptrdiff_t specpdl_count;
return Qnil;
contact = Flist (nargs, args);
- GCPRO1 (contact);
port = Fplist_get (contact, QCport);
if (NILP (port))
specpdl_ptr = specpdl + specpdl_count;
- UNGCPRO;
return proc;
}
-/* 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
- connection has no PID; you cannot signal it. All you can do is
- stop/continue it and deactivate/close it via delete-process. */
+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 coding_systems = Qt;
+ Lisp_Object val;
-DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
- 0, MANY, 0,
- doc: /* Create and return a network server or client process.
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil; /* No error message (too late!). */
-In Emacs, network connections are represented by process objects, so
-input and output work as for subprocesses and `delete-process' closes
-a network connection. However, a network process has no process id,
-it cannot be signaled, and the status codes are different from normal
-processes.
+ /* Setup coding systems for communicating with the network stream. */
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
-Arguments are specified as keyword/argument pairs. The following
-arguments are defined:
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ 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))))
+ /* 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
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_decode_coding_system (p, val);
-:name NAME -- NAME is name for process. It is modified if necessary
-to make it unique.
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ val = Qnil;
+ else
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_encode_coding_system (p, val);
-:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
-with the process. Process output goes at end of that buffer, unless
-you specify an output stream or filter function to handle the output.
-BUFFER may be also nil, meaning that this process is not associated
-with any buffer.
+ pset_decoding_buf (p, empty_unibyte_string);
+ p->decoding_carryover = 0;
+ pset_encoding_buf (p, empty_unibyte_string);
-:host HOST -- HOST is name of the host to connect to, or its IP
-address. The symbol `local' specifies the local host. If specified
-for a server process, it must be a valid name or address for the local
-host, and only clients connecting to that address will be accepted.
+ p->inherit_coding_system_flag
+ = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
+}
-: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.)
+#ifdef HAVE_GNUTLS
+void
+finish_after_tls_connection (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object result = Qt;
-:type TYPE -- TYPE is the type of connection. The default (nil) is a
-stream type connection, `datagram' creates a datagram type connection,
-`seqpacket' creates a reliable datagram connection.
+ if (!NILP (Ffboundp (Qnsm_verify_connection)))
+ result = call3 (Qnsm_verify_connection,
+ proc,
+ Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
-:family FAMILY -- FAMILY is the address (and protocol) family for the
-service specified by HOST and SERVICE. The default (nil) is to use
-whatever address family (IPv4 or IPv6) that is defined for the host
-and port number specified by HOST and SERVICE. Other address families
-supported are:
- local -- for a local (i.e. UNIX) address specified by SERVICE.
- ipv4 -- use IPv4 address family only.
- ipv6 -- use IPv6 address family only.
+ 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
-:local ADDRESS -- ADDRESS is the local address used for the connection.
-This parameter is ignored when opening a client process. When specified
-for a server process, the FAMILY, HOST and SERVICE args are ignored.
+void
+connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+{
+ 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;
+ int addrlen;
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ int optbits = 0;
-:remote ADDRESS -- ADDRESS is the remote partner's address for the
-connection. This parameter is ignored when opening a stream server
-process. For a datagram server process, it specifies the initial
-setting of the remote datagram address. When specified for a client
-process, the FAMILY, HOST, and SERVICE args are ignored.
+ /* Do this in case we never enter the while-loop below. */
+ count1 = SPECPDL_INDEX ();
+ s = -1;
-The format of ADDRESS depends on the address family:
-- An IPv4 address is represented as an vector of integers [A B C D P]
-corresponding to numeric IP address A.B.C.D and port number P.
-- A local address is represented as a string with the address in the
-local address space.
-- An "unsupported family" address is represented by a cons (F . AV)
-where F is the family number and AV is a vector containing the socket
-address data with one element per address data byte. Do not rely on
-this format in portable code, as it may depend on implementation
-defined constants, data sizes, and data structure alignment.
+ while (!NILP (ip_addresses))
+ {
+ ip_address = XCAR (ip_addresses);
+ ip_addresses = XCDR (ip_addresses);
-:coding CODING -- If CODING is a symbol, it specifies the coding
-system used for both reading and writing for this process. If CODING
-is a cons (DECODING . ENCODING), DECODING is used for reading, and
-ENCODING is used for writing.
+#ifdef WINDOWSNT
+ retry_connect:
+#endif
-: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.
+ addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
+ if (sa)
+ free (sa);
+ sa = xmalloc (addrlen);
+ conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
-:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
-running when Emacs is exited.
+ s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
-:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
-In the stopped state, a server process does not accept new
-connections, and a client process does not handle incoming traffic.
-The stopped state is cleared by `continue-process' and set by
-`stop-process'.
+#ifdef DATAGRAM_SOCKETS
+ if (!p->is_server && p->socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
-:filter FILTER -- Install FILTER as the process filter.
+#ifdef NON_BLOCKING_CONNECT
+ if (p->is_non_blocking_client)
+ {
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+ if (ret < 0)
+ {
+ xerrno = errno;
+ emacs_close (s);
+ s = -1;
+ continue;
+ }
+ }
+#endif
-:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
-process filter are multibyte, otherwise they are unibyte.
-If this keyword is not specified, the strings are multibyte if
-the default value of `enable-multibyte-characters' is non-nil.
+ /* Make us close S if quit. */
+ record_unwind_protect_int (close_file_unwind, s);
-:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+ /* Parse network options in the arg list. We simply ignore anything
+ which isn't a known option (including other keywords). An error
+ is signaled if setting a known option fails. */
+ {
+ Lisp_Object params = contact, key, val;
-:log LOG -- Install LOG as the server process log function. This
-function is called when the server accepts a network connection from a
-client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
-is the server process, CLIENT is the new process for the connection,
-and MESSAGE is a string.
+ while (!NILP (params))
+ {
+ key = XCAR (params);
+ params = XCDR (params);
+ val = XCAR (params);
+ params = XCDR (params);
+ optbits |= set_socket_option (s, key, val);
+ }
+ }
-:plist PLIST -- Install PLIST as the new process's initial plist.
+ if (p->is_server)
+ {
+ /* Configure as a server socket. */
-: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
-pending connection queue (also known as the backlog); the default
-queue length is 5. Default is to create a client process.
+ /* SO_REUSEADDR = 1 is default for server sockets; must specify
+ explicit :reuseaddr key to override this. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ if (!(optbits & (1 << OPIX_REUSEADDR)))
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket", Qnil);
+ }
-The following network options can be specified for this connection:
+ if (bind (s, sa, addrlen))
+ report_file_error ("Cannot bind server socket", Qnil);
-:broadcast BOOL -- Allow send and receive of datagram broadcasts.
-:dontroute BOOL -- Only send to directly connected hosts.
-:keepalive BOOL -- Send keep-alive messages on network stream.
-:linger BOOL or TIMEOUT -- Send queued messages before closing.
+#ifdef HAVE_GETSOCKNAME
+ if (p->port == 0)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ {
+ 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
+
+ if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
+ report_file_error ("Cannot listen on server socket", Qnil);
+
+ break;
+ }
+
+ immediate_quit = 1;
+ QUIT;
+
+ ret = connect (s, sa, addrlen);
+ xerrno = errno;
+
+ if (ret == 0 || xerrno == EISCONN)
+ {
+ /* The unwind-protect will be discarded afterwards.
+ Likewise for immediate_quit. */
+ 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)
+ {
+ /* Unlike most other syscalls connect() cannot be called
+ again. (That would return EALREADY.) The proper way to
+ wait for completion is pselect(). */
+ int sc;
+ socklen_t len;
+ fd_set fdset;
+ retry_select:
+ FD_ZERO (&fdset);
+ FD_SET (s, &fdset);
+ QUIT;
+ sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
+ if (sc == -1)
+ {
+ if (errno == EINTR)
+ goto retry_select;
+ else
+ report_file_error ("Failed select", Qnil);
+ }
+ eassert (sc > 0);
+
+ len = sizeof xerrno;
+ eassert (FD_ISSET (s, &fdset));
+ if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
+ report_file_error ("Failed getsockopt", Qnil);
+ if (xerrno)
+ report_file_errno ("Failed connect", Qnil, xerrno);
+ break;
+ }
+#endif /* !WINDOWSNT */
+
+ immediate_quit = 0;
+
+ /* Discard the unwind protect closing S. */
+ specpdl_ptr = specpdl + count1;
+ emacs_close (s);
+ s = -1;
+
+#ifdef WINDOWSNT
+ if (xerrno == EINTR)
+ goto retry_connect;
+#endif
+ }
+
+ if (s >= 0)
+ {
+#ifdef DATAGRAM_SOCKETS
+ if (p->socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ emacs_abort ();
+
+ datagram_address[s].sa = xmalloc (addrlen);
+ datagram_address[s].len = addrlen;
+ if (p->is_server)
+ {
+ Lisp_Object remote;
+ 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);
+ if (rlen != 0 && rfamily == family
+ && rlen == addrlen)
+ conv_lisp_to_sockaddr (rfamily, remote,
+ datagram_address[s].sa, rlen);
+ }
+ }
+ else
+ memcpy (datagram_address[s].sa, sa, addrlen);
+ }
+#endif
+
+ contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
+ conv_sockaddr_to_lisp (sa, addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!p->is_server)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
+ }
+#endif
+ }
+
+ immediate_quit = 0;
+
+ if (s < 0)
+ {
+ /* If non-blocking got this far - and failed - assume non-blocking is
+ not supported after all. This is probably a wrong assumption, but
+ the normal blocking calls to open-network-stream handles this error
+ better. */
+ if (p->is_non_blocking_client)
+ return;
+
+ report_file_errno ((p->is_server
+ ? "make server process failed"
+ : "make client process failed"),
+ contact, xerrno);
+ }
+
+ inch = s;
+ outch = s;
+
+ chan_process[inch] = proc;
+
+ fcntl (inch, F_SETFL, O_NONBLOCK);
+
+ p = XPROCESS (proc);
+ p->open_fd[SUBPROCESS_STDIN] = inch;
+ p->infd = inch;
+ p->outfd = outch;
+
+ /* Discard the unwind protect for closing S, if any. */
+ specpdl_ptr = specpdl + count1;
+
+ /* Unwind bind_polling_period and request_sigio. */
+ unbind_to (count, Qnil);
+
+ if (p->is_server && p->socktype != SOCK_DGRAM)
+ pset_status (p, Qlisten);
+
+ /* Make the process marker point into the process buffer (if any). */
+ if (BUFFERP (p->buffer))
+ set_marker_both (p->mark, p->buffer,
+ 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,
+ in that case, we still need to signal this like a non-blocking
+ connection. */
+ pset_status (p, Qconnect);
+ if (!FD_ISSET (inch, &connect_wait_mask))
+ {
+ FD_SET (inch, &connect_wait_mask);
+ FD_SET (inch, &write_mask);
+ num_pending_connects++;
+ }
+ }
+ 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))
+ || (EQ (p->status, Qlisten) && NILP (p->command)))
+ {
+ FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ }
+
+ if (inch > max_process_desc)
+ max_process_desc = inch;
+
+ /* 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, 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
+ connection has no PID; you cannot signal it. All you can do is
+ stop/continue it and deactivate/close it via delete-process. */
+
+DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
+ 0, MANY, 0,
+ doc: /* Create and return a network server or client process.
+
+In Emacs, network connections are represented by process objects, so
+input and output work as for subprocesses and `delete-process' closes
+a network connection. However, a network process has no process id,
+it cannot be signaled, and the status codes are different from normal
+processes.
+
+Arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:host HOST -- HOST is name of the host to connect to, or its IP
+address. The symbol `local' specifies the local host. If specified
+for a server process, it must be a valid name or address for the local
+host, and only clients connecting to that address will be accepted.
+
+: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.)
+
+:type TYPE -- TYPE is the type of connection. The default (nil) is a
+stream type connection, `datagram' creates a datagram type connection,
+`seqpacket' creates a reliable datagram connection.
+
+:family FAMILY -- FAMILY is the address (and protocol) family for the
+service specified by HOST and SERVICE. The default (nil) is to use
+whatever address family (IPv4 or IPv6) that is defined for the host
+and port number specified by HOST and SERVICE. Other address families
+supported are:
+ local -- for a local (i.e. UNIX) address specified by SERVICE.
+ ipv4 -- use IPv4 address family only.
+ ipv6 -- use IPv6 address family only.
+
+:local ADDRESS -- ADDRESS is the local address used for the connection.
+This parameter is ignored when opening a client process. When specified
+for a server process, the FAMILY, HOST and SERVICE args are ignored.
+
+:remote ADDRESS -- ADDRESS is the remote partner's address for the
+connection. This parameter is ignored when opening a stream server
+process. For a datagram server process, it specifies the initial
+setting of the remote datagram address. When specified for a client
+process, the FAMILY, HOST, and SERVICE args are ignored.
+
+The format of ADDRESS depends on the address family:
+- An IPv4 address is represented as an vector of integers [A B C D P]
+corresponding to numeric IP address A.B.C.D and port number P.
+- A local address is represented as a string with the address in the
+local address space.
+- An "unsupported family" address is represented by a cons (F . AV)
+where F is the family number and AV is a vector containing the socket
+address data with one element per address data byte. Do not rely on
+this format in portable code, as it may depend on implementation
+defined constants, data sizes, and data structure alignment.
+
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
+
+: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.
+
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a server process does not accept new
+connections, and a client process does not handle incoming traffic.
+The stopped state is cleared by `continue-process' and set by
+`stop-process'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte if
+the default value of `enable-multibyte-characters' is non-nil.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+:log LOG -- Install LOG as the server process log function. This
+function is called when the server accepts a network connection from a
+client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
+is the server process, CLIENT is the new process for the connection,
+and MESSAGE is a string.
+
+: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
+pending connection queue (also known as the backlog); the default
+queue length is 5. Default is to create a client process.
+
+The following network options can be specified for this connection:
+
+:broadcast BOOL -- Allow send and receive of datagram broadcasts.
+:dontroute BOOL -- Only send to directly connected hosts.
+:keepalive BOOL -- Send keep-alive messages on network stream.
+:linger BOOL or TIMEOUT -- Send queued messages before closing.
:oobinline BOOL -- Place out-of-band data in receive data stream.
:priority INT -- Set protocol defined priority for sent packets.
:reuseaddr BOOL -- Allow reusing a recently used local address
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
-#ifdef HAVE_GETADDRINFO
- struct addrinfo ai, *res, *lres;
- struct addrinfo hints;
+#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETADDRINFO_A)
+ struct addrinfo *hints;
const char *portstring;
char portbuf[128];
-#else /* HAVE_GETADDRINFO */
- struct _emacs_addrinfo
- {
- int ai_family;
- int ai_socktype;
- int ai_protocol;
- int ai_addrlen;
- struct sockaddr *ai_addr;
- struct _emacs_addrinfo *ai_next;
- } ai, *res, *lres;
-#endif /* HAVE_GETADDRINFO */
- struct sockaddr_in address_in;
+#endif
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
- int port;
- int ret = 0;
- int xerrno = 0;
- int s = -1, outch, inch;
- struct gcpro gcpro1;
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count1;
- Lisp_Object colon_address; /* Either QClocal or QCremote. */
+ int port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
- bool is_non_blocking_client = 0;
- bool is_server = 0;
- int backlog = 5;
+ Lisp_Object ip_addresses = Qnil;
int socktype;
int family = -1;
+ int ai_protocol = 0;
+#ifdef HAVE_GETADDRINFO_A
+ struct gaicb **dns_requests = NULL;
+#endif
+ ptrdiff_t count = SPECPDL_INDEX ();
if (nargs == 0)
return Qnil;
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
- GCPRO1 (contact);
#ifdef WINDOWSNT
/* Ensure socket support is loaded if available. */
else
error ("Unsupported connection type");
- /* :server BOOL */
- tem = Fplist_get (contact, QCserver);
- if (!NILP (tem))
- {
- /* Don't support network sockets when non-blocking mode is
- not available, since a blocked Emacs is not useful. */
- is_server = 1;
- if (TYPE_RANGED_INTEGERP (int, tem))
- backlog = XINT (tem);
- }
-
- /* Make colon_address an alias for :local (server) or :remote (client). */
- colon_address = is_server ? QClocal : QCremote;
-
- /* :nowait BOOL */
- if (!is_server && socktype != SOCK_DGRAM
- && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
- {
-#ifndef NON_BLOCKING_CONNECT
- error ("Non-blocking connect not supported");
-#else
- is_non_blocking_client = 1;
-#endif
- }
-
name = Fplist_get (contact, QCname);
buffer = Fplist_get (contact, QCbuffer);
filter = Fplist_get (contact, QCfilter);
CHECK_STRING (name);
- /* Initialize addrinfo structure in case we don't use getaddrinfo. */
- ai.ai_socktype = socktype;
- ai.ai_protocol = 0;
- ai.ai_next = NULL;
- res = &ai;
-
/* :local ADDRESS or :remote ADDRESS */
- address = Fplist_get (contact, colon_address);
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ address = Fplist_get (contact, QCremote);
+ else
+ address = Fplist_get (contact, QClocal);
if (!NILP (address))
{
host = service = Qnil;
- if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ai.ai_family = family;
- ai.ai_addr = alloca (ai.ai_addrlen);
- conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+
+ ip_addresses = Fcons (address, Qnil);
goto open_socket;
}
else
error ("Unknown address family");
- ai.ai_family = family;
-
/* :service SERVICE -- string, integer (port number), or t (random port). */
service = Fplist_get (contact, QCservice);
/* :host HOST -- hostname, ip address, or 'local for localhost. */
host = Fplist_get (contact, QChost);
- if (!NILP (host))
+ if (NILP (host))
+ {
+ /* The "connection" function gets it bind info from the address we're
+ given, so use this dummy address if nothing is specified. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ host = build_string ("127.0.0.1");
+ }
+ else
{
if (EQ (host, Qlocal))
/* Depending on setup, "localhost" may map to different IPv4 and/or
host = Qnil;
}
CHECK_STRING (service);
- memset (&address_un, 0, sizeof address_un);
- address_un.sun_family = AF_LOCAL;
if (sizeof address_un.sun_path <= SBYTES (service))
error ("Service name too long");
- lispstpcpy (address_un.sun_path, service);
- ai.ai_addr = (struct sockaddr *) &address_un;
- ai.ai_addrlen = sizeof address_un;
+ ip_addresses = Fcons (service, Qnil);
goto open_socket;
}
#endif
}
#endif
-#ifdef HAVE_GETADDRINFO
- /* If we have a host, use getaddrinfo to resolve both host and service.
- Otherwise, use getservbyname to lookup the service. */
+#if defined (HAVE_GETADDRINFO) || defined (HAVE_GETADDRINFO_A)
if (!NILP (host))
{
{
sprintf (portbuf, "%"pI"d", XINT (service));
portstring = portbuf;
- }
- else
- {
- CHECK_STRING (service);
- portstring = SSDATA (service);
- }
-
- immediate_quit = 1;
- QUIT;
- memset (&hints, 0, sizeof (hints));
- hints.ai_flags = 0;
- hints.ai_family = family;
- hints.ai_socktype = socktype;
- hints.ai_protocol = 0;
-
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
- if (ret)
-#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
-#else
- error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
-#endif
- immediate_quit = 0;
-
- 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). */
-
- if (EQ (service, Qt))
- port = 0;
- else if (INTEGERP (service))
- port = htons ((unsigned short) 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;
- }
-
- memset (&address_in, 0, sizeof address_in);
- address_in.sin_family = family;
- address_in.sin_addr.s_addr = INADDR_ANY;
- address_in.sin_port = 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 (SDATA (host));
- immediate_quit = 0;
-
- if (host_info_ptr)
- {
- memcpy (&address_in.sin_addr, host_info_ptr->h_addr,
- host_info_ptr->h_length);
- family = host_info_ptr->h_addrtype;
- address_in.sin_family = family;
- }
- else
- /* Attempt to interpret host as numeric inet address. */
- {
- unsigned long numeric_addr;
- numeric_addr = inet_addr (SSDATA (host));
- if (numeric_addr == -1)
- error ("Unknown host \"%s\"", SDATA (host));
-
- memcpy (&address_in.sin_addr, &numeric_addr,
- sizeof (address_in.sin_addr));
- }
-
- }
-#endif /* not HAVE_GETADDRINFO */
-
- ai.ai_family = family;
- ai.ai_addr = (struct sockaddr *) &address_in;
- ai.ai_addrlen = sizeof address_in;
-
- open_socket:
-
- /* Do this in case we never enter the for-loop below. */
- count1 = SPECPDL_INDEX ();
- s = -1;
-
- for (lres = res; lres; lres = lres->ai_next)
- {
- ptrdiff_t optn;
- int optbits;
-
-#ifdef WINDOWSNT
- retry_connect:
-#endif
-
- s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC,
- lres->ai_protocol);
- if (s < 0)
- {
- xerrno = errno;
- continue;
- }
-
-#ifdef DATAGRAM_SOCKETS
- if (!is_server && socktype == SOCK_DGRAM)
- break;
-#endif /* DATAGRAM_SOCKETS */
-
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
+ }
+ else
{
- ret = fcntl (s, F_SETFL, O_NONBLOCK);
- if (ret < 0)
- {
- xerrno = errno;
- emacs_close (s);
- s = -1;
- continue;
- }
+ CHECK_STRING (service);
+ portstring = SSDATA (service);
}
-#endif
- /* Make us close S if quit. */
- record_unwind_protect_int (close_file_unwind, s);
+ hints = xzalloc (sizeof (struct addrinfo));
+ hints->ai_flags = 0;
+ hints->ai_family = family;
+ hints->ai_socktype = socktype;
+ hints->ai_protocol = 0;
+ }
- /* Parse network options in the arg list.
- We simply ignore anything which isn't a known option (including other keywords).
- An error is signaled if setting a known option fails. */
- for (optn = optbits = 0; optn < nargs - 1; optn += 2)
- optbits |= set_socket_option (s, args[optn], args[optn + 1]);
+#endif
- if (is_server)
- {
- /* Configure as a server socket. */
+#ifdef HAVE_GETADDRINFO_A
+ if (!NILP (Fplist_get (contact, QCnowait)) &&
+ !NILP (host))
+ {
+ int ret;
- /* SO_REUSEADDR = 1 is default for server sockets; must specify
- explicit :reuseaddr key to override this. */
-#ifdef HAVE_LOCAL_SOCKETS
- if (family != AF_LOCAL)
-#endif
- if (!(optbits & (1 << OPIX_REUSEADDR)))
- {
- int optval = 1;
- if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
- report_file_error ("Cannot set reuse option on server socket", Qnil);
- }
+ 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;
- if (bind (s, lres->ai_addr, lres->ai_addrlen))
- report_file_error ("Cannot bind server socket", Qnil);
+ ret = getaddrinfo_a (GAI_NOWAIT, dns_requests, 1, NULL);
+ if (ret)
+ error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
-#ifdef HAVE_GETSOCKNAME
- if (EQ (service, Qt))
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- {
- ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
- service = make_number (ntohs (sa1.sin_port));
- contact = Fplist_put (contact, QCservice, service);
- }
- }
-#endif
+ goto open_socket;
+ }
+#endif /* HAVE_GETADDRINFO_A */
- if (socktype != SOCK_DGRAM && listen (s, backlog))
- report_file_error ("Cannot listen on server socket", Qnil);
+#ifdef HAVE_GETADDRINFO
+ /* If we have a host, use getaddrinfo to resolve both host and service.
+ Otherwise, use getservbyname to lookup the service. */
- break;
- }
+ if (!NILP (host))
+ {
+ struct addrinfo *res, *lres;
+ int ret;
immediate_quit = 1;
QUIT;
- ret = connect (s, lres->ai_addr, lres->ai_addrlen);
- xerrno = errno;
-
- if (ret == 0 || xerrno == EISCONN)
- {
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
- break;
- }
+#ifdef HAVE_RES_INIT
+ res_init ();
+#endif
-#ifdef NON_BLOCKING_CONNECT
-#ifdef EINPROGRESS
- if (is_non_blocking_client && xerrno == EINPROGRESS)
- break;
+ ret = getaddrinfo (SSDATA (host), portstring, hints, &res);
+ if (ret)
+#ifdef HAVE_GAI_STRERROR
+ error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
#else
-#ifdef EWOULDBLOCK
- if (is_non_blocking_client && xerrno == EWOULDBLOCK)
- break;
-#endif
-#endif
+ error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
+ immediate_quit = 0;
-#ifndef WINDOWSNT
- if (xerrno == EINTR)
+ for (lres = res; lres; lres = lres->ai_next)
{
- /* Unlike most other syscalls connect() cannot be called
- again. (That would return EALREADY.) The proper way to
- wait for completion is pselect(). */
- int sc;
- socklen_t len;
- fd_set fdset;
- retry_select:
- FD_ZERO (&fdset);
- FD_SET (s, &fdset);
- QUIT;
- sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
- if (sc == -1)
- {
- if (errno == EINTR)
- goto retry_select;
- else
- report_file_error ("Failed select", Qnil);
- }
- eassert (sc > 0);
-
- len = sizeof xerrno;
- eassert (FD_ISSET (s, &fdset));
- if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
- report_file_error ("Failed getsockopt", Qnil);
- if (xerrno)
- report_file_errno ("Failed connect", Qnil, xerrno);
- break;
+ ip_addresses = Fcons (conv_sockaddr_to_lisp
+ (lres->ai_addr, lres->ai_addrlen),
+ ip_addresses);
+ ai_protocol = lres->ai_protocol;
}
-#endif /* !WINDOWSNT */
-
- immediate_quit = 0;
- /* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
- emacs_close (s);
- s = -1;
+ ip_addresses = Fnreverse (ip_addresses);
-#ifdef WINDOWSNT
- if (xerrno == EINTR)
- goto retry_connect;
-#endif
- }
+ freeaddrinfo (res);
+ xfree (hints);
- if (s >= 0)
- {
-#ifdef DATAGRAM_SOCKETS
- if (socktype == SOCK_DGRAM)
- {
- if (datagram_address[s].sa)
- emacs_abort ();
- datagram_address[s].sa = xmalloc (lres->ai_addrlen);
- datagram_address[s].len = lres->ai_addrlen;
- if (is_server)
- {
- Lisp_Object remote;
- memset (datagram_address[s].sa, 0, lres->ai_addrlen);
- if (remote = Fplist_get (contact, QCremote), !NILP (remote))
- {
- int rfamily, rlen;
- rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
- if (rlen != 0 && rfamily == lres->ai_family
- && rlen == lres->ai_addrlen)
- conv_lisp_to_sockaddr (rfamily, remote,
- datagram_address[s].sa, rlen);
- }
- }
- else
- memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
- }
-#endif
- contact = Fplist_put (contact, colon_address,
- conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
-#ifdef HAVE_GETSOCKNAME
- if (!is_server)
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- contact = Fplist_put (contact, QClocal,
- conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
- }
-#endif
+ goto open_socket;
}
+#endif /* HAVE_GETADDRINFO */
- immediate_quit = 0;
+ /* We end up here if getaddrinfo is not defined, or in case no hostname
+ has been specified (e.g. for a local server process). */
-#ifdef HAVE_GETADDRINFO
- if (res != &ai)
+ if (EQ (service, Qt))
+ port = 0;
+ else if (INTEGERP (service))
+ port = (unsigned short) XINT (service);
+ else
{
- block_input ();
- freeaddrinfo (res);
- unblock_input ();
+ 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);
}
-#endif
- if (s < 0)
+#ifndef HAVE_GETADDRINFO
+ if (!NILP (host))
{
- /* If non-blocking got this far - and failed - assume non-blocking is
- not supported after all. This is probably a wrong assumption, but
- the normal blocking calls to open-network-stream handles this error
- better. */
- if (is_non_blocking_client)
- return Qnil;
-
- report_file_errno ((is_server
- ? "make server process failed"
- : "make client process failed"),
- contact, xerrno);
- }
-
- inch = s;
- outch = s;
-
- if (!NILP (buffer))
- buffer = Fget_buffer_create (buffer);
- proc = make_process (name);
-
- chan_process[inch] = proc;
-
- fcntl (inch, F_SETFL, O_NONBLOCK);
-
- p = XPROCESS (proc);
-
- pset_childp (p, contact);
- pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
- pset_type (p, Qnetwork);
-
- pset_buffer (p, buffer);
- pset_sentinel (p, sentinel);
- pset_filter (p, filter);
- pset_log (p, Fplist_get (contact, QClog));
- if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
- p->kill_without_query = 1;
- if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
- pset_command (p, Qt);
- p->pid = 0;
+ struct hostent *host_info_ptr;
- p->open_fd[SUBPROCESS_STDIN] = inch;
- p->infd = inch;
- p->outfd = outch;
+ /* 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;
- /* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
+#ifdef HAVE_RES_INIT
+ res_init ();
+#endif
- /* Unwind bind_polling_period and request_sigio. */
- unbind_to (count, Qnil);
+ host_info_ptr = gethostbyname ((const char *) SDATA (host));
+ immediate_quit = 0;
- if (is_server && socktype != SOCK_DGRAM)
- pset_status (p, Qlisten);
+ if (host_info_ptr)
+ {
+ 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));
- /* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ if (numeric_addr == -1)
+ error ("Unknown host \"%s\"", SDATA (host));
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
- {
- /* 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 (!FD_ISSET (inch, &connect_wait_mask))
- {
- FD_SET (inch, &connect_wait_mask);
- FD_SET (inch, &write_mask);
- num_pending_connects++;
+ ip_addresses = Fcons (conv_numerical_to_lisp
+ ((unsigned char *) &numeric_addr, 4, port),
+ Qnil);
}
- }
- 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))
- || (EQ (p->status, Qlisten) && NILP (p->command)))
- {
- FD_SET (inch, &input_wait_mask);
- FD_SET (inch, &non_keyboard_wait_mask);
- }
- if (inch > max_process_desc)
- max_process_desc = inch;
+ }
+#endif /* not HAVE_GETADDRINFO */
- tem = Fplist_member (contact, QCcoding);
- if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
- tem = Qnil; /* No error message (too late!). */
+ open_socket:
- {
- /* Setup coding systems for communicating with the network stream. */
- struct gcpro gcpro1;
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems = Qt;
- Lisp_Object val;
+ if (!NILP (buffer))
+ buffer = Fget_buffer_create (buffer);
+ proc = make_process (name);
+ p = XPROCESS (proc);
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qnetwork);
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCAR (val);
- }
- else if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
- || (NILP (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
- CR LF. */
- val = Qnil;
- else
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- {
- GCPRO1 (proc);
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- UNGCPRO;
- }
- if (CONSP (coding_systems))
- val = XCAR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCAR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_decode_coding_system (p, val);
+ pset_buffer (p, buffer);
+ pset_sentinel (p, sentinel);
+ pset_filter (p, filter);
+ pset_log (p, Fplist_get (contact, QClog));
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ p->kill_without_query = 1;
+ if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
+ pset_command (p, Qt);
+ p->pid = 0;
+ p->backlog = 5;
+ p->is_non_blocking_client = 0;
+ p->is_server = 0;
+ p->port = port;
+ p->socktype = socktype;
+ p->ai_protocol = ai_protocol;
+#ifdef HAVE_GETADDRINFO_A
+ p->dns_requests = NULL;
+#endif
+#ifdef HAVE_GNUTLS
+ tem = Fplist_get (contact, QCtls_parameters);
+ CHECK_LIST (tem);
+ p->gnutls_boot_parameters = tem;
+#endif
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCDR (val);
- }
- else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- val = Qnil;
- else
- {
- if (EQ (coding_systems, Qt))
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- {
- GCPRO1 (proc);
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- UNGCPRO;
- }
- }
- if (CONSP (coding_systems))
- val = XCDR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCDR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_encode_coding_system (p, val);
- }
- setup_process_coding_systems (proc);
+ set_network_socket_coding_system (proc, service, host, name);
- pset_decoding_buf (p, empty_unibyte_string);
- p->decoding_carryover = 0;
- pset_encoding_buf (p, empty_unibyte_string);
+ unbind_to (count, Qnil);
- p->inherit_coding_system_flag
- = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
+ /* :server BOOL */
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ {
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+ p->is_server = 1;
+ 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
+ }
+
+#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. */
+ if (!p->is_server && NILP (ip_addresses))
+ {
+ p->dns_requests = dns_requests;
+ p->status = Qconnect;
+ }
+ else
+ {
+ connect_network_socket (proc, ip_addresses);
+ }
+#else /* HAVE_GETADDRINFO_A */
+ connect_network_socket (proc, ip_addresses);
+#endif
- UNGCPRO;
return proc;
}
exec_sentinel (proc, concat3 (open_from, host_string, nl));
}
+#ifdef HAVE_GETADDRINFO_A
+static Lisp_Object
+check_for_dns (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object ip_addresses = Qnil;
+ int ret = 0;
+
+ /* Sanity check. */
+ if (! p->dns_requests)
+ return Qnil;
+
+ ret = gai_error (p->dns_requests[0]);
+ if (ret == EAI_INPROGRESS)
+ 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)
+ {
+ ip_addresses = Fcons (conv_sockaddr_to_lisp
+ (res->ai_addr, res->ai_addrlen),
+ ip_addresses);
+ }
+
+ ip_addresses = Fnreverse (ip_addresses);
+ }
+ /* 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_requests[0]->ar_name),
+ build_string (" failed")))));
+ }
+
+ 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 *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
bool no_avail;
int xerrno;
Lisp_Object proc;
- struct timespec timeout, end_time;
- int got_some_input = -1;
+ struct timespec timeout, end_time, timer_delay;
+ struct timespec got_output_end_time = invalid_timespec ();
+ enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
+ int got_some_output = -1;
ptrdiff_t count = SPECPDL_INDEX ();
+ /* Close to the current time if known, an invalid timespec otherwise. */
+ struct timespec now = invalid_timespec ();
+
FD_ZERO (&Available);
FD_ZERO (&Writeok);
waiting_for_user_input_p);
waiting_for_user_input_p = read_kbd;
- if (time_limit < 0)
- {
- time_limit = 0;
- nsecs = -1;
- }
- else if (TYPE_MAXIMUM (time_t) < time_limit)
+ if (TYPE_MAXIMUM (time_t) < time_limit)
time_limit = TYPE_MAXIMUM (time_t);
- /* Since we may need to wait several times,
- compute the absolute time to return at. */
- if (time_limit || nsecs > 0)
+ if (time_limit < 0 || nsecs < 0)
+ wait = MINIMUM;
+ else if (time_limit > 0 || nsecs > 0)
{
- timeout = make_timespec (time_limit, nsecs);
- end_time = timespec_add (current_timespec (), timeout);
+ wait = TIMEOUT;
+ now = current_timespec ();
+ end_time = timespec_add (now, make_timespec (time_limit, nsecs));
}
+ else
+ wait = INFINITY;
while (1)
{
- bool timeout_reduced_for_timers = false;
+ bool process_skipped = false;
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
- /* After reading input, vacuum up any leftovers without waiting. */
- if (0 <= got_some_input)
- nsecs = -1;
+#if defined (HAVE_GETADDRINFO_A) || defined (HAVE_GNUTLS)
+ {
+ Lisp_Object ip_addresses;
+ Lisp_Object process_list_head, aproc;
+ struct Lisp_Process *p;
+
+ FOR_EACH_PROCESS(process_list_head, aproc)
+ {
+ p = XPROCESS (aproc);
+
+ if (! wait_proc || p == wait_proc)
+ {
+#ifdef HAVE_GETADDRINFO_A
+ /* Check for pending DNS requests. */
+ if (p->dns_requests)
+ {
+ ip_addresses = check_for_dns (aproc);
+ if (!NILP (ip_addresses) &&
+ !EQ (ip_addresses, Qt))
+ connect_network_socket (aproc, ip_addresses);
+ }
+#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 (proc, Qnil);
+ finish_after_tls_connection (aproc);
+ }
+ else 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 (nsecs < 0)
- {
- /* A negative timeout means
- gobble output available now
- but don't wait at all. */
-
- timeout = make_timespec (0, 0);
- }
- else if (time_limit || nsecs > 0)
+ if (wait == TIMEOUT)
{
- struct timespec now = current_timespec ();
+ if (!timespec_valid_p (now))
+ now = current_timespec ();
if (timespec_cmp (end_time, now) <= 0)
break;
timeout = timespec_sub (end_time, now);
}
else
- {
- timeout = make_timespec (100000, 0);
- }
+ timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
/* Normally we run timers here.
But not if wait_for_cell; in those cases,
if (NILP (wait_for_cell)
&& just_wait_proc >= 0)
{
- struct timespec timer_delay;
-
do
{
unsigned old_timers_run = timers_run;
&& requeued_events_pending_p ())
break;
- /* A negative timeout means do not wait at all. */
- if (nsecs >= 0)
- {
- if (timespec_valid_p (timer_delay))
- {
- if (timespec_cmp (timer_delay, timeout) < 0)
- {
- timeout = timer_delay;
- timeout_reduced_for_timers = true;
- }
- }
- else
- {
- /* This is so a breakpoint can be put here. */
- wait_reading_process_output_1 ();
- }
- }
- }
+ /* This is so a breakpoint can be put here. */
+ if (!timespec_valid_p (timer_delay))
+ wait_reading_process_output_1 ();
+ }
/* Cause C-g and alarm signals to take immediate action,
and cause input available signals to zero out timeout.
/* It's okay for us to do this and then continue with
the loop, since timeout has already been zeroed out. */
clear_waiting_for_input ();
- got_some_input = status_notify (NULL, wait_proc);
+ got_some_output = status_notify (NULL, wait_proc);
if (do_display) redisplay_preserve_echo_area (13);
}
}
}
else
{
- if (got_some_input < nread)
- got_some_input = nread;
+ if (got_some_output < nread)
+ got_some_output = nread;
if (nread == 0)
break;
read_some_bytes = true;
}
else
{
-
/* Set the timeout for adaptive read buffering if any
process has non-zero read_output_skip and non-zero
read_output_delay, and we are not reading output for a
Vprocess_adaptive_read_buffering is nil. */
if (process_output_skip && check_delay > 0)
{
- int nsecs = timeout.tv_nsec;
- if (timeout.tv_sec > 0 || nsecs > READ_OUTPUT_DELAY_MAX)
- nsecs = READ_OUTPUT_DELAY_MAX;
+ int adaptive_nsecs = timeout.tv_nsec;
+ if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
+ adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
{
proc = chan_process[channel];
if (!XPROCESS (proc)->read_output_skip)
continue;
FD_CLR (channel, &Available);
+ process_skipped = true;
XPROCESS (proc)->read_output_skip = 0;
- if (XPROCESS (proc)->read_output_delay < nsecs)
- nsecs = XPROCESS (proc)->read_output_delay;
+ if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
+ adaptive_nsecs = XPROCESS (proc)->read_output_delay;
}
}
- timeout = make_timespec (0, nsecs);
+ timeout = make_timespec (0, adaptive_nsecs);
process_output_skip = 0;
}
+ /* If we've got some output and haven't limited our timeout
+ with adaptive read buffering, limit it. */
+ if (got_some_output > 0 && !process_skipped
+ && (timeout.tv_sec
+ || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
+ timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
+
+
+ if (NILP (wait_for_cell) && just_wait_proc >= 0
+ && timespec_valid_p (timer_delay)
+ && timespec_cmp (timer_delay, timeout) < 0)
+ {
+ if (!timespec_valid_p (now))
+ now = current_timespec ();
+ struct timespec timeout_abs = timespec_add (now, timeout);
+ if (!timespec_valid_p (got_output_end_time)
+ || timespec_cmp (timeout_abs, got_output_end_time) < 0)
+ got_output_end_time = timeout_abs;
+ timeout = timer_delay;
+ }
+ else
+ got_output_end_time = invalid_timespec ();
+
+ /* NOW can become inaccurate if time can pass during pselect. */
+ if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
+ now = invalid_timespec ();
+
#if defined (HAVE_NS)
nfds = ns_select
#elif defined (HAVE_GLIB)
data is available in the buffers manually. */
if (nfds == 0)
{
+ fd_set tls_available;
+ int set = 0;
+
+ FD_ZERO (&tls_available);
if (! wait_proc)
{
/* We're not waiting on a specific process, so loop
{
nfds++;
eassert (p->infd == channel);
- FD_SET (p->infd, &Available);
+ FD_SET (p->infd, &tls_available);
+ set++;
}
}
}
nfds = 1;
eassert (0 <= wait_proc->infd);
/* Set to Available. */
- FD_SET (wait_proc->infd, &Available);
+ FD_SET (wait_proc->infd, &tls_available);
+ set++;
}
}
+ if (set)
+ Available = tls_available;
}
#endif
}
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
- /* We waited the full specified time, so return now. */
- break;
+ if (nfds == 0)
+ {
+ /* Exit the main loop if we've passed the requested timeout,
+ or aren't skipping processes and got some output and
+ haven't lowered our timeout due to timers or SIGIO and
+ have waited a long amount of time due to repeated
+ timers. */
+ 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))
+ {
+ now = current_timespec ();
+ if (timespec_cmp (cmp_time, now) <= 0)
+ break;
+ }
+ }
+
if (nfds < 0)
{
if (xerrno == EINTR)
buffered-ahead character if we have one. */
nread = read_process_output (proc, channel);
- if ((!wait_proc || wait_proc == XPROCESS (proc)) && got_some_input < nread)
- got_some_input = nread;
+ if ((!wait_proc || wait_proc == XPROCESS (proc))
+ && got_some_output < nread)
+ got_some_output = nread;
if (nread > 0)
{
+ /* Vacuum up any leftovers without waiting. */
+ if (wait_proc == XPROCESS (proc))
+ wait = MINIMUM;
/* Since read_process_output can run a filter,
which can call accept-process-output,
don't try to read from any other processes
}
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))
{
QUIT;
}
- return got_some_input;
+ return got_some_output;
}
\f
/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
bool outer_running_asynch_code = running_asynch_code;
int waiting = waiting_for_user_input_p;
- /* No need to gcpro these, because all we do with them later
- is test them for EQness, and none of them should be a string. */
#if 0
Lisp_Object obuffer, okeymap;
XSETBUFFER (obuffer, current_buffer);
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);
+
send_process (proc, SSDATA (string),
SBYTES (string), string);
return Qnil;
{
Lisp_Object process_number
= string_to_number (SSDATA (process), 10, 1);
- if (INTEGERP (process_number) || FLOATP (process_number))
+ if (NUMBERP (process_number))
tem = process_number;
}
process = tem;
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];
if (inhibit_sentinels)
return;
- /* No need to gcpro these, because all we do with them later
- is test them for EQness, and none of them should be a string. */
odeactivate = Vdeactivate_mark;
#if 0
Lisp_Object obuffer, okeymap;
{
Lisp_Object proc;
Lisp_Object tail, msg;
- struct gcpro gcpro1, gcpro2;
- int got_some_input = -1;
+ int got_some_output = -1;
tail = Qnil;
msg = Qnil;
- /* We need to gcpro tail; if read_process_output calls a filter
- which deletes a process and removes the cons to which tail points
- from Vprocess_alist, and then causes a GC, tail is an unprotected
- reference. */
- GCPRO2 (tail, msg);
/* Set this now, so that if new processes are created by sentinels
that we run, we get called again to handle their status changes. */
{
int nread = read_process_output (proc, p->infd);
if ((!wait_proc || wait_proc == XPROCESS (proc))
- && got_some_input < nread)
- got_some_input = nread;
+ && got_some_output < nread)
+ got_some_output = nread;
if (nread <= 0)
break;
}
p->update_tick = p->tick;
/* Now output the message suitably. */
exec_sentinel (proc, msg);
+ if (BUFFERP (p->buffer))
+ /* In case it uses %s in mode-line-format. */
+ bset_update_mode_line (XBUFFER (p->buffer));
}
} /* end for */
- update_mode_lines = 24; /* In case buffers use %s in mode-line-format. */
- UNGCPRO;
- return got_some_input;
+ return got_some_output;
}
DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
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. */)
+encode subprocess input.
+
+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. */)
(register 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);
+
if (p->infd < 0)
error ("Input file descriptor of %s closed", SDATA (p->name));
if (p->outfd < 0)
register struct Lisp_Process *p;
CHECK_PROCESS (process);
+
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "set-process-filter-multibyte");
+
p = XPROCESS (process);
if (NILP (flag))
pset_decode_coding_system
{
register int nfds;
struct timespec end_time, timeout;
+ enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
- if (time_limit < 0)
- {
- time_limit = 0;
- nsecs = -1;
- }
- else if (TYPE_MAXIMUM (time_t) < time_limit)
+ if (TYPE_MAXIMUM (time_t) < time_limit)
time_limit = TYPE_MAXIMUM (time_t);
- /* What does time_limit really mean? */
- if (time_limit || nsecs > 0)
+ if (time_limit < 0 || nsecs < 0)
+ wait = MINIMUM;
+ else if (time_limit > 0 || nsecs > 0)
{
- timeout = make_timespec (time_limit, nsecs);
- end_time = timespec_add (current_timespec (), timeout);
+ wait = TIMEOUT;
+ end_time = timespec_add (current_timespec (),
+ make_timespec (time_limit, nsecs));
}
+ else
+ wait = INFINITY;
/* Turn off periodic alarms (in case they are in use)
and then turn off any other atimers,
/* Compute time from now till when time limit is up. */
/* Exit if already run out. */
- if (nsecs < 0)
- {
- /* A negative timeout means
- gobble output available now
- but don't wait at all. */
-
- timeout = make_timespec (0, 0);
- }
- else if (time_limit || nsecs > 0)
+ if (wait == TIMEOUT)
{
struct timespec now = current_timespec ();
if (timespec_cmp (end_time, now) <= 0)
timeout = timespec_sub (end_time, now);
}
else
- {
- timeout = make_timespec (100000, 0);
- }
+ timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
/* If our caller will not immediately handle keyboard events,
run timer events directly.
&& requeued_events_pending_p ())
break;
- if (timespec_valid_p (timer_delay) && nsecs >= 0)
+ if (timespec_valid_p (timer_delay))
{
if (timespec_cmp (timer_delay, timeout) < 0)
{
/* If we woke up due to SIGWINCH, actually change size now. */
do_pending_window_change (0);
- if ((time_limit || nsecs) && nfds == 0 && ! timeout_reduced_for_timers)
+ if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
/* We waited the full specified time, so return now. */
break;
}
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
- doc: /* Return the (or a) process associated with BUFFER.
-BUFFER may be a buffer or the name of one. */)
+ doc: /* Return the (or a) live process associated with BUFFER.
+BUFFER may be a buffer or the name of one.
+Return nil if all processes associated with BUFFER have been
+deleted or killed. */)
(register Lisp_Object buffer)
{
#ifdef subprocesses
Value is an alist where each element is a cons cell of the form
- \(KEY . VALUE)
+ (KEY . VALUE)
If this functionality is unsupported, the value is nil.
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");