Re: open-{gnutls,network}-stream backwards compatibility

[Robert Pluim]

Robert Pluim <address@hidden> writes:

>> Sounds OK to me, provided we announce this in NEWS.
>
> Nah, we'll spring it on the users unannounced and see what happens :-)

Proposed changes, on top of the proposed patch for Bug#33780.

diff --git i/doc/lispref/processes.texi w/doc/lispref/processes.texi
index 72b164c5d4..487dff76d1 100644
--- i/doc/lispref/processes.texi
+++ w/doc/lispref/processes.texi
@@ -2457,8 +2457,11 @@ Network
 Either a list of the form @code{(@var{key-file} @var{cert-file})},
 naming the certificate key file and certificate file itself, or
 @code{t}, meaning to query @code{auth-source} for this information
-(@pxref{Top,,Overview, auth, The Auth-Source Manual}).
-Only used for @acronym{TLS} or @acronym{STARTTLS}.
+(@pxref{Help for users,,auth-source, auth, Emacs auth-source Library}).
+Only used for @acronym{TLS} or @acronym{STARTTLS}.  If
address@hidden:client-certificate} is not specified, behave as if it were t,
+customize @code{network-stream-use-client-certificates} to change
+this.
 
 @item :return-list @var{cons-or-nil}
 The return value of this function.  If omitted or @code{nil}, return a
diff --git i/etc/NEWS w/etc/NEWS
index 43997f8418..be62d3803e 100644
--- i/etc/NEWS
+++ w/etc/NEWS
@@ -206,6 +206,12 @@ gnutls-cli command.  Call 'open-network-stream' with
 ':client-certificate t' to trigger looking up of per-server
 certificates via 'auth-source'.
 
++++
+** New user option 'network-stream-use-client-certificates'.
+When non-nil, 'open-network-stream' performs lookups of client
+certificates using 'auth-source' as if ':client-certificate t' were
+specified.  Defaults to t.
+
 +++
 ** New function 'fill-polish-nobreak-p', to be used in 
'fill-nobreak-predicate'.
 It blocks line breaking after a one-letter word, also in the case when
diff --git i/lisp/net/network-stream.el w/lisp/net/network-stream.el
index 1723931c67..53827bcefb 100644
--- i/lisp/net/network-stream.el
+++ w/lisp/net/network-stream.el
@@ -57,6 +57,21 @@ starttls-use-gnutls
 (defvar starttls-gnutls-program)
 (defvar starttls-program)
 
+(defcustom network-stream-use-client-certificates t
+  "Whether to use client certificates for network connections.
+
+When non-nil, `open-network-stream' will automatically look for
+matching client certificates (via 'auth-source') for a
+destination server, if it is called without a :client-certificate
+keyword.  Default is t.
+
+Set to nil to disable this lookup globally.  To disable on a
+per-connection basis, specify ':client-certificate nil' when
+calling `open-network-stream'."
+  :group 'network
+  :type '(choice (const t)
+                 (const nil)))
+
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
   "Open a TCP connection to HOST, optionally with encryption.
@@ -128,10 +143,12 @@ open-network-stream
 
 :client-certificate should either be a list where the first
   element is the certificate key file name, and the second
-  element is the certificate file name itself, or t, which
-  means that `auth-source' will be queried for the key and the
+  element is the certificate file name itself, or t, which means
+  that `auth-source' will be queried for the key and the
   certificate.  This parameter will only be used when doing TLS
-  or STARTTLS connections.
+  or STARTTLS connections.  If :client-certificate is not
+  specified, behave as if it were t, customize
+  `network-stream-use-client-certificates' to change this.
 
 :use-starttls-if-possible is a boolean that says to do opportunistic
 STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
@@ -180,6 +197,11 @@ open-network-stream
                       ((memq type '(tls ssl)) 'network-stream-open-tls)
                       ((eq type 'shell) 'network-stream-open-shell)
                       (t (error "Invalid connection type %s" type))))
+            (parameters
+               (if (and network-stream-use-client-certificates
+                        (not (plist-member parameters :client-certificate)))
+                   (plist-put parameters :client-certificate t)
+                 parameters))
            result)
        (unwind-protect
            (setq result (funcall fun name work-buffer host service parameters))
diff --git i/test/lisp/net/gnutls-tests.el w/test/lisp/net/gnutls-tests.el
index ea8dd7eb66..26f662aa69 100644
--- i/test/lisp/net/gnutls-tests.el
+++ w/test/lisp/net/gnutls-tests.el
@@ -29,6 +29,7 @@
 (require 'cl-lib)
 (require 'gnutls)
 (require 'hex-util)
+(require 'network-stream)
 
 (defvar gnutls-tests-message-prefix "")
 
@@ -291,5 +292,99 @@ gnutls-tests-pad-to-multiple
                   (should-not (gnutls-tests-hexstring-equal data reverse))
                   (should (gnutls-tests-hexstring-equal input 
reverse)))))))))))
 
+(defconst network-stream-tests--datadir
+  (expand-file-name "test/data/net" source-directory))
+
+(defun make-tls-server (port)
+  (start-process "gnutls" (generate-new-buffer "*tls*")
+                 "gnutls-serv" "--http"
+                 "--x509keyfile"
+                 (concat network-stream-tests--datadir "/key.pem")
+                 "--x509certfile"
+                 (concat network-stream-tests--datadir "/cert.pem")
+                 "--port" (format "%s" port)))
+
+(ert-deftest test-gnutls-006-open-network-stream-tls-wait ()
+  (skip-unless (executable-find "gnutls-serv"))
+  (skip-unless (gnutls-available-p))
+  (let ((server (make-tls-server 44333))
+        (times 0)
+        (network-security-level 'low)
+        proc status)
+    (unwind-protect
+        (progn
+          (sleep-for 1)
+          (with-current-buffer (process-buffer server)
+            (message "gnutls-serv: %s" (buffer-string)))
+
+          ;; It takes a while for gnutls-serv to start.
+          (while (and (null (ignore-errors
+                              (setq proc (open-network-stream
+                                          "bar"
+                                          (generate-new-buffer "*foo*")
+                                          "localhost"
+                                          44333
+                                          :type 'tls
+                                          :nowait nil))))
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (should proc))
+      (if (process-live-p server) (delete-process server)))
+    (setq status (gnutls-peer-status proc))
+    (should (consp status))
+    (delete-process proc)
+    ;; This sleep-for is needed for the native MS-Windows build.  If
+    ;; it is removed, the next test mysteriously fails because the
+    ;; initial part of the echo is not received.
+    (sleep-for 0.1)
+    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
+      (should (stringp issuer))
+      (setq issuer (split-string issuer ","))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+
+(ert-deftest test-gnutls-007-open-network-stream-tls-nowait ()
+  (skip-unless (executable-find "gnutls-serv"))
+  (skip-unless (gnutls-available-p))
+  (let ((server (make-tls-server 44334))
+        (times 0)
+        (network-security-level 'low)
+        proc status)
+    (unwind-protect
+        (progn
+          (sleep-for 1)
+          (with-current-buffer (process-buffer server)
+            (message "gnutls-serv: %s" (buffer-string)))
+
+          ;; It takes a while for gnutls-serv to start.
+          (while (and (null (ignore-errors
+                              (setq proc (open-network-stream
+                                          "bar"
+                                          (generate-new-buffer "*foo*")
+                                          "localhost"
+                                          44334
+                                          :type 'tls
+                                          :nowait t))))
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (should proc)
+          (setq times 0)
+          (while (and (eq (process-status proc) 'connect)
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (skip-unless (not (eq (process-status proc) 'connect))))
+      (if (process-live-p server) (delete-process server)))
+    (setq status (gnutls-peer-status proc))
+    (message "status %s" status)
+    (should (consp status))
+    (delete-process proc)
+    ;; This sleep-for is needed for the native MS-Windows build.  If
+    ;; it is removed, the next test mysteriously fails because the
+    ;; initial part of the echo is not received.
+    (sleep-for 0.1)
+    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
+      (should (stringp issuer))
+      (setq issuer (split-string issuer ","))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+
 (provide 'gnutls-tests)
 ;;; gnutls-tests.el ends here
diff --git i/test/lisp/net/network-stream-tests.el 
w/test/lisp/net/network-stream-tests.el
index 29b92da3de..b68a99869b 100644
--- i/test/lisp/net/network-stream-tests.el
+++ w/test/lisp/net/network-stream-tests.el
@@ -25,6 +25,11 @@
 ;;; Code:
 
 (require 'gnutls)
+(require 'network-stream)
+; The require above is needed for 'open-network-stream', but it pulls
+; in nsm, which then makes the :nowait tests fail unless we disable
+; the nsm.
+(setq network-security-level 'low)
 
 (ert-deftest make-local-unix-server ()
   (skip-unless (featurep 'make-network-process '(:family local)))
@@ -294,4 +299,83 @@ make-tls-server
       (setq issuer (split-string issuer ","))
       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 
+(ert-deftest open-network-stream-tls-wait ()
+  (skip-unless (executable-find "gnutls-serv"))
+  (skip-unless (gnutls-available-p))
+  (let ((server (make-tls-server 44334))
+        (times 0)
+        proc status)
+    (unwind-protect
+        (progn
+          (sleep-for 1)
+          (with-current-buffer (process-buffer server)
+            (message "gnutls-serv: %s" (buffer-string)))
+
+          ;; It takes a while for gnutls-serv to start.
+          (while (and (null (ignore-errors
+                              (setq proc (open-network-stream
+                                          "bar"
+                                          (generate-new-buffer "*foo*")
+                                          "localhost"
+                                          44334
+                                          :type 'tls
+                                          :nowait nil))))
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (should proc))
+      (if (process-live-p server) (delete-process server)))
+    (setq status (gnutls-peer-status proc))
+    (should (consp status))
+    (delete-process proc)
+    ;; This sleep-for is needed for the native MS-Windows build.  If
+    ;; it is removed, the next test mysteriously fails because the
+    ;; initial part of the echo is not received.
+    (sleep-for 0.1)
+    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
+      (should (stringp issuer))
+      (setq issuer (split-string issuer ","))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+
+(ert-deftest open-network-stream-tls-nowait ()
+  (skip-unless (executable-find "gnutls-serv"))
+  (skip-unless (gnutls-available-p))
+  (let ((server (make-tls-server 44335))
+        (times 0)
+        proc status)
+    (unwind-protect
+        (progn
+          (sleep-for 1)
+          (with-current-buffer (process-buffer server)
+            (message "gnutls-serv: %s" (buffer-string)))
+
+          ;; It takes a while for gnutls-serv to start.
+          (while (and (null (ignore-errors
+                              (setq proc (open-network-stream
+                                          "bar"
+                                          (generate-new-buffer "*foo*")
+                                          "localhost"
+                                          44335
+                                          :type 'tls
+                                          :nowait t))))
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (should proc)
+          (setq times 0)
+          (while (and (eq (process-status proc) 'connect)
+                      (< (setq times (1+ times)) 10))
+            (sit-for 0.1))
+          (skip-unless (not (eq (process-status proc) 'connect))))
+      (if (process-live-p server) (delete-process server)))
+    (setq status (gnutls-peer-status proc))
+    (should (consp status))
+    (delete-process proc)
+    ;; This sleep-for is needed for the native MS-Windows build.  If
+    ;; it is removed, the next test mysteriously fails because the
+    ;; initial part of the echo is not received.
+    (sleep-for 0.1)
+    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
+      (should (stringp issuer))
+      (setq issuer (split-string issuer ","))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
+
 ;;; network-stream-tests.el ends here