[Emacs-diffs] feature/async-dns 894e21d: Doc fixes and refactorings based on comments from Eli Zaretskii

[Lars Ingebrigtsen]

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

    Doc fixes and refactorings based on comments from Eli Zaretskii
    
    * doc/lispref/processes.texi (Network Processes): Clarify the
    meaning of :tls-parameters.
    
    * lisp/net/gnutls.el (open-gnutls-stream): Clarify :nowait.
    
    * lisp/net/gnutls.el (gnutls-boot-parameters): Factor out into
    own function.
    (gnutls-negotiate): Use it.
    (open-gnutls-stream): Ditto.
    
    * src/eval.c (vformat_string): Refactor out the printing bits
    from verror.
    (verror): Use it.
    
    * src/gnutls.c (boot_error): Mark failed processes with the
    real error message.
    
    * src/lisp.h: Declare vformat_string.
---
 doc/lispref/processes.texi |    9 ++-
 doc/misc/emacs-gnutls.texi |    4 +
 lisp/net/gnutls.el         |  151 ++++++++++++++++++++++++--------------------
 lisp/net/network-stream.el |    7 +-
 src/eval.c                 |   15 +++-
 src/gnutls.c               |    2 +-
 src/lisp.h                 |    2 +
 src/process.c              |    6 +-
 8 files changed, 114 insertions(+), 82 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index e77da77..ccff138 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2420,9 +2420,12 @@ has succeeded or failed.
 
 @item :tls-parameters
 When opening a TLS connection, this should be where the first element
-is the TLS type, and the remaining elements should form a keyword list
-acceptable for @code{gnutls-boot}.  The TLS connection will then be
-negotiated after completing the connection to the host.
+is the TLS type (which should either be @code{gnutls-x509pki} or
address@hidden, and the remaining elements should form a keyword
+list acceptable for @code{gnutls-boot}.  (This keyword list can be
+optained from the @code{gnutls-boot-parameters} function.)  The TLS
+connection will then be negotiated after completing the connection to
+the host.
 
 @item :stop @var{stopped}
 If @var{stopped} is address@hidden, start the network connection or
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 75fd97c..115727f 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -181,6 +181,10 @@ 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.
 
+The @var{nowait} parameter means that the scoket should be
+asynchronous, and the connection process will be returned to the
+caller before TLS negotiation has happened.
+
 @lisp
 ;; open a HTTPS connection
 (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 8db6654..8db3450 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -110,7 +110,8 @@ Third arg is name of the host to connect to, or its IP 
address.
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 Fifth arg NOWAIT (which is optional) means that the socket should
-be opened asynchronously.
+be opened asynchronously.  The connection process will be
+returned to the caller before TLS negotiation has happened.
 
 Usage example:
 
@@ -129,12 +130,13 @@ trust and key files, and priority string."
                   :nowait nowait
                   :tls-parameters
                   (and nowait
-                       (gnutls-negotiate :type 'gnutls-x509pki
-                                         :return-keywords t
-                                         :hostname host)))))
+                       (cons 'gnutls-x509pki
+                             (gnutls-boot-parameters
+                              :type 'gnutls-x509pki
+                              :hostname host))))))
     (if nowait
         process
-      (gnutls-negotiate :process (open-network-stream name buffer host service)
+      (gnutls-negotiate :process process
                         :type 'gnutls-x509pki
                         :hostname host))))
 
@@ -149,14 +151,48 @@ 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.
 
-Note arguments are passed CL style, :type TYPE instead of just TYPE.
+Note that arguments are passed CL style, :type TYPE instead of just TYPE.
 
-TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROCESS is a process returned by `open-network-stream'.
+For the meaning of the rest of the parameters, see `gnutls-boot-parameters'."
+  (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.
+        (file-name-handler-alist nil)
+         (params (gnutls-boot-parameters
+                  :type type
+                  :hostname hostname
+                  :priority-string priority-string
+                  :trustfiles trustfiles
+                  :crlfiles crlfiles
+                  :keylist keylist
+                  :min-prime-bits min-prime-bits
+                  :verify-flags verify-flags
+                  :verify-error verify-error
+                  :verify-hostname-error verify-hostname-error))
+         ret)
+    (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)))
+
+    process))
+
+(cl-defun gnutls-boot-parameters
+    (&rest spec
+           &key type hostname priority-string
+           trustfiles crlfiles keylist min-prime-bits
+           verify-flags verify-error verify-hostname-error
+           &allow-other-keys)
+  "Return a keyword list of parameters suitable for passing to `gnutls-boot'.
+
+TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.  It defaults to `gnutls-trustfiles'.
@@ -201,71 +237,48 @@ 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.
-
-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.
-        (file-name-handler-alist nil)
-         (trustfiles (or trustfiles (gnutls-trustfiles)))
-         (priority-string (or priority-string
-                              (cond
-                               ((eq type 'gnutls-anon)
-                                "NORMAL:+ANON-DH:!ARCFOUR-128")
-                               ((eq type 'gnutls-x509pki)
-                                (if gnutls-algorithm-priority
-                                    (upcase gnutls-algorithm-priority)
-                                  "NORMAL")))))
-         (verify-error (or verify-error
-                           ;; this uses the value of `gnutls-verify-error'
-                           (cond
-                            ;; if t, pass it on
-                            ((eq gnutls-verify-error t)
-                             t)
-                            ;; if a list, look for hostname matches
-                            ((listp gnutls-verify-error)
-                             (apply 'append
-                                    (mapcar
-                                     (lambda (check)
-                                       (when (string-match (nth 0 check)
-                                                           hostname)
-                                         (nth 1 check)))
-                                     gnutls-verify-error)))
-                            ;; else it's nil
-                            (t nil))))
-         (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
-         params ret)
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
+  (let ((trustfiles (or trustfiles (gnutls-trustfiles)))
+        (priority-string (or priority-string
+                             (cond
+                              ((eq type 'gnutls-anon)
+                               "NORMAL:+ANON-DH:!ARCFOUR-128")
+                              ((eq type 'gnutls-x509pki)
+                               (if gnutls-algorithm-priority
+                                   (upcase gnutls-algorithm-priority)
+                                 "NORMAL")))))
+        (verify-error (or verify-error
+                          ;; this uses the value of `gnutls-verify-error'
+                          (cond
+                           ;; if t, pass it on
+                           ((eq gnutls-verify-error t)
+                            t)
+                           ;; if a list, look for hostname matches
+                           ((listp gnutls-verify-error)
+                            (apply 'append
+                                   (mapcar
+                                    (lambda (check)
+                                      (when (string-match (nth 0 check)
+                                                          hostname)
+                                        (nth 1 check)))
+                                    gnutls-verify-error)))
+                           ;; else it's nil
+                           (t nil))))
+        (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
 
     (when verify-hostname-error
       (push :hostname verify-error))
 
-    (setq params `(:priority ,priority-string
-                             :hostname ,hostname
-                             :loglevel ,gnutls-log-level
-                             :min-prime-bits ,min-prime-bits
-                             :trustfiles ,trustfiles
-                             :crlfiles ,crlfiles
-                             :keylist ,keylist
-                             :verify-flags ,verify-flags
-                             :verify-error ,verify-error
-                             :callbacks nil))
-
-    (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)))
-
-      process)))
+    `(:priority ,priority-string
+                :hostname ,hostname
+                :loglevel ,gnutls-log-level
+                :min-prime-bits ,min-prime-bits
+                :trustfiles ,trustfiles
+                :crlfiles ,crlfiles
+                :keylist ,keylist
+                :verify-flags ,verify-flags
+                :verify-error ,verify-error
+                :callbacks nil)))
 
 (defun gnutls-trustfiles ()
   "Return a list of usable trustfiles."
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index acbdb7a..4925805 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -140,9 +140,10 @@ a greeting from the server.
 asynchronously, if possible.
 
 :tls-parameters 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')."
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
diff --git a/src/eval.c b/src/eval.c
index 6c912bc..c01dd09 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1751,9 +1751,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object 
conditions)
 }
 
 
-/* Dump an error message; called like vprintf.  */
-void
-verror (const char *m, va_list ap)
+/* Format and return a string; called like vprintf.  */
+Lisp_Object
+vformat_string (const char *m, va_list ap)
 {
   char buf[4000];
   ptrdiff_t size = sizeof buf;
@@ -1767,7 +1767,14 @@ verror (const char *m, va_list ap)
   if (buffer != buf)
     xfree (buffer);
 
-  xsignal1 (Qerror, string);
+  return string;
+}
+
+/* Dump an error message; called like vprintf.  */
+void
+verror (const char *m, va_list ap)
+{
+  xsignal1 (Qerror, vformat_string (m, ap));
 }
 
 
diff --git a/src/gnutls.c b/src/gnutls.c
index fb3c3c2..948a0c5 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1174,7 +1174,7 @@ 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);
+    pset_status (p, list2 (Qfailed, vformat_string (m, ap)));
   else
     verror (m, ap);
 }
diff --git a/src/lisp.h b/src/lisp.h
index 02b8078..e87f475 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3908,6 +3908,8 @@ extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
 extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
 extern _Noreturn void verror (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);
+extern Lisp_Object vformat_string (const char *, va_list)
+  ATTRIBUTE_FORMAT_PRINTF (1, 0);
 extern void un_autoload (Lisp_Object);
 extern Lisp_Object call_debugger (Lisp_Object arg);
 extern void *near_C_stack_top (void);
diff --git a/src/process.c b/src/process.c
index e4dd123..0c8fc43 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3454,8 +3454,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).