From f3f9a3582ef2081e96d12fb92ac190ffe9c1c431 Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Thu, 24 Jan 2019 11:34:34 +0100 Subject: [PATCH] Check for client certificates when using GnuTLS This fixes Bug#33780, and extends the documentation to describe how to enable use of client certificates. * lisp/net/network-stream.el (network-stream-certificate): Correct order of parameters to plist-get. (network-stream-open-tls): Pass all received parameters to open-gnutls-stream as plist, not just :nowait. * lisp/net/gnutls.el (open-gnutls-stream): Change optional nowait arg to be plist. Derive nowait and client certificate(s) and keys(s) from plist (maybe via auth-source) and pass to gnutls-boot-parameters and gnutls-negotiate. (network-stream-certificate): Add declare-function form for it. * doc/misc/auth.texi (Help for users): Describe format to use for client key/cert specification. * doc/misc/emacs-gnutls.texi (Help For Developers): Describe usage of optional plist argument. Add crossreference to description of .authinfo format for client key/cert specification. * etc/NEWS: Describe new client certificate functionality for 'open-network-stream'. * test/lisp/net/network-stream-tests.el: Add require of network-stream. (connect-to-tls-ipv4-nowait): Bind network-security-level to 'low in order to bypass nsm prompting. (connect-to-tls-ipv6-nowait): Likewise. (open-network-stream-tls-wait): New test. (open-network-stream-tls-nowait): New test. (open-network-stream-tls): New test. (open-network-stream-tls-nocert): New test. (open-gnutls-stream-new-api-default): New test. (open-gnutls-stream-new-api-wait): New test. (open-gnutls-stream-old-api-wait): New test. (open-gnutls-stream-new-api-nowait): New test. (open-gnutls-stream-old-api-nowait): New test. (open-gnutls-stream-new-api-errors): New test. The new tests exercise 'open-network-stream' and the old and new api of 'open-gnutls-stream'. --- doc/misc/auth.texi | 9 + doc/misc/emacs-gnutls.texi | 38 ++- etc/NEWS | 7 + lisp/net/gnutls.el | 50 ++-- lisp/net/network-stream.el | 4 +- test/lisp/net/network-stream-tests.el | 367 ++++++++++++++++++++++++++ 6 files changed, 448 insertions(+), 27 deletions(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 495d9f53e15..ddfeabcba7b 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -109,6 +109,15 @@ The @code{user} is the user name. It's known as @var{:user} in @code{auth-source-search} queries. You can also use @code{login} and @code{account}. +You can also use this file to specify client certificates to use when +setting up TLS connections. The format is: +@example +machine @var{mymachine} port @var{myport} key @var{key} cert @var{cert} +@end example + +@var{key} and @var{cert} are filenames containing the key and +certificate to use respectively. + You can use spaces inside a password or other token by surrounding the token with either single or double quotes. diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index aae583c641c..add79d12e42 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -179,17 +179,35 @@ Just use @code{open-protocol-stream} or @code{open-network-stream} You should not have to use the @file{gnutls.el} functions directly. But you can test them with @code{open-gnutls-stream}. -@defun open-gnutls-stream name buffer host service &optional nowait +@defun open-gnutls-stream name buffer host service &optional parameters This function creates a buffer connected to a specific @var{host} and -@var{service} (port number or service name). The parameters and their -syntax are the same as those given to @code{open-network-stream} -(@pxref{Network,, Network Connections, elisp, The Emacs Lisp Reference -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 socket should be -asynchronous, and the connection process will be returned to the -caller before TLS negotiation has happened. +@var{service} (port number or service name). The mandatory arguments +and their syntax are the same as those given to +@code{open-network-stream} (@pxref{Network,, Network Connections, +elisp, The Emacs Lisp Reference Manual}). The connection process is +called @var{name} (made unique if necessary). This function returns +the connection process. + +The optional @var{parameters} argument is a list of keywords and +values. The only keywords which currently have any effect are +@code{:client-certificate} and @code{:nowait}. + +Passing @w{@code{:client certificate t}} triggers looking up of client +certificates matching @var{host} and @var{service} using the +@file{auth-source} library. Any resulting client certificates are passed +down to the lower TLS layers. The format used by @file{.authinfo} to +specify the per-server keys is described in @ref{Help for +users,,auth-source, auth, Emacs auth-source Library}. + +Passing @w{@code{:nowait t}} means that the socket should be asynchronous, +and the connection process will be returned to the caller before TLS +negotiation has happened. + +For historical reasons @var{parameters} can also be a symbol, which is +interpreted the same as passing a list containing @code{:nowait} and +the value of that symbol. + +Example calls: @lisp ;; open a HTTPS connection diff --git a/etc/NEWS b/etc/NEWS index fe816ef0ec5..82eab44422a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -218,6 +218,13 @@ issued), you can either set 'network-security-protocol-checks' to nil, or adjust the elements in that variable to only happen on the 'high' security level (assuming you use the 'medium' level). ++++ +** Native GnuTLS connections can now use client certificates. +Previously, this support was only available when using the external +gnutls-cli command. Call 'open-network-stream' with +':client-certificate t' to trigger looking up of per-server +certificates via 'auth-source'. + +++ ** 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 a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 78ac3fe35b1..61480f35877 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -38,6 +38,9 @@ (require 'cl-lib) (require 'puny) +(declare-function network-stream-certificate "network-stream" + (host service parameters)) + (defgroup gnutls nil "Emacs interface to the GnuTLS library." :version "24.1" @@ -138,7 +141,7 @@ node `(emacs) Network Security'." (integer :tag "Number of bits" 512)) :group 'gnutls) -(defun open-gnutls-stream (name buffer host service &optional nowait) +(defun open-gnutls-stream (name buffer host service &optional parameters) "Open a SSL/TLS connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. @@ -149,12 +152,15 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. a filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer -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 +Third arg HOST is the name of the host to connect to, or its IP address. +Fourth arg SERVICE is the 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. The connection process will be -returned to the caller before TLS negotiation has happened. +Fifth arg PARAMETERS is an optional list of keyword/value pairs. +Only :client-certificate and :nowait keywords are recognized, and +have the same meaning as for `open-network-stream'. +For historical reasons PARAMETERS can also be a symbol, which is +interpreted the same as passing a list containing :nowait and the +value of that symbol. Usage example: @@ -168,19 +174,33 @@ This is a very simple wrapper around `gnutls-negotiate'. See its documentation for the specific parameters you can use to open a GnuTLS connection, including specifying the credential type, trust and key files, and priority string." - (let ((process (open-network-stream - name buffer host service - :nowait nowait - :tls-parameters - (and nowait - (cons 'gnutls-x509pki - (gnutls-boot-parameters - :type 'gnutls-x509pki - :hostname (puny-encode-domain host))))))) + (let* ((parameters + (cond ((symbolp parameters) + (list :nowait parameters)) + ((not (cl-evenp (length parameters))) + (error "Malformed keyword list")) + ((consp parameters) + parameters) + (t + (error "Unknown parameter type")))) + (cert (network-stream-certificate host service parameters)) + (keylist (and cert (list cert))) + (nowait (plist-get parameters :nowait)) + (process (open-network-stream + name buffer host service + :nowait nowait + :tls-parameters + (and nowait + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :type 'gnutls-x509pki + :keylist keylist + :hostname (puny-encode-domain host))))))) (if nowait process (gnutls-negotiate :process process :type 'gnutls-x509pki + :keylist keylist :hostname (puny-encode-domain host))))) (define-error 'gnutls-error "GnuTLS error") diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 84ba0b85e79..4b006503d88 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -196,7 +196,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (car result)))))) (defun network-stream-certificate (host service parameters) - (let ((spec (plist-get :client-certificate parameters))) + (let ((spec (plist-get parameters :client-certificate))) (cond ((listp spec) ;; Either nil or a list with a key/certificate pair. @@ -389,7 +389,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')." (stream (if (gnutls-available-p) (open-gnutls-stream name buffer host service - (plist-get parameters :nowait)) + parameters) (require 'tls) (open-tls-stream name buffer host service))) (eoc (plist-get parameters :end-of-command))) diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 29b92da3de0..6ad0c25903f 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -25,6 +25,10 @@ ;;; Code: (require 'gnutls) +(require 'network-stream) +;; The require above is needed for 'open-network-stream' to work, but +;; it pulls in nsm, which then makes the :nowait t' tests fail unless +;; we disable the nsm, which we do by binding 'network-security-level' (ert-deftest make-local-unix-server () (skip-unless (featurep 'make-network-process '(:family local))) @@ -214,6 +218,7 @@ (skip-unless (gnutls-available-p)) (let ((server (make-tls-server 44331)) (times 0) + (network-security-level 'low) proc status) (unwind-protect (progn @@ -257,6 +262,7 @@ (skip-unless (featurep 'make-network-process '(:family ipv6))) (let ((server (make-tls-server 44333)) (times 0) + (network-security-level 'low) proc status) (unwind-protect (progn @@ -294,4 +300,365 @@ (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) + (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 nil)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (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"))))) + +(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) + (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" + 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"))))) + +(ert-deftest open-network-stream-tls () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44336)) + (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" + 44336 + :type 'tls)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (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"))))) + +(ert-deftest open-network-stream-tls-nocert () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44337)) + (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" + 44337 + :type 'tls + :client-certificate nil)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (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"))))) + +(ert-deftest open-gnutls-stream-new-api-default () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44665)) + (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-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44665)))) + (< (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-gnutls-stream-new-api-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44666)) + (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-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44666 + (list :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-gnutls-stream-old-api-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44667)) + (times 0) + nowait + 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-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44667 + nowait)))) + (< (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-gnutls-stream-new-api-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44668)) + (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-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44668 + (list :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) + (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-gnutls-stream-old-api-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44669)) + (times 0) + (network-security-level 'low) + (nowait t) + 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-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44669 + nowait)))) + (< (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) + (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-gnutls-stream-new-api-errors () + (skip-unless (gnutls-available-p)) + (should-error + (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44777 + (list t))) + (should-error + (open-gnutls-stream + "bar" + (generate-new-buffer "*foo*") + "localhost" + 44777 + (vector :nowait t)))) + ;;; network-stream-tests.el ends here -- 2.39.5