procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make auth-source-pass behave more like other backends

Browse source 
* 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: Require `ert-x'.
(auth-source-pass-can-start-from-auth-source-search): Ensure
`auth-source-pass-extra-query-keywords' is enabled around test body.
(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,
auth-source-pass-extra-query-keywords--user-priorities): 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.)

Special thanks to Akib Azmain Turja <akib@disroot.org> for helping
improve this patch.
This commit is contained in:
F. Jason Park 2022-11-01 22:46:24 -07:00
parent 0147e1ed83
commit 2cf9e699ef
4 changed files with 402 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
doc/misc/auth.texi
View file

@ -526,6 +526,8 @@ If several entries match, the one matching the most items (where an
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 processing 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,22 @@ Set this variable to a string that should separate an host name from a
port in an entry. Defaults to @samp{:}.
@end defvar
@defvar auth-source-pass-extra-query-keywords
This expands the selection of available keywords to include
@code{:max} and @code{:require} and tells more of them to accept a
list of query parameters as an argument. When searching, it also
favors the @samp{rms@@gnu.org.gpg} form for usernames over the
@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user}
param was provided.
In general, if you prefer idiosyncrasies traditionally exhibited by
this backend, such as prioritizing field count in a filename, try
setting this option to @code{nil}. But, if you experience problems
predicting the outcome of searches relative to other auth-source
backends or encounter code expecting to query multiple backends
uniformly, try flipping it back to @code{t} (the default).
@end defvar
@node Help for developers
@chapter Help for developers

8
etc/NEWS
View file

@ -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
+++

112
lisp/auth-source-pass.el
View file

@ -55,13 +55,27 @@
:type 'string
:version "27.1")
(defcustom auth-source-pass-extra-query-keywords t
"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 @@ HOST, USER and PORT."
((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 @@ HOSTS can be a string or a list of strings."
(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,67 @@ HOSTS can be a string or a list of strings."
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."
(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.,

267
test/lisp/auth-source-pass-tests.el
View file

@ -25,7 +25,7 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'auth-source-pass)
@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
(auth-source-pass-enable)
(let ((result (car (auth-source-search :host "gitlab.com"))))
;; This also asserts an aspect of traditional search behavior
;; relative to `auth-source-pass-extra-query-keywords'.
(let* ((auth-source-pass-extra-query-keywords nil)
(result (car (auth-source-search :host "gitlab.com"))))
(should (equal (plist-get result :user) "someone"))
(should (equal (plist-get result :host) "gitlab.com")))))
@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to
(should (auth-source-pass--have-message-matching
"found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")"))))
;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
;; 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")))))))
;; Match precision sometimes takes a back seat to the traversal
;; ordering. Specifically, the :host (h1, ...) args hold greater sway
;; over the output because they determine the first coordinate in the
;; sequence of (host, user, port) combinations visited. (Taking a
;; tree-wise view, these become the depth-1 nodes in a DFS.)
;; Note that all trailing /user forms are demoted for the sake of
;; predictability (see tests further below for details). This means
;; that, in the following test, /bar is held in 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")))))))
;; This is another example given in the bug thread.
(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")))))))
;; This conveys the same idea as `user-priorities', just below, but
;; with slightly more realistic and less legible values.
(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
(let ((store (sort (copy-sequence '(("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"))))
(lambda (&rest _) (zerop (random 2))))))
(auth-source-pass--with-store store
(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"))))))))
;; This is a more distilled version of `suffixed-user', above. It
;; better illustrates that search order takes precedence over "/user"
;; demotion because otherwise * and ** would be swapped, below. It
;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
;; h:2/u, u@g:1}.
(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
(let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
("h:2/u" (secret . "/"))
("u@h:1" (secret . "@"))
("u@h:2" (secret . "@"))
("g:1/u" (secret . "/"))
("g:2/u" (secret . "/"))
("u@g:1" (secret . "@"))
("u@g:2" (secret . "@"))))
(lambda (&rest _) (zerop (random 2))))))
(auth-source-pass--with-store store
(auth-source-pass-enable)
(let* ((auth-source-pass-extra-query-keywords t)
(results (auth-source-search :host '("h" "g")
:port 2
:max 5)))
(dolist (result results)
(setf (plist-get result :secret) (auth-info-password result)))
(should (equal results
'((:host "h" :user "u" :port 2 :secret "@")
(:host "h" :user "u" :port 2 :secret "/") ; *
(:host "g" :user "u" :port 2 :secret "@") ; **
(:host "g" :user "u" :port 2 :secret "/"))))))))
(provide 'auth-source-pass-tests)
;;; auth-source-pass-tests.el ends here