From: "J.P." <jp@neverwas.me>
To: Akib Azmain Turja <akib@disroot.org>
Cc: "Damien Cassou" <damien@cassou.me>,
"Björn Bidar" <bjorn.bidar@thaodan.de>,
emacs-erc@gnu.org, "Michael Albinus" <michael.albinus@gmx.de>,
58985@debbugs.gnu.org
Subject: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends
Date: Mon, 14 Nov 2022 07:12:39 -0800 [thread overview]
Message-ID: <877czxlgd4.fsf@neverwas.me> (raw)
In-Reply-To: <87mt8uvxkp.fsf@disroot.org> (Akib Azmain Turja's message of "Mon, 14 Nov 2022 12:50:46 +0600")
[-- Attachment #1: Type: text/plain, Size: 1729 bytes --]
Akib Azmain Turja <akib@disroot.org> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> You mentioned previously some potentially surprising ambiguities
>> surrounding the trailing /user syntax. If any realistic scenarios
>> present themselves, perhaps we can try to improve the situation if it's
>> not too far out of scope (or just document the behavior, maybe in a unit
>> test). Thanks again.
>
> I think it's good enough to install on master. Then more people can
> test and report about it.
>
> However, observed some behavior of the new code, here are my findings:
>
> The new searching code seems to prefer "HOST/USER" over "USER@HOST".
That's the effect, right. I think `directory-files-recursively'
basically determines the ordering in which the entries are considered.
> I created the password store entry "foo.com/bar.org". Then I evaluated:
> (warning: manually typed with hands)
>
> (auth-source-search :host "bar.org")
> ;; => nil
>
> (auth-source-search :host "foo.com")
> ;; => ((:host "foo.com" :user "bar.org" :secret ...))
>
> I created another entry "bar.org@foo.com". But it returns the password
> in "foo.com/bar.org".
>
> I deleted "foo.com/bar.org", now it return the password of
> "bar.org@foo.com".
>
> I created "foo.com/bar.org" again, and "foo.com/bar.org" is preferred
> again.
>
> I suggest to prefer the "@" syntax over "/user" syntax.
I have tried tweaking things in that direction. But as far as
deprecating the /user form officially: that seems more like a group
decision. And then there's the question of how to express such a policy.
Should we emit a warning? At the very least, it would need to be
documented somewhere.
Anyway, this is useful analysis. Thanks again for all your help.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v6-v7.diff --]
[-- Type: text/x-patch, Size: 10404 bytes --]
From 7a6ee6960ded65dfdec768b094eca8d1883a8f4d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 14 Nov 2022 06:51:56 -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 | 113 +++++++++++++-
lisp/erc/erc-compat.el | 104 +++++++++++++
lisp/erc/erc.el | 7 +-
test/lisp/auth-source-pass-tests.el | 223 ++++++++++++++++++++++++++++
test/lisp/erc/erc-services-tests.el | 3 -
8 files changed, 466 insertions(+), 6 deletions(-)
Interdiff:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 34edd4fa31..aa39df014c 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -258,14 +258,16 @@ auth-source-pass--find-match
(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)))
+ `( :host ,(or (match-string 10 path) (match-string 11 path))
+ ,@(if-let* ((tr (match-string 21 path)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 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)
@@ -279,7 +281,7 @@ auth-source-pass--find-match-many
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)
+ out suffixed suffixedp)
(catch 'done
(dolist (host hosts out)
(pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
@@ -304,10 +306,16 @@ auth-source-pass--find-match-many
,@(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)))))))))))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))))
(defun auth-source-pass--disambiguate (host &optional user port)
"Return (HOST USER PORT) after disambiguation.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 47d5258f92..51bf251026 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -193,17 +193,16 @@ erc-compat--auth-source-pass--retrieve-parsed
(? "/" (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)))
+ (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
+ ,@(if-let* ((tr (match-string 21 e)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 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'.
@@ -221,7 +220,7 @@ erc-compat--auth-source-pass--build-result-many
(if (memq k require)
(and v (equal mv v))
(or (not v) (not mv) (equal mv v))))))
- out)
+ out suffixed suffixedp)
(catch 'done
(dolist (host hosts)
(pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
@@ -245,10 +244,16 @@ erc-compat--auth-source-pass--build-result-many
,@(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)))))))))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))
(reverse out)))
(cl-defun erc-compat--auth-source-pass-search
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 60903808e0..a92653b5ac 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -654,6 +654,11 @@ auth-source-pass-extra-query-keywords--port-type
;; matches are not given precedence, i.e., matching store items are
;; returned in the order encountered
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability, and so are quasi-deprecated. This means that, in
+;; the following test, /bar is shunted off to limbo, followed by /foo,
+;; but they both retain priority over "gnu.org", as noted above.
+
(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"))
@@ -667,10 +672,44 @@ auth-source-pass-extra-query-keywords--hosts-first
(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" :secret "c")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
(:host "x.com" :user "foo" :secret "e")))))))
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+ (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+ ("foo.com" (secret . "b"))
+ ("bar.org" (secret . "c"))
+ ("fake.com" (secret . "d")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "bar.org" :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "bar.org" :secret "c")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+ (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+ ("bar@x.com" (secret . "b"))
+ ("x.com" (secret . "?"))
+ ("bar@y.org" (secret . "c"))
+ ("fake.com" (secret . "?"))
+ ("fake.com/bar" (secret . "d"))
+ ("y.org/bar" (secret . "?"))
+ ("bar@fake.com" (secret . "e")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+ :user "bar"
+ :require '(:user) :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :user "bar" :secret "b")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "fake.com" :user "bar" :secret "e")
+ (:host "fake.com" :user "bar" :secret "d")
+ (:host "y.org" :user "bar" :secret "c")))))))
(provide 'auth-source-pass-tests)
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --]
[-- Type: text/x-patch, Size: 22097 bytes --]
From aef40854691b4c6e9c97ffdedefb342ae3fcc669 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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,
auth-source-pass-extra-query-keywords--ambiguous-user-host,
auth-source-pass-extra-query-keywords--suffixed-user): 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 | 113 +++++++++++++-
test/lisp/auth-source-pass-tests.el | 223 ++++++++++++++++++++++++++++
4 files changed, 354 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 7cd192b9d3..465ab4ad68 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1395,6 +1395,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..aa39df014c 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,68 @@ 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
+ `( :host ,(or (match-string 10 path) (match-string 11 path))
+ ,@(if-let* ((tr (match-string 21 path)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 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 suffixed suffixedp)
+ (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)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (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..a92653b5ac 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -488,6 +488,229 @@ 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
+
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability, and so are quasi-deprecated. This means that, in
+;; the following test, /bar is shunted off to limbo, followed by /foo,
+;; but they both retain priority over "gnu.org", as noted above.
+
+(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" :secret "c")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "x.com" :user "foo" :secret "e")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+ (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+ ("foo.com" (secret . "b"))
+ ("bar.org" (secret . "c"))
+ ("fake.com" (secret . "d")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "bar.org" :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "bar.org" :secret "c")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+ (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+ ("bar@x.com" (secret . "b"))
+ ("x.com" (secret . "?"))
+ ("bar@y.org" (secret . "c"))
+ ("fake.com" (secret . "?"))
+ ("fake.com/bar" (secret . "d"))
+ ("y.org/bar" (secret . "?"))
+ ("bar@fake.com" (secret . "e")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+ :user "bar"
+ :require '(:user) :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :user "bar" :secret "b")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "fake.com" :user "bar" :secret "e")
+ (:host "fake.com" :user "bar" :secret "d")
+ (:host "y.org" :user "bar" :secret "c")))))))
+
(provide 'auth-source-pass-tests)
;;; auth-source-pass-tests.el ends here
--
2.38.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --]
[-- Type: text/x-patch, Size: 9503 bytes --]
From 7a6ee6960ded65dfdec768b094eca8d1883a8f4d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 | 104 ++++++++++++++++++++++++++++
lisp/erc/erc.el | 7 +-
test/lisp/erc/erc-services-tests.el | 3 -
4 files changed, 112 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..51bf251026 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,108 @@ 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 `( :host ,(or (match-string 10 e) (match-string 11 e))
+ ,@(if-let* ((tr (match-string 21 e)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 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 suffixed suffixedp)
+ (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)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))
+ (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
next prev parent reply other threads:[~2022-11-14 15:12 UTC|newest]
Thread overview: 39+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <87wn8cb0ym.fsf@neverwas.me>
2022-11-05 23:55 ` bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends J.P.
2022-11-06 11:23 ` Michael Albinus
[not found] ` <87pme09vis.fsf@gmx.de>
2022-11-07 5:00 ` J.P.
2022-11-09 18:21 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87a653z7dl.fsf@neverwas.me>
2022-11-07 10:33 ` Michael Albinus
[not found] ` <874jvbnje1.fsf@gmx.de>
2022-11-08 13:56 ` J.P.
2022-11-10 0:39 ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10 5:25 ` J.P.
[not found] ` <875yfnnzy6.fsf@neverwas.me>
2022-11-10 13:40 ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10 14:40 ` J.P.
[not found] ` <87pmduc1pz.fsf@neverwas.me>
2022-11-15 3:45 ` J.P.
2022-11-09 18:25 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <874jv8ouh9.fsf@disroot.org>
2022-11-10 5:26 ` J.P.
2022-11-10 7:12 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <878rkjl1vd.fsf@disroot.org>
2022-11-10 14:38 ` J.P.
2022-11-11 3:17 ` J.P.
[not found] ` <877d026uym.fsf@neverwas.me>
2022-11-11 14:45 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87tu35eehq.fsf@disroot.org>
2022-11-12 4:30 ` J.P.
[not found] ` <87bkpcu74w.fsf@neverwas.me>
2022-11-12 15:24 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <875yfkdwlm.fsf@disroot.org>
2022-11-13 7:26 ` Akib Azmain Turja
2022-11-13 15:29 ` J.P.
[not found] ` <875yfiq3d8.fsf@neverwas.me>
2022-11-14 6:50 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87mt8uvxkp.fsf@disroot.org>
2022-11-14 15:12 ` J.P. [this message]
2022-11-14 17:49 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-15 3:32 ` J.P.
[not found] ` <87a64s99ka.fsf@neverwas.me>
2022-11-18 14:14 ` J.P.
2022-11-18 23:25 ` Kai Tetzlaff
2022-11-19 0:35 ` J.P.
2022-11-19 1:02 ` Kai Tetzlaff
2022-11-19 3:39 ` J.P.
2022-11-19 4:08 ` J.P.
2022-11-19 14:59 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <87bkp4z6xg.fsf@neverwas.me>
2022-12-07 14:30 ` J.P.
[not found] ` <878rkkoup4.fsf@disroot.org>
2022-11-10 5:23 ` J.P.
2022-11-10 7:12 ` Akib Azmain Turja
[not found] ` <87a64zo01q.fsf@neverwas.me>
2022-11-10 8:11 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-06 14:39 ` Damien Cassou
2022-11-07 4:59 ` J.P.
2022-11-03 13:51 J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=877czxlgd4.fsf@neverwas.me \
--to=jp@neverwas.me \
--cc=58985@debbugs.gnu.org \
--cc=akib@disroot.org \
--cc=bjorn.bidar@thaodan.de \
--cc=damien@cassou.me \
--cc=emacs-erc@gnu.org \
--cc=michael.albinus@gmx.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.