[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: open-{gnutls,network}-stream backwards compatibility
From: |
Robert Pluim |
Subject: |
Re: open-{gnutls,network}-stream backwards compatibility |
Date: |
Wed, 09 Jan 2019 22:50:13 +0100 |
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
- open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/04
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/04
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/05
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/05
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/05
- Re: open-{gnutls,network}-stream backwards compatibility,
Robert Pluim <=
- Re: open-{gnutls,network}-stream backwards compatibility, Ted Zlatanov, 2019/01/10
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/10
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/12
- Re: open-{gnutls,network}-stream backwards compatibility, Ted Zlatanov, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Ted Zlatanov, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Eli Zaretskii, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Ted Zlatanov, 2019/01/02
- Re: open-{gnutls,network}-stream backwards compatibility, Robert Pluim, 2019/01/04