Re: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
Akib Azmain Turja <[email protected]> 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 <[email protected]> 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.
0000-v5-v6.diff
(text/x-patch, 4.3 KB)
From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> 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
0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch
(text/x-patch, 18.8 KB)
From 0ab6214112f9fead4173981286d5491cc70b502c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> 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")) + ("[email protected]" (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
0002-POC-Support-auth-source-pass-in-ERC.patch
(text/x-patch, 9 KB)
From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> 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