[Emacs-diffs] feature/async-dns cecf6c9: Rework the mechanisms for async GnuTLS connections

[Lars Ingebrigtsen]

branch: feature/async-dns
commit cecf6c9ac58ecd9ea251241a6b8a18e0e01dbc2a
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    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 1db6c51..75fd97c 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
 
address@hidden 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 90bfe04..9e261a7 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 43b2862..222dbc6 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 d11b11c..06459fb 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 a30dd23..5526405 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 8bd555b..eb34f5f 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
 };