From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends Date: Fri, 11 Nov 2022 20:30:23 -0800 Message-ID: <87bkpcu74w.fsf__33213.4463403904$1668227480$gmane$org@neverwas.me> References: <87wn8cb0ym.fsf@neverwas.me> <874jvdardn.fsf__3771.40490324877$1667692584$gmane$org@neverwas.me> <87pme09vis.fsf@gmx.de> <87a653z7dl.fsf@neverwas.me> <878rkjl1vd.fsf@disroot.org> <877d026uym.fsf@neverwas.me> <87tu35eehq.fsf@disroot.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="16618"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Damien Cassou , =?UTF-8?Q?Bj=C3=B6rn?= Bidar , emacs-erc@gnu.org, Michael Albinus , 58985@debbugs.gnu.org To: Akib Azmain Turja Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sat Nov 12 05:31:13 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1otiAi-00048d-Ew for geb-bug-gnu-emacs@m.gmane-mx.org; Sat, 12 Nov 2022 05:31:12 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1otiAa-0008LL-V8; Fri, 11 Nov 2022 23:31:04 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1otiAZ-0008Ki-Ie for bug-gnu-emacs@gnu.org; Fri, 11 Nov 2022 23:31:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1otiAZ-0000Hb-8b for bug-gnu-emacs@gnu.org; Fri, 11 Nov 2022 23:31:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1otiAX-00009F-Qz for bug-gnu-emacs@gnu.org; Fri, 11 Nov 2022 23:31:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 12 Nov 2022 04:31:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58985 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 58985-submit@debbugs.gnu.org id=B58985.1668227443545 (code B ref 58985); Sat, 12 Nov 2022 04:31:01 +0000 Original-Received: (at 58985) by debbugs.gnu.org; 12 Nov 2022 04:30:43 +0000 Original-Received: from localhost ([127.0.0.1]:47141 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1otiAD-00008h-FL for submit@debbugs.gnu.org; Fri, 11 Nov 2022 23:30:43 -0500 Original-Received: from mail-108-mta102.mxroute.com ([136.175.108.102]:37917) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1otiAA-00008T-QN for 58985@debbugs.gnu.org; Fri, 11 Nov 2022 23:30:40 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta102.mxroute.com (ZoneMTA) with ESMTPSA id 1846a1a6f640006e99.002 for <58985@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Sat, 12 Nov 2022 04:30:28 +0000 X-Zone-Loop: c798404f2223514469f2e40fb957d53d365881a85574 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=wYpgmPhozdt6c+TZtG5MkUI4Kv3IPA7rIAhb1XcZZng=; b=eeXFr7u90RDUpgF/IUfLxC+MyC /lRyMTHaz0WRSa75xW6w9m8epuJI0L6I3R8XZRhIyQvZud5N7IJ2MVRLMWxSneaFn2Xj5IGm/5eYq ukCVS3cRVTWJCVoXuJZaEv91ob6uNQgcl1sGe9mykY+Nvhd1SOZ2Q1/faL6a1+t3bNH7Gw0PTitqz ySIkjr2T7NRxmvKX7QxbzpPmAp/0ZbpSE017Gb0BufDqqZvF4x6wLopwMwEgFtUzKTEPYHKiLE/Qm AhpOtwabl9z7iHfj756PY6a1V9YJAgt+q0nT0OMmpvm/n6mzaaGr9NF8IeL83rAvPpqyO+nqvfIWq zgY3LITg==; In-Reply-To: <87tu35eehq.fsf@disroot.org> (Akib Azmain Turja's message of "Fri, 11 Nov 2022 20:45:53 +0600") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:247631 Archived-At: --=-=-= Content-Type: text/plain Akib Azmain Turja writes: > Why the closure doesn't capture "s"? For me, the following code > captures "s" (obviously with lexical binding): (just let-wrapped version > of your code) > > (let ((e '(:secret "topsecret"))) > (when-let* ((s (plist-get e :secret)) ; s not captured by closure > (v (auth-source--obfuscate s))) > (setf (plist-get e :secret) > (lambda () (auth-source--deobfuscate v)))) > e) > ;; => (:secret > ;; (closure > ;; ((p #1) > ;; (v . "XIcHKKIKtavKgK8J6zXP1w==-N/XAaAOqAtGcCzKGKX71og==") > ;; (s . "topsecret") ;; LEAKED!!! > ;; (e :secret #1) > ;; t) > ;; nil > ;; (auth-source--deobfuscate v))) > Looks like you don't have: commit 1b1ffe07897ebe06cf96ab423fad3cde9fd6c981 Author: Stefan Monnier Date: Mon Oct 17 17:11:40 2022 -0400 (Ffunction): Make interpreted closures safe for space It's easiest to just make a habit of applying patches on the latest HEAD. Once you do, you'll find that the output of your example changes. If ELPA's Compat ever takes an interest, I suppose a backported version could just `byte-compile' the lambda. >> + (push e out))))) > > [...] > >> +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) >> + (when-let ((m (string-match auth-source-pass--match-regexp path))) > > Why do you let-bound "m"? Because I am slow and blind, I guess. > I can't find any use of it in the body. Go figure. (Thanks.) >> +(defun auth-source-pass--find-match-many (hosts users ports require max) >> + "Return plists for valid combinations of HOSTS, USERS, PORTS. >> +Each plist contains, at the very least, a host and a secret." >> + (let ((seen (make-hash-table :test #'equal)) >> + (entries (auth-source-pass-entries)) >> + out) >> + (catch 'done >> + (dolist (host hosts out) >> + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) >> + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) >> + (setq p nil)) >> + (dolist (user (or users (list u))) >> + (dolist (port (or ports (list p))) >> + (dolist (e entries) >> + (when-let* >> + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed >> + seen e (integerp port)))) >> + ((equal host (plist-get m :host))) >> + ((auth-source-pass--match-parts m :port port require)) >> + ((auth-source-pass--match-parts m :user user require)) >> + (parsed (auth-source-pass-parse-entry e)) >> + ;; For now, ignore body-content pairs, if any, >> + ;; from `auth-source-pass--parse-data'. >> + (secret (or (auth-source-pass--get-attr 'secret parsed) >> + (not (memq :secret require))))) >> + (push >> + `( :host ,host ; prefer user-provided :host over h >> + ,@(and-let* ((u (plist-get m :user))) (list :user u)) >> + ,@(and-let* ((p (plist-get m :port))) (list :port p)) >> + ,@(and secret (not (eq secret t)) (list :secret secret))) >> + out) >> + (when (or (zerop (cl-decf max)) >> + (null (setq entries (remove e entries)))) > > Remove will create a lot of garbage, e.g. (let ((x '(1 2 3 4 5))) > (eq (remove 6 x) x)) and (let ((x '(1 2 3 4 5))) (eq (remove 1 x) > (cdr x))) both returns nil. Since you're clearly aware that, for lists, `remove' just calls `delete' on a shallow copy, how could (remove thing x) ever be eq to some nthcdr of x so long as both are non-nil? > If you think delete is OK, go ahead and use it. If you think remove is > better, keep it. Do whatever you think right. As I tried to explain in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=58985#64 I think `delete' is safe in this situation, assuming of course that, for ancient, core functions, the implementation can be construed as the de facto interface. Based on your comments, you seem to agree with this assumption, which seems only sane. I have thus reverted the change. > >> + (throw 'done out))))))))))) >> + > > [...] While I certainly welcome the assiduous scrutinizing of Emacs lisp mechanics and technique (truly), I was mainly hoping that, as an avid pass user, you would also help flesh out the precise effects of the behavior introduced by these changes and hopefully share some insights into how they might impact day-to-day usage for the typical pass user. Granted, that necessarily involves applying these patches atop your daily driver and living with them for a spell and, ideally, investing some thought into imagining common usage patterns beyond your own (plus any potentially problematic edge cases). If you have the energy to devote to (perhaps just some of) these areas, it would really help move this bug report forward. Thanks. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v5-v6.diff >From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 11 Nov 2022 19:55:11 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- lisp/erc/erc-compat.el | 99 +++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 414 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 54070e03eb..34edd4fa31 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -132,7 +132,7 @@ auth-source-pass--build-result-many (auth-source-pass--do-debug "final result: %S" rv)) (let (out) (dolist (e rv out) - (when-let* ((s (plist-get e :secret)) ; s not captured by closure + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 (v (auth-source--obfuscate s))) (setf (plist-get e :secret) (lambda () (auth-source--deobfuscate v)))) @@ -256,7 +256,7 @@ auth-source-pass--find-match (list hosts)))) (defun auth-source-pass--retrieve-parsed (seen path port-number-p) - (when-let ((m (string-match auth-source-pass--match-regexp path))) + (when (string-match auth-source-pass--match-regexp path) (puthash path (list :host (or (match-string 10 path) (match-string 11 path)) :user (or (match-string 20 path) (match-string 21 path)) @@ -306,7 +306,7 @@ auth-source-pass--find-match-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (remove e entries)))) + (null (setq entries (delete e entries)))) (throw 'done out))))))))))) (defun auth-source-pass--disambiguate (host &optional user port) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 739f502764..47d5258f92 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -184,15 +184,15 @@ erc-compat--with-memoization ;; This basically hard codes `auth-source-pass-port-separator' to ":" (defun erc-compat--auth-source-pass--retrieve-parsed (seen e port-number-p) - (when-let ((pat (rx (or bot "/") - (or (: (? (group-n 20 (+ (not (in " /@")))) "@") - (group-n 10 (+ (not (in " /:@")))) - (? ":" (group-n 30 (+ (not (in " /:")))))) - (: (group-n 11 (+ (not (in " /:@")))) - (? ":" (group-n 31 (+ (not (in " /:"))))) - (? "/" (group-n 21 (+ (not (in " /:"))))))) - eot)) - (m (string-match pat e))) + (when (string-match (rx (or bot "/") + (or (: (? (group-n 20 (+ (not (in " /@")))) "@") + (group-n 10 (+ (not (in " /:@")))) + (? ":" (group-n 30 (+ (not (in " /:")))))) + (: (group-n 11 (+ (not (in " /:@")))) + (? ":" (group-n 31 (+ (not (in " /:"))))) + (? "/" (group-n 21 (+ (not (in " /:"))))))) + eot) + e) (puthash e (list :host (or (match-string 10 e) (match-string 11 e)) :user (or (match-string 20 e) @@ -247,7 +247,7 @@ erc-compat--auth-source-pass--build-result-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (remove e entries)))) + (null (setq entries (delete e entries)))) (throw 'done nil))))))))) (reverse out))) -- 2.38.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch >From 0ab6214112f9fead4173981286d5491cc70b502c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 1 Nov 2022 22:46:24 -0700 Subject: [PATCH 1/2] [POC] Make auth-source-pass behave more like other backends * lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Add new option to bring search behavior more in line with other backends. (auth-source-pass-search): Add new keyword params `max' and `require' and consider new option `auth-source-pass-extra-query-keywords' for dispatch. (auth-source-pass--match-regexp, auth-source-pass--retrieve-parsed, auth-source-pass--match-parts): Add supporting variable and helpers. (auth-source-pass--build-result-many, auth-source-pass--find-match-many): Add "-many" variants for existing workhorse functions. * test/lisp/auth-source-pass-tests.el (auth-source-pass-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. Bug#58985. --- doc/misc/auth.texi | 11 ++ etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ 4 files changed, 307 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..2c61732f8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1385,6 +1385,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..34edd4fa31 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (cl-defun auth-source-pass-search (&rest spec &key backend type host user port + require max &allow-other-keys) "Given some search query, return matching credentials. See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, -HOST, USER and PORT." +HOST, USER, PORT, REQUIRE, and MAX." (cl-assert (or (null type) (eq type (oref backend type))) t "Invalid password-store search: %s %s") (cond ((eq host t) @@ -70,6 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (auth-source-pass--build-result-many host port user require max)) (t (when-let ((result (auth-source-pass--build-result host port user))) (list result))))) @@ -89,6 +105,39 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(defun auth-source-pass--build-result-many (hosts ports users require max) + "Return multiple `auth-source-pass--build-result' values." + (unless (listp hosts) (setq hosts (list hosts))) + (unless (listp users) (setq users (list users))) + (unless (listp ports) (setq ports (list ports))) + (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (rv (auth-source-pass--find-match-many hosts users ports + require (or max 1)))) + (when auth-source-debug + (auth-source-pass--do-debug "final result: %S" rv)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 + (v (auth-source--obfuscate s))) + (setf (plist-get e :secret) + (lambda () (auth-source--deobfuscate v)))) + (push e out))))) + ;;;###autoload (defun auth-source-pass-enable () "Enable auth-source-password-store." @@ -206,6 +255,60 @@ auth-source-pass--find-match hosts (list hosts)))) +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) + (when (string-match auth-source-pass--match-regexp path) + (puthash path + (list :host (or (match-string 10 path) (match-string 11 path)) + :user (or (match-string 20 path) (match-string 21 path)) + :port (and-let* ((p (or (match-string 30 path) + (match-string 31 path))) + (n (string-to-number p))) + (if (or (zerop n) (not port-number-p)) + (format "%s" p) + n))) + seen))) + +(defun auth-source-pass--match-parts (parts key value require) + (let ((mv (plist-get parts key))) + (if (memq key require) + (and value (equal mv value)) + (or (not value) (not mv) (equal mv value))))) + +(defun auth-source-pass--find-match-many (hosts users ports require max) + "Return plists for valid combinations of HOSTS, USERS, PORTS. +Each plist contains, at the very least, a host and a secret." + (let ((seen (make-hash-table :test #'equal)) + (entries (auth-source-pass-entries)) + out) + (catch 'done + (dolist (host hosts out) + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) + (setq p nil)) + (dolist (user (or users (list u))) + (dolist (port (or ports (list p))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((equal host (plist-get m :host))) + ((auth-source-pass--match-parts m :port port require)) + ((auth-source-pass--match-parts m :user user require)) + (parsed (auth-source-pass-parse-entry e)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (secret (or (auth-source-pass--get-attr 'secret parsed) + (not (memq :secret require))))) + (push + `( :host ,host ; prefer user-provided :host over h + ,@(and-let* ((u (plist-get m :user))) (list :user u)) + ,@(and-let* ((p (plist-get m :port))) (list :port p)) + ,@(and secret (not (eq secret t)) (list :secret secret))) + out) + (when (or (zerop (cl-decf max)) + (null (setq entries (delete e entries)))) + (throw 'done out))))))))))) + (defun auth-source-pass--disambiguate (host &optional user port) "Return (HOST USER PORT) after disambiguation. Disambiguate between having user provided inside HOST (e.g., diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index f5147a7ce0..60903808e0 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,190 @@ auth-source-pass-prints-meaningful-debug-log (should (auth-source-pass--have-message-matching "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")")))) + +;; FIXME move this to top of file if keeping these netrc tests +(require 'ert-x) + +;; No entry has the requested port, but a result is still returned. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a") + (:host "x.com" :port "42" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :secret "a") + (:host "x.com" :port 42 :secret "b"))))))) + +;; No entry has the requested port, but :port is required, so search fails + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))) + (should-not results)))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (should-not (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com")) + (auth-source-pass-enable) + (should-not (auth-source-search :host "x.com"))))) + +;; Output port type (int or string) matches that of input parameter + +(ert-deftest auth-source-pass-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port 42)) + '((:host "x.com" :port 42 :secret "a"))))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port "42")) + '((:host "x.com" :port "42" :secret "a"))))))) + +;; The :host search param ordering more heavily influences the output +;; because (h1, u1, p1), (h1, u1, p2), ... (hN, uN, pN); also, exact +;; matches are not given precedence, i.e., matching store items are +;; returned in the order encountered + +(ert-deftest auth-source-pass-extra-query-keywords--hosts-first () + (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) + ("gnu.org" (secret . "b")) + ("x.com" (secret . "c")) + ("fake.com" (secret . "d")) + ("x.com/foo" (secret . "e"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; Notice gnu.org is never considered ^ + '((:host "x.com" :user "bar" :port "42" :secret "a") + (:host "x.com" :secret "c") + (:host "x.com" :user "foo" :secret "e"))))))) + + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-POC-Support-auth-source-pass-in-ERC.patch >From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 24 Apr 2022 06:20:09 -0700 Subject: [PATCH 2/2] [POC] Support auth-source-pass in ERC * doc/misc/erc.texi: Mention that the auth-source-pass backend is supported. * lisp/erc/erc-compat.el (erc-compat--auth-source-pass-search, erc-compat--auth-source-pass--build-results-many, erc-compat--auth-source-pass--retrieve-parsed, erc-compat--auth-source-pass-packend-parse): Copy some yet unreleased functions from auth-source-pass that mimic the netrc backend. Also add forward declarations to support them. * lisp/erc/erc.el (erc--auth-source-search): Use own auth-source-pass erc-compat backend until 29.1 released. * test/lisp/erc/erc-services-tests.el (erc-join-tests--auth-source-pass-entries): Remove useless items. (erc--auth-source-search--pass-standard, erc--auth-source-search--pass-announced, erc--auth-source-search--pass-overrides): Remove `ert-skip' guard. Bug#58985. --- doc/misc/erc.texi | 3 +- lisp/erc/erc-compat.el | 99 +++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 107 insertions(+), 5 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9..ad35b78f0e 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -861,7 +861,8 @@ Connecting @code{erc-auth-source-search}. It tries to merge relevant contextual parameters with those provided or discovered from the logical connection or the underlying transport. Some auth-source back ends may not be -compatible; netrc, plstore, json, and secrets are currently supported. +compatible; netrc, plstore, json, secrets, and pass are currently +supported. @end defopt @subheading Full name diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f1352..47d5258f92 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -32,6 +32,8 @@ ;;; Code: (require 'compat nil 'noerror) +(eval-when-compile (require 'cl-lib)) + ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode @@ -168,6 +170,103 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; Auth Source + +(declare-function auth-source-pass--get-attr + "auth-source-pass" (key entry-data)) +(declare-function auth-source-pass--disambiguate + "auth-source-pass" (host &optional user port)) +(declare-function auth-source-backend-parse-parameters + "auth-source-pass" (entry backend)) +(declare-function auth-source-backend "auth-source" (&rest slots)) +(declare-function auth-source-pass-entries "auth-source-pass" nil) +(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(defun erc-compat--auth-source-pass--retrieve-parsed (seen e port-number-p) + (when (string-match (rx (or bot "/") + (or (: (? (group-n 20 (+ (not (in " /@")))) "@") + (group-n 10 (+ (not (in " /:@")))) + (? ":" (group-n 30 (+ (not (in " /:")))))) + (: (group-n 11 (+ (not (in " /:@")))) + (? ":" (group-n 31 (+ (not (in " /:"))))) + (? "/" (group-n 21 (+ (not (in " /:"))))))) + eot) + e) + (puthash e (list :host (or (match-string 10 e) + (match-string 11 e)) + :user (or (match-string 20 e) + (match-string 21 e)) + :port (and-let* ((p (or (match-string 30 e) + (match-string 31 e))) + (n (string-to-number p))) + (if (or (zerop n) + (not port-number-p)) + (format "%s" p) + n))) + seen))) + +;; This looks bad, but it just inlines `auth-source-pass--find-match-many'. +(defun erc-compat--auth-source-pass--build-result-many + (hosts users ports require max) + "Return a plist of HOSTS, PORTS, USERS, and secret." + (unless (listp hosts) (setq hosts (list hosts))) + (unless (listp users) (setq users (list users))) + (unless (listp ports) (setq ports (list ports))) + (unless max (setq max 1)) + (let ((seen (make-hash-table :test #'equal)) + (entries (auth-source-pass-entries)) + (check (lambda (m k v) + (let ((mv (plist-get m k))) + (if (memq k require) + (and v (equal mv v)) + (or (not v) (not mv) (equal mv v)))))) + out) + (catch 'done + (dolist (host hosts) + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) + (setq p nil)) + (dolist (user (or users (list u))) + (dolist (port (or ports (list p))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) + (erc-compat--auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((equal host (plist-get m :host))) + ((funcall check m :port port)) + ((funcall check m :user user)) + (parsed (auth-source-pass-parse-entry e)) + (secret (or (auth-source-pass--get-attr 'secret parsed) + (not (memq :secret require))))) + (push + `( :host ,host ; prefer user-provided :host over h + ,@(and-let* ((u (plist-get m :user))) (list :user u)) + ,@(and-let* ((p (plist-get m :port))) (list :port p)) + ,@(and secret (not (eq secret t)) (list :secret secret))) + out) + (when (or (zerop (cl-decf max)) + (null (setq entries (delete e entries)))) + (throw 'done nil))))))))) + (reverse out))) + +(cl-defun erc-compat--auth-source-pass-search + (&rest spec &key host user port require max &allow-other-keys) + ;; From `auth-source-pass-search' + (cl-assert (and host (not (eq host t))) + t "Invalid password-store search: %s %s") + (erc-compat--auth-source-pass--build-result-many host user port require max)) + +(defun erc-compat--auth-source-pass-backend-parse (entry) + (when (eq entry 'password-store) + (auth-source-backend-parse-parameters + entry (auth-source-backend + :source "." + :type 'password-store + :search-function #'erc-compat--auth-source-pass-search)))) + + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,12 @@ erc--auth-source-search the nod. Much the same would happen for entries sharing only a port: the one with host foo would win." (when-let* - ((priority (map-keys defaults)) + ((auth-source-backend-parser-functions + (if (memq 'password-store auth-sources) + (cons #'erc-compat--auth-source-pass-backend-parse + auth-source-backend-parser-functions) + auth-source-backend-parser-functions)) + (priority (map-keys defaults)) (test (lambda (a b) (catch 'done (dolist (key priority) diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("GNU.chat:irc/#chan" (secret . "foo")))) (ert-deftest erc--auth-source-search--pass-standard () - (ert-skip "Pass backend not yet supported") (let ((store erc-join-tests--auth-source-pass-entries) (auth-sources '(password-store)) (auth-source-do-cache nil)) @@ -487,7 +486,6 @@ erc--auth-source-search--pass-standard (erc-services-tests--auth-source-standard #'erc-auth-source-search)))) (ert-deftest erc--auth-source-search--pass-announced () - (ert-skip "Pass backend not yet supported") (let ((store erc-join-tests--auth-source-pass-entries) (auth-sources '(password-store)) (auth-source-do-cache nil)) @@ -500,7 +498,6 @@ erc--auth-source-search--pass-announced (erc-services-tests--auth-source-announced #'erc-auth-source-search)))) (ert-deftest erc--auth-source-search--pass-overrides () - (ert-skip "Pass backend not yet supported") (let ((store `(,@erc-join-tests--auth-source-pass-entries ("GNU.chat:6697/#chan" (secret . "spam")) -- 2.38.1 --=-=-=--