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.

diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 1db6c517de8302f16049b5f42857725474f4b7a1..75fd97c7c7479430fca86f327e76c7c8a3ce9f5d 100644 (file)
--- 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 90bfe04af9ee8b40c5c81caa8162c937dfb43f35..9e261a7b04f85b8faeaf16e4f5f44fa7c7ed45de 100644 (file)
--- 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 43b2862e0ea09cc088eea28d9cde7727bd4b3261..222dbc64d68e64a20b7d36c1e8c1e00f5003ae16 100644 (file)
--- 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 d11b11c7c5449ef7df5f922c04d3779490f71d30..06459fb3ccd2ed5b6d735d05287845774684a1f3 100644 (file)
--- 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 a30dd23077cb6b4cfec9f138bc1232a303414b3f..552640583409fbf10d9fb0a537f8c5da2f3c3460 100644 (file)
--- 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 8bd555b83bd577fdb19d3bbb89edc8f78bca00b6..eb34f5f0411bc6844d2e596ba417111ae639dc46 100644 (file)
--- 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
 };