From: Lars Ingebrigtsen Date: Sun, 31 Jan 2016 23:27:07 +0000 (+0100) Subject: Further TLS async work X-Git-Tag: emacs-26.0.90~2520^2~48 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4ff81f8fac1270a829bb2725911bf6b614711257;p=emacs.git Further TLS async work * gnutls.c (boot_error): New function to either signal an error or return an error code. (Fgnutls_boot): Don't signal errors when running asynchronously. * process.h (pset_status): Move here from process.c to be able to use from gnutls.c. * process.c (connect_network_socket): Do the TLS boot here when running asynchronously. (wait_reading_process_output): Rework the dns_processes handling for more safety. --- diff --git a/src/gnutls.c b/src/gnutls.c index 06459fb3ccd..a0b6e0df68b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1167,6 +1167,19 @@ emacs_gnutls_global_deinit (void) } #endif +/* VARARGS 1 */ +static void +boot_error (struct Lisp_Process *p, const char *m, ...) +{ + va_list ap; + va_start (ap, m); + if (p->is_non_blocking_client) + pset_status (p, Qfailed); + else + verror (m, ap); +} + + DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. Currently only client mode is supported. Return a success/failure @@ -1246,16 +1259,23 @@ one trustfile (usually a CA bundle). */) Lisp_Object verify_error; Lisp_Object prime_bits; Lisp_Object warnings; + struct Lisp_Process *p = XPROCESS (proc); CHECK_PROCESS (proc); CHECK_SYMBOL (type); CHECK_LIST (proplist); if (NILP (Fgnutls_available_p ())) - error ("GnuTLS not available"); + { + boot_error (p, "GnuTLS not available"); + return Qnil; + } if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon)) - error ("Invalid GnuTLS credential type"); + { + boot_error (p, "Invalid GnuTLS credential type"); + return Qnil; + } hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname); priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority); @@ -1272,11 +1292,15 @@ one trustfile (usually a CA bundle). */) } else if (NILP (Flistp (verify_error))) { - error ("gnutls-boot: invalid :verify_error parameter (not a list)"); + boot_error (p, "gnutls-boot: invalid :verify_error parameter (not a list)"); + return Qnil; } if (!STRINGP (hostname)) - error ("gnutls-boot: invalid :hostname parameter (not a string)"); + { + boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)"); + return Qnil; + } c_hostname = SSDATA (hostname); state = XPROCESS (proc)->gnutls_state; @@ -1384,7 +1408,8 @@ one trustfile (usually a CA bundle). */) else { emacs_gnutls_deinit (proc); - error ("Invalid trustfile"); + boot_error (p, "Invalid trustfile"); + return Qnil; } } @@ -1408,7 +1433,8 @@ one trustfile (usually a CA bundle). */) else { emacs_gnutls_deinit (proc); - error ("Invalid CRL file"); + boot_error (p, "Invalid CRL file"); + return Qnil; } } @@ -1437,8 +1463,9 @@ one trustfile (usually a CA bundle). */) else { emacs_gnutls_deinit (proc); - error (STRINGP (keyfile) ? "Invalid client cert file" - : "Invalid client key file"); + boot_error (p, STRINGP (keyfile) ? "Invalid client cert file" + : "Invalid client key file"); + return Qnil; } } } @@ -1528,8 +1555,9 @@ one trustfile (usually a CA bundle). */) || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error))) { emacs_gnutls_deinit (proc); - error ("Certificate validation failed %s, verification code %x", - c_hostname, peer_verification); + boot_error (p, "Certificate validation failed %s, verification code %x", + c_hostname, peer_verification); + return Qnil; } else { @@ -1558,7 +1586,8 @@ one trustfile (usually a CA bundle). */) { gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); - error ("No x509 certificate was found\n"); + boot_error (p, "No x509 certificate was found\n"); + return Qnil; } /* We only check the first certificate in the given chain. */ @@ -1586,7 +1615,8 @@ one trustfile (usually a CA bundle). */) { gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); - error ("The x509 certificate does not match \"%s\"", c_hostname); + boot_error (p, "The x509 certificate does not match \"%s\"", c_hostname); + return Qnil; } else { diff --git a/src/process.c b/src/process.c index 55264058340..afb98256ba5 100644 --- a/src/process.c +++ b/src/process.c @@ -385,11 +385,6 @@ pset_sentinel (struct Lisp_Process *p, Lisp_Object val) 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; @@ -3309,11 +3304,17 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) #ifdef HAVE_GNUTLS if (!NILP (p->gnutls_async_parameters) && p->is_non_blocking_client) { - Fgnutls_boot (proc, Fcar (p->gnutls_async_parameters), - Fcdr (p->gnutls_async_parameters)); + Lisp_Object params = p->gnutls_async_parameters, boot = Qnil; + p->gnutls_async_parameters = Qnil; + boot = Fgnutls_boot (proc, Fcar (params), Fcdr (params)); + if (STRINGP (boot)) { + pset_status (p, Qfailed); + deactivate_process (proc); + } } #endif + } @@ -3798,6 +3799,9 @@ usage: (make-network-process &rest ARGS) */) #ifdef HAVE_GETADDRINFO_A p->dns_requests = NULL; #endif +#ifdef HAVE_GNUTLS + p->gnutls_async_parameters = Qnil; +#endif unbind_to (count, Qnil); @@ -4545,13 +4549,12 @@ server_accept_connection (Lisp_Object server, int channel) } #ifdef HAVE_GETADDRINFO_A -static int +static Lisp_Object check_for_dns (Lisp_Object proc) { struct Lisp_Process *p = XPROCESS (proc); Lisp_Object ip_addresses = Qnil; int ret = 0; - int connect = 0; /* Sanity check. */ if (! p->dns_requests) @@ -4559,7 +4562,7 @@ check_for_dns (Lisp_Object proc) ret = gai_error (p->dns_requests[0]); if (ret == EAI_INPROGRESS) - return 0; + return Qt; /* We got a response. */ if (ret == 0) @@ -4575,10 +4578,13 @@ check_for_dns (Lisp_Object proc) ip_addresses = Fnreverse (ip_addresses); freeaddrinfo (p->dns_requests[0]->ar_result); - connect = 1; } + /* The DNS lookup failed. */ else - pset_status (p, Qfailed); + { + pset_status (p, Qfailed); + deactivate_process (proc); + } xfree ((void *)p->dns_requests[0]->ar_request); xfree ((void *)p->dns_requests[0]->ar_name); @@ -4587,10 +4593,7 @@ check_for_dns (Lisp_Object proc) xfree (p->dns_requests); p->dns_requests = NULL; - if (connect) - connect_network_socket (proc, ip_addresses); - - return 1; + return ip_addresses; } #endif /* HAVE_GETADDRINFO_A */ @@ -4722,18 +4725,47 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #ifdef HAVE_GETADDRINFO_A if (!NILP (dns_processes)) { - Lisp_Object dns_list = dns_processes, dns; + Lisp_Object dns_list = dns_processes, dns, ip_addresses, + answers = Qnil, answer, new = Qnil; struct Lisp_Process *p; + /* This is programmed in a somewhat awkward fashion because + calling connect_network_socket might make us end up back + here again, and we would have a race condition with + segfaults. So first go through all pending requests and see + whether we got any answers. */ while (!NILP (dns_list)) { dns = Fcar (dns_list); dns_list = Fcdr (dns_list); p = XPROCESS (dns); - if (p && p->dns_requests && - (! wait_proc || p == wait_proc) && - check_for_dns (dns)) - dns_processes = Fdelq (dns, dns_processes); + if (p && p->dns_requests) + { + if (! wait_proc || p == wait_proc) + { + ip_addresses = check_for_dns (dns); + if (EQ (ip_addresses, Qt)) + new = Fcons (dns, new); + else + answers = Fcons (Fcons (dns, ip_addresses), answers); + } + else + new = Fcons (dns, new); + } + } + + /* Replace with the list of DNS requests still not responded + to. */ + dns_processes = new; + + /* Then continue the connection for the successful + requests. */ + while (!NILP (answers)) + { + answer = Fcar (answers); + answers = Fcdr (answers); + if (!NILP (Fcdr (answer))) + connect_network_socket (Fcar (answer), Fcdr (answer)); } } #endif /* HAVE_GETADDRINFO_A */ @@ -7685,6 +7717,7 @@ syms_of_process (void) staticpro (&Vprocess_alist); staticpro (&deleted_pid_list); + staticpro (&dns_processes); #endif /* subprocesses */ diff --git a/src/process.h b/src/process.h index eb34f5f0411..95c64fa73b7 100644 --- a/src/process.h +++ b/src/process.h @@ -210,6 +210,12 @@ pset_childp (struct Lisp_Process *p, Lisp_Object val) p->childp = val; } +INLINE void +pset_status (struct Lisp_Process *p, Lisp_Object val) +{ + p->status = val; +} + #ifdef HAVE_GNUTLS INLINE void pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)