From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Robert Pluim Newsgroups: gmane.emacs.devel Subject: Re: open-{gnutls,network}-stream backwards compatibility Date: Wed, 09 Jan 2019 22:50:13 +0100 Message-ID: References: <831s5v3s9w.fsf@gnu.org> <83zhsj2arw.fsf@gnu.org> <838t0034bh.fsf@gnu.org> <83wonj1th1.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1547070554 3518 195.159.176.226 (9 Jan 2019 21:49:14 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 9 Jan 2019 21:49:14 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 09 22:49:10 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ghLin-0000ja-R4 for ged-emacs-devel@m.gmane.org; Wed, 09 Jan 2019 22:49:10 +0100 Original-Received: from localhost ([127.0.0.1]:33420 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ghLku-0004uS-Ik for ged-emacs-devel@m.gmane.org; Wed, 09 Jan 2019 16:51:20 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:49143) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ghLkC-0004sa-8i for emacs-devel@gnu.org; Wed, 09 Jan 2019 16:50:37 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ghLk4-00085Z-Bj for emacs-devel@gnu.org; Wed, 09 Jan 2019 16:50:33 -0500 Original-Received: from mail-wm1-x32a.google.com ([2a00:1450:4864:20::32a]:36832) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ghLjw-00080C-0R for emacs-devel@gnu.org; Wed, 09 Jan 2019 16:50:22 -0500 Original-Received: by mail-wm1-x32a.google.com with SMTP id p6so9919596wmc.1 for ; Wed, 09 Jan 2019 13:50:19 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:references:mail-followup-to:mail-copies-to :gmane-reply-to-list:date:message-id:mime-version; bh=0Lw0N0X45ObVJsnQOATLPuqpANTD4/tSQ0GIrppQ2vw=; b=OlyWX27Gl8+cE1k+6u5Jv9l1FpsIR3F7+sXj52pLTCncU4HxW8kdVUV2d89Hd8iugh oRnHEFrWsNndyCQzJjuVyEIvhSFx/eQbpS8N7+bEXqujhm+EAPUtfA304/c/1ChLbF4z nRc/LycnoMzctq5eRb9zP5NMU220Hjfu6ulwbVqA1qD44Z8XblBLc00h2HksokZL5Wje Z0h1n5CyYBXyVNoNA35+TrvfgS0enEjWPCS9wUTn8IhcRAB0mNTp6yHOFubepMuFVwaf dxVz2zWSsS7/1KgAx5/kSkTJjhAbinILRrJHLzQGuKEn2MzuRGWlO71jZQwgVkjPgyj2 I3Og== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:references:mail-followup-to :mail-copies-to:gmane-reply-to-list:date:message-id:mime-version; bh=0Lw0N0X45ObVJsnQOATLPuqpANTD4/tSQ0GIrppQ2vw=; b=ApL721R7ddwCCsjJKMuDABaz8r71GN9VeCtEEeghy168C1SrwGGNFu2oLYUbaUorfP 3vxLbeGz0zgHLE+9PKThwm2QRfqN8XiLFGdou/DVzATj/zRPgJ9NzIg7kGEh3FtYy26U QaU+DEa4Nu+EbIbiPHlTJSHIUwjFlKiedU3Xo3Mhz8v0dSMDDIL9w4zUJ3y5PBSKUnDH +ExmxKWB/OvuU1qLL+Wf5ag5T163W9p6tYIFckDlicyjCPhR1P6JQoYGRqHXH+zo3LTA Fhn3Zg6StUl5CR23WkwZpwD2vzetls//PGrqaB7e2ImQwdHTv+6iXNLzpKmgYhlBPVG7 bOkw== X-Gm-Message-State: AJcUukdKLncKOkeqvKF5FoiYhXgH9t2i4fuGSqfsWP/On9Ib2cjM8AwG ZcdZfZTHayVkhUD3OyUiiVRYl4eF X-Google-Smtp-Source: ALg8bN4ne1llAKKhQirH+5V4z3d9iL1bwbzJKfYagZ3E1d8MGtCYxAidjU6DHCGQWaaAowCDMUzitw== X-Received: by 2002:a1c:f509:: with SMTP id t9mr7739534wmh.76.1547070617141; Wed, 09 Jan 2019 13:50:17 -0800 (PST) Original-Received: from rpluim-mac ([2a01:e34:ecfc:a860:dd91:7904:7876:1876]) by smtp.gmail.com with ESMTPSA id q12sm12115766wmf.2.2019.01.09.13.50.15 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 09 Jan 2019 13:50:16 -0800 (PST) Mail-Followup-To: emacs-devel@gnu.org Mail-Copies-To: never Gmane-Reply-To-List: yes X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::32a X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:232282 Archived-At: Robert Pluim 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 +@code{: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