From 4ea31e074dc3505bcddc5be99a67cd3eab8cf389 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 21 Jun 2011 22:39:08 +0200 Subject: [PATCH] Add support for client certificates for built-in and external STARTTLS. --- lisp/ChangeLog | 8 ++++++++ lisp/net/network-stream.el | 42 ++++++++++++++++++++++++++++++++++---- 2 files changed, 46 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 61606fb61e8..78af1aa3ca1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2011-06-21 Lars Magne Ingebrigtsen + + * net/network-stream.el (network-stream-open-starttls): Provide + support for client certificates both for external and built-in + STARTTLS. + (auth-source): Require. + (open-network-stream): Document the :client-certificate keyword. + 2011-06-21 Michael Albinus * net/tramp-cache.el (top): Don't load the persistency file when diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index b17b9ae805c..9c4ca80104d 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -44,6 +44,7 @@ (require 'tls) (require 'starttls) +(require 'auth-source) (declare-function gnutls-negotiate "gnutls" t t) ; defun* @@ -110,10 +111,17 @@ values: STARTTLS if the server supports STARTTLS, and nil otherwise. :always-query-capabilies says whether to query the server for -capabilities, even if we're doing a `plain' network connection. + capabilities, even if we're doing a `plain' network connection. + +: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 + certificate. This parameter will only be used when doing TLS + or STARTTLS connections. :nowait is a boolean that says the connection should be made -asynchronously, if possible." + asynchronously, if possible." (unless (featurep 'make-network-process) (error "Emacs was compiled without networking support")) (let ((type (plist-get parameters :type)) @@ -152,6 +160,22 @@ asynchronously, if possible." :type (nth 3 result)) (car result)))))) +(defun network-stream-certificate (host service parameters) + (let ((spec (plist-get :client-certificate parameters))) + (cond + ((listp spec) + ;; Either nil or a list with a key/certificate pair. + spec) + ((eq spec t) + (let* ((auth-info + (car (auth-source-search :max 1 + :host host + :port service))) + (key (plist-get auth-info :cert-key)) + (cert (plist-get auth-info :cert-cert))) + (and key cert + (list key cert))))))) + ;;;###autoload (defalias 'open-protocol-stream 'open-network-stream) @@ -201,14 +225,24 @@ asynchronously, if possible." starttls-extra-arguments ;; For opportunistic TLS upgrades, we don't really ;; care about the identity of the peer. - (cons "--insecure" starttls-extra-arguments)))) + (cons "--insecure" starttls-extra-arguments))) + (cert (network-stream-certificate host service parameters))) + ;; There are client certificates requested, so add them to + ;; the command line. + (when cert + (setq starttls-extra-arguments + (nconc (list "--x509keyfile" (nth 0 cert) + "--x509certfile" (nth 1 cert)) + starttls-extra-arguments))) (setq stream (starttls-open-stream name buffer host service))) (network-stream-get-response stream start eoc)) (when (string-match success-string (network-stream-command stream starttls-command eoc)) ;; The server said it was OK to begin STARTTLS negotiations. (if (fboundp 'open-gnutls-stream) - (gnutls-negotiate :process stream :hostname host) + (let ((cert (network-stream-certificate host service parameters))) + (gnutls-negotiate :process stream :hostname host + :keylist (and cert (list cert)))) (unless (starttls-negotiate stream) (delete-process stream))) (if (memq (process-status stream) '(open run)) -- 2.39.2