X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b1c7207dbbc5b35aa2fa6e69a3041299e881dbb6..c3ed7cea0a43ab86c9d3b1627878055844bc8656:/src/process.c diff --git a/src/process.c b/src/process.c index 198e7de399..9f2d379c33 100644 --- a/src/process.c +++ b/src/process.c @@ -267,6 +267,12 @@ static int max_process_desc; /* The largest descriptor currently in use for input; -1 if none. */ static int max_input_desc; +/* Set the external socket descriptor for Emacs to use when + `make-network-process' is called with a non-nil + `:use-external-socket' option. The value should be either -1, or + the file descriptor of a socket that is already bound. */ +static int external_sock_fd; + /* Indexed by descriptor, gives the process (if any) for that descriptor. */ static Lisp_Object chan_process[FD_SETSIZE]; static void wait_for_socket_fds (Lisp_Object, char const *); @@ -675,12 +681,7 @@ allocate_process (void) static Lisp_Object make_process (Lisp_Object name) { - register Lisp_Object val, tem, name1; - register struct Lisp_Process *p; - char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)]; - printmax_t i; - - p = allocate_process (); + struct Lisp_Process *p = allocate_process (); /* Initialize Lisp data. Note that allocate_process initializes all Lisp data to nil, so do it only for slots which should not be nil. */ pset_status (p, Qrun); @@ -690,7 +691,7 @@ make_process (Lisp_Object name) non-Lisp data, so do it only for slots which should not be zero. */ p->infd = -1; p->outfd = -1; - for (i = 0; i < PROCESS_OPEN_FDS; i++) + for (int i = 0; i < PROCESS_OPEN_FDS; i++) p->open_fd[i] = -1; #ifdef HAVE_GNUTLS @@ -700,17 +701,22 @@ make_process (Lisp_Object name) /* If name is already in use, modify it until it is unused. */ - name1 = name; - for (i = 1; ; i++) + Lisp_Object name1 = name; + for (printmax_t i = 1; ; i++) { - tem = Fget_process (name1); - if (NILP (tem)) break; - name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i)); + Lisp_Object tem = Fget_process (name1); + if (NILP (tem)) + break; + char const suffix_fmt[] = "<%"pMd">"; + char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)]; + AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i)); + name1 = concat2 (name, lsuffix); } name = name1; pset_name (p, name); pset_sentinel (p, Qinternal_default_process_sentinel); pset_filter (p, Qinternal_default_process_filter); + Lisp_Object val; XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; @@ -3075,7 +3081,8 @@ finish_after_tls_connection (Lisp_Object proc) #endif static void -connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) +connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses, + Lisp_Object use_external_socket_p) { ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count1; @@ -3089,6 +3096,15 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) struct Lisp_Process *p = XPROCESS (proc); Lisp_Object contact = p->childp; int optbits = 0; + int socket_to_use = -1; + + if (!NILP (use_external_socket_p)) + { + socket_to_use = external_sock_fd; + + /* Ensure we don't consume the external socket twice. */ + external_sock_fd = -1; + } /* Do this in case we never enter the while-loop below. */ count1 = SPECPDL_INDEX (); @@ -3109,11 +3125,15 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) sa = xmalloc (addrlen); conv_lisp_to_sockaddr (family, ip_address, sa, addrlen); - s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol); + s = socket_to_use; if (s < 0) { - xerrno = errno; - continue; + s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol); + if (s < 0) + { + xerrno = errno; + continue; + } } #ifdef DATAGRAM_SOCKETS @@ -3168,7 +3188,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) report_file_error ("Cannot set reuse option on server socket", Qnil); } - if (bind (s, sa, addrlen)) + /* If passed a socket descriptor, it should be already bound. */ + if (socket_to_use < 0 && bind (s, sa, addrlen) != 0) report_file_error ("Cannot bind server socket", Qnil); #ifdef HAVE_GETSOCKNAME @@ -3534,6 +3555,11 @@ The following network options can be specified for this connection: (this is allowed by default for a server process). :bindtodevice NAME -- bind to interface NAME. Using this may require special privileges on some systems. +:use-external-socket BOOL -- Use any pre-allocated sockets that have + been passed to Emacs. If Emacs wasn't + passed a socket, this option is silently + ignored. + Consult the relevant system programmer's manual pages for more information on using these options. @@ -3578,7 +3604,7 @@ usage: (make-network-process &rest ARGS) */) EMACS_INT port = 0; Lisp_Object tem; Lisp_Object name, buffer, host, service, address; - Lisp_Object filter, sentinel; + Lisp_Object filter, sentinel, use_external_socket_p; Lisp_Object ip_addresses = Qnil; int socktype; int family = -1; @@ -3618,6 +3644,7 @@ usage: (make-network-process &rest ARGS) */) buffer = Fplist_get (contact, QCbuffer); filter = Fplist_get (contact, QCfilter); sentinel = Fplist_get (contact, QCsentinel); + use_external_socket_p = Fplist_get (contact, QCuse_external_socket); CHECK_STRING (name); @@ -3914,7 +3941,7 @@ usage: (make-network-process &rest ARGS) */) } #endif - connect_network_socket (proc, ip_addresses); + connect_network_socket (proc, ip_addresses, use_external_socket_p); return proc; } @@ -4251,19 +4278,6 @@ Data that is unavailable is returned as nil. */) #endif } -/* If program file NAME starts with /: for quoting a magic - name, remove that, preserving the multibyteness of NAME. */ - -Lisp_Object -remove_slash_colon (Lisp_Object name) -{ - return - ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') - ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, - SBYTES (name) - 2, STRING_MULTIBYTE (name)) - : name); -} - /* Turn off input and output for process PROC. */ static void @@ -4848,7 +4862,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { Lisp_Object ip_addresses = check_for_dns (aproc); if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt)) - connect_network_socket (aproc, ip_addresses); + connect_network_socket (aproc, ip_addresses, Qnil); else retry_for_async = true; } @@ -5509,7 +5523,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, { #ifdef HAVE_GNUTLS /* If we have an incompletely set up TLS connection, - then defer the sentinel signalling until + then defer the sentinel signaling until later. */ if (NILP (p->gnutls_boot_parameters) && !p->gnutls_p) @@ -7456,6 +7470,19 @@ add_timer_wait_descriptor (int fd) #endif /* HAVE_TIMERFD */ +/* If program file NAME starts with /: for quoting a magic + name, remove that, preserving the multibyteness of NAME. */ + +Lisp_Object +remove_slash_colon (Lisp_Object name) +{ + return + ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') + ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, + SBYTES (name) - 2, STRING_MULTIBYTE (name)) + : name); +} + /* Add DESC to the set of keyboard input descriptors. */ void @@ -7713,10 +7740,10 @@ catch_child_signal (void) /* This is not called "init_process" because that is the name of a Mach system call, so it would cause problems on Darwin systems. */ void -init_process_emacs (void) +init_process_emacs (int sockfd) { #ifdef subprocesses - register int i; + int i; inhibit_sentinels = 0; @@ -7739,6 +7766,7 @@ init_process_emacs (void) FD_ZERO (&non_process_wait_mask); FD_ZERO (&write_mask); max_process_desc = max_input_desc = -1; + external_sock_fd = sockfd; memset (fd_callback_info, 0, sizeof (fd_callback_info)); FD_ZERO (&connect_wait_mask); @@ -7837,6 +7865,7 @@ syms_of_process (void) DEFSYM (QCserver, ":server"); DEFSYM (QCnowait, ":nowait"); DEFSYM (QCsentinel, ":sentinel"); + DEFSYM (QCuse_external_socket, ":use-external-socket"); DEFSYM (QCtls_parameters, ":tls-parameters"); DEFSYM (Qnsm_verify_connection, "nsm-verify-connection"); DEFSYM (QClog, ":log"); @@ -7981,13 +8010,6 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_process_filter_multibyte); defsubr (&Sprocess_filter_multibyte_p); -#endif /* subprocesses */ - - defsubr (&Sget_buffer_process); - defsubr (&Sprocess_inherit_coding_system_flag); - defsubr (&Slist_system_processes); - defsubr (&Sprocess_attributes); - { Lisp_Object subfeatures = Qnil; const struct socket_options *sopt; @@ -8020,4 +8042,10 @@ The variable takes effect when `start-process' is called. */); Fprovide (intern_c_string ("make-network-process"), subfeatures); } +#endif /* subprocesses */ + + defsubr (&Sget_buffer_process); + defsubr (&Sprocess_inherit_coding_system_flag); + defsubr (&Slist_system_processes); + defsubr (&Sprocess_attributes); }