From cecf6c9ac58ecd9ea251241a6b8a18e0e01dbc2a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 31 Jan 2016 02:32:21 +0100 Subject: [PATCH] Rework the mechanisms for async GnuTLS connections * lisp/net/gnutls.el (open-gnutls-stream): Compute the gnutls-boot parameters and pass them to the process object. (gnutls-negotiate): New parameter :return-keywords that won't connect to anything, just compute the keywords. * lisp/url/url-http.el (url-http): Revert async TLS sentinel hack, which is no longer necessary. * src/gnutls.c (Fgnutls_asynchronous_parameters): Rename from gnutls-mark-process. * src/process.c (connect_network_socket): If we're connecting to an asynchronous TLS socket, complete the GnuTLS boot sequence here. * src/process.h: New parameter gnutls_async_parameters. --- doc/misc/emacs-gnutls.texi | 9 ++++++--- lisp/net/gnutls.el | 32 ++++++++++++++++++++++---------- lisp/url/url-http.el | 12 +----------- src/gnutls.c | 13 ++++++++----- src/process.c | 13 ++++++++++++- src/process.h | 2 +- 6 files changed, 50 insertions(+), 31 deletions(-) diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 1db6c517de8..75fd97c7c74 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -181,9 +181,6 @@ syntax are the same as those given to @code{open-network-stream} Manual}). The connection process is called @var{name} (made unique if necessary). This function returns the connection process. -If called with @var{nowait}, the process is returned immediately -(before connecting to the server). - @lisp ;; open a HTTPS connection (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https") @@ -194,6 +191,12 @@ If called with @var{nowait}, the process is returned immediately @end defun +@findex gnutls-asynchronous-parameters +If called with @var{nowait}, the process is returned immediately +(before connecting to the server). In that case, the process object +is told what parameters to use when negotiating the connection +by using the @code{gnutls-asynchronous-parameters} function. + The function @code{gnutls-negotiate} is not generally useful and it may change as needed, so please see @file{gnutls.el} for the details. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 90bfe04af9e..9e261a7b04f 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -128,8 +128,11 @@ trust and key files, and priority string." :nowait nowait))) (if nowait (progn - (gnutls-mark-process process t) - (set-process-sentinel process 'gnutls-async-sentinel) + (gnutls-asynchronous-parameters + process + (gnutls-negotiate :type 'gnutls-x509pki + :return-keywords t + :hostname host)) process) (gnutls-negotiate :process (open-network-stream name buffer host service) :type 'gnutls-x509pki @@ -153,6 +156,7 @@ trust and key files, and priority string." &key process type hostname priority-string trustfiles crlfiles keylist min-prime-bits verify-flags verify-error verify-hostname-error + return-keywords &allow-other-keys) "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. @@ -204,7 +208,13 @@ here's a recent version of the list. GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256 It must be omitted, a number, or nil; if omitted or nil it -defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." +defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. + +If RETURN-KEYWORDS, don't connect to anything, but just return +the computed parameters that we otherwise would be calling +gnutls-boot with. The return value will be a list where the +first element is the TLS type, and the rest of the list consists +of the keywords." (let* ((type (or type 'gnutls-x509pki)) ;; The gnutls library doesn't understand files delivered via ;; the special handlers, so ignore all files found via those. @@ -252,15 +262,17 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." :verify-error ,verify-error :callbacks nil)) - (gnutls-message-maybe - (setq ret (gnutls-boot process type params)) - "boot: %s" params) + (if return-keywords + (cons type params) + (gnutls-message-maybe + (setq ret (gnutls-boot process type params)) + "boot: %s" params) - (when (gnutls-errorp ret) - ;; This is a error from the underlying C code. - (signal 'gnutls-error (list process ret))) + (when (gnutls-errorp ret) + ;; This is a error from the underlying C code. + (signal 'gnutls-error (list process ret))) - process)) + process))) (defun gnutls-trustfiles () "Return a list of usable trustfiles." diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 43b2862e0ea..222dbc64d68 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1277,17 +1277,7 @@ The return value of this function is the retrieval buffer." (pcase (process-status connection) (`connect ;; Asynchronous connection - (if (not (process-sentinel connection)) - (set-process-sentinel connection 'url-http-async-sentinel) - ;; If we already have a sentinel on this process (for - ;; instance on TLS connections), then chain them - ;; together. - (let ((old (process-sentinel connection))) - (set-process-sentinel - connection - `(lambda (proc why) - (funcall ',old proc why) - (url-http-async-sentinel proc why)))))) + (set-process-sentinel connection 'url-http-async-sentinel)) (`failed ;; Asynchronous connection failed (error "Could not create connection to %s:%d" host port)) diff --git a/src/gnutls.c b/src/gnutls.c index d11b11c7c54..06459fb3ccd 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -686,13 +686,16 @@ emacs_gnutls_deinit (Lisp_Object proc) return Qt; } -DEFUN ("gnutls-mark-process", Fgnutls_mark_process, Sgnutls_mark_process, 2, 2, 0, - doc: /* Mark this process as being a pre-init GnuTLS process. */) - (Lisp_Object proc, Lisp_Object state) +DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters, + Sgnutls_asynchronous_parameters, 2, 2, 0, + doc: /* Mark this process as being a pre-init GnuTLS process. +The second parameter is the list of parameters to feed to gnutls-boot +to finish setting up the connection. */) + (Lisp_Object proc, Lisp_Object params) { CHECK_PROCESS (proc); - XPROCESS (proc)->gnutls_wait_p = !NILP (state); + XPROCESS (proc)->gnutls_async_parameters = params; return Qnil; } @@ -1703,7 +1706,7 @@ syms_of_gnutls (void) make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); defsubr (&Sgnutls_get_initstage); - defsubr (&Sgnutls_mark_process); + defsubr (&Sgnutls_asynchronous_parameters); defsubr (&Sgnutls_errorp); defsubr (&Sgnutls_error_fatalp); defsubr (&Sgnutls_error_string); diff --git a/src/process.c b/src/process.c index a30dd23077c..55264058340 100644 --- a/src/process.c +++ b/src/process.c @@ -715,6 +715,7 @@ make_process (Lisp_Object name) #ifdef HAVE_GNUTLS p->gnutls_initstage = GNUTLS_STAGE_EMPTY; + p->gnutls_async_parameters = Qnil; #endif /* If name is already in use, modify it until it is unused. */ @@ -3305,6 +3306,14 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses) max_process_desc = inch; set_network_socket_coding_system (proc); + +#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)); + p->gnutls_async_parameters = Qnil; + } +#endif } @@ -5817,7 +5826,9 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, error ("Output file descriptor of %s is closed", SDATA (p->name)); #ifdef HAVE_GNUTLS - if (p->gnutls_wait_p) + /* The TLS connection hasn't been set up yet, so we can't write + anything on the socket. */ + if (p->gnutls_async_parameters) return; #endif diff --git a/src/process.h b/src/process.h index 8bd555b83bd..eb34f5f0411 100644 --- a/src/process.h +++ b/src/process.h @@ -191,8 +191,8 @@ struct Lisp_Process unsigned int gnutls_extra_peer_verification; int gnutls_log_level; int gnutls_handshakes_tried; + Lisp_Object gnutls_async_parameters; bool_bf gnutls_p : 1; - bool_bf gnutls_wait_p : 1; #endif }; -- 2.39.5