X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/76bf44370e7b1215bb8f6125eea03102fc8f786d..e4324bdf565fd934afa7558d4356f040d3a66c6e:/src/process.c diff --git a/src/process.c b/src/process.c index 10c79ab14a..9c09aeefa6 100644 --- a/src/process.c +++ b/src/process.c @@ -284,6 +284,7 @@ static Lisp_Object chan_process[FD_SETSIZE]; #ifdef HAVE_GETADDRINFO_A /* Pending DNS requests. */ static Lisp_Object dns_processes; +static void wait_for_socket_fds (Lisp_Object process, char *name); #endif /* Alist of elements (NAME . PROCESS). */ @@ -1029,6 +1030,7 @@ The string argument is normally a multibyte string, except: struct Lisp_Process *p; CHECK_PROCESS (process); + p = XPROCESS (process); /* Don't signal an error if the process's input file descriptor @@ -1117,7 +1119,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size, 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)) @@ -1194,6 +1197,10 @@ list of keywords. */) 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, @@ -2372,7 +2379,7 @@ conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int { 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++) @@ -2423,6 +2430,9 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_ CHECK_PROCESS (process); + if (NETCONN_P (process)) + wait_for_socket_fds (process, "process-datagram-address"); + if (!DATAGRAM_CONN_P (process)) return Qnil; @@ -2442,6 +2452,9 @@ Returns nil upon error setting address, ADDRESS otherwise. */) CHECK_PROCESS (process); + if (NETCONN_P (process)) + wait_for_socket_fds (process, "set-process-datagram-address"); + if (!DATAGRAM_CONN_P (process)) return Qnil; @@ -2610,6 +2623,8 @@ OPTION is not a supported option, return nil instead; otherwise return t. */) 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"); @@ -2987,8 +3002,6 @@ void set_network_socket_coding_system (Lisp_Object proc) } 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); @@ -3066,13 +3079,14 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) { Lisp_Object params = contact, key, val; - while (!NILP (params)) { - key = XCAR (params); - params = XCDR (params); - val = XCAR (params); - params = XCDR (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) @@ -3303,7 +3317,7 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) if (inch > max_process_desc) max_process_desc = inch; - set_network_socket_coding_system (proc); + setup_process_coding_systems (proc); #ifdef HAVE_GNUTLS /* Continue the asynchronous connection. */ @@ -3311,16 +3325,50 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) { Lisp_Object boot, params = p->gnutls_boot_parameters; - p->gnutls_boot_parameters = Qnil; boot = Fgnutls_boot (proc, XCAR (params), XCDR (params)); - if (NILP (boot) || STRINGP (boot)) { - deactivate_process (proc); - if (NILP (boot)) - pset_status (p, list2 (Qfailed, - build_string ("TLS negotiation failed"))); - else - pset_status (p, list2 (Qfailed, boot)); - } + p->gnutls_boot_parameters = Qnil; + + if (NILP (boot) || STRINGP (boot) || + p->gnutls_initstage != GNUTLS_STAGE_READY) + { + deactivate_process (proc); + if (NILP (boot)) + pset_status (p, list2 (Qfailed, + build_string ("TLS negotiation failed"))); + else + pset_status (p, list2 (Qfailed, boot)); + } + else + { + 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 @@ -3420,11 +3468,12 @@ 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 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. @@ -3453,8 +3502,10 @@ 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, and the -remaining elements should be a keyword list accepted by gnutls-boot. +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). @@ -3842,6 +3893,8 @@ usage: (make-network-process &rest ARGS) */) p->gnutls_boot_parameters = tem; #endif + set_network_socket_coding_system (proc); + unbind_to (count, Qnil); /* :server BOOL */ @@ -4597,7 +4650,11 @@ check_for_dns (Lisp_Object proc) /* Sanity check. */ if (! p->dns_requests) - return 1; + return Qnil; + + /* This process should not already be connected (or killed). */ + if (!EQ (p->status, Qconnect)) + return Qnil; ret = gai_error (p->dns_requests[0]); if (ret == EAI_INPROGRESS) @@ -4638,8 +4695,43 @@ check_for_dns (Lisp_Object proc) 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)) + { + printf("Waiting for socket from %s...\n", 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)) + { + printf("Waiting for connection...\n"); + 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 (EQ (XPROCESS (process)->status, Qconnect) && + !NILP (XPROCESS (process)->gnutls_boot_parameters)) + { + printf("Waiting for TLS...\n"); + 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 @@ -5432,11 +5524,15 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, } 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")); + if (NILP (p->gnutls_boot_parameters)) + { + 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)) { @@ -5893,6 +5989,11 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, 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)) @@ -5900,13 +6001,6 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); -#ifdef HAVE_GNUTLS - /* The TLS connection hasn't been set up yet, so we can't write - anything on the socket. */ - if (p->gnutls_boot_parameters) - return; -#endif - coding = proc_encode_coding_system[p->outfd]; Vlast_coding_system_used = CODING_ID_NAME (coding->id); @@ -6131,6 +6225,9 @@ Output from processes can arrive in between bunches. */) 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 ()); @@ -6150,6 +6247,7 @@ Output from processes can arrive in between bunches. */) Lisp_Object proc; CHECK_STRING (string); proc = get_process (process); + send_process (proc, SSDATA (string), SBYTES (string), string); return Qnil; @@ -6564,10 +6662,15 @@ process has been transmitted to the serial port. */) 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]; @@ -7018,7 +7121,12 @@ encode subprocess input. */) 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) @@ -7055,6 +7163,10 @@ suppressed. */) 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 @@ -7747,6 +7859,7 @@ syms_of_process (void) 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");