bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends

[Akib Azmain Turja]

"J.P." <jp@neverwas.me> writes:

> Hi Michael,
>
> Michael Albinus <michael.albinus@gmx.de> writes:
>
>> I'm not familiar with the auth-source-pass.el implementation, so I
>> cannot speak too much about your patch. Reading it roughly, I haven't
>> found serious flaws, 'tho.
>
> Thanks for taking a look!
>
>> However :-)
>>
>> +(defcustom auth-source-pass-standard-search nil
>> +  "Whether to use more standardized search behavior.
>> +When nil, the password-store backend works like it always has and
>> +considers at most one `:user' search parameter and returns at
>> +most one result.  With t, it tries to more faithfully mimic other
>> +auth-source backends."
>> +  :version "29.1"
>> +  :type 'boolean)
>>
>> - The name of this user option as well as its docstring are focussed on
>>   the current behavior. People won't know what "mimic other auth-source
>>   backends" would mean. Please describe the effect w/o that comparison,
>>   and pls give it a name based on its effect, and not "...-standard-search".
>
> I've changed the name to `auth-source-pass-extra-query-keywords' and
> updated the description to something hopefully more adequate.
>
>> - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS.
>
> Added.
>
> BTW, I was initially thinking it'd be better to wait for a more
> comprehensive and maintainable solution, like something based around a
> larger set of common functions to be shared among the various back ends
> (hence the [POC] qualifier on my patches). However, I suppose such a
> thing could be done later, once the desired behavior is all dialed in
> (perhaps alongside addressing support for full CRUD operations, which
> are still missing, AFIAK). Anyway, I really don't know enough about pass
> or auth-source to commit to such an endeavor. But I've reached out to
> some folks who may be able to lend a hand.
>
> Thanks,
> J.P.
>
>
> From 450e2f029a26b30d583afcb44e7fdd561a95c277 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--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.
> ---
>  doc/misc/auth.texi                  |  11 +++
>  etc/NEWS                            |   8 ++
>  lisp/auth-source-pass.el            | 109 ++++++++++++++++++++-
>  test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++
>  4 files changed, 271 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
> +

The name won't make much sense to the ordinary user who don't know about
the API.

Repeating from another message, this variable should be something like
"auth-source-pass-old-search" (or even "...-obsolete-search").

>  @node Help for developers
>  @chapter Help for developers
>  
> diff --git a/etc/NEWS b/etc/NEWS
> index 89da8aa63f..776936489f 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -1383,6 +1383,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..d9129667e1 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")
> +

This should be non-nil by default, since it fixes a number of bugs.  We
don't want to deprive users from these fixes, do we?

REPEAT: The name won't make much sense to the ordinary user who don't
know about the API.

Repeating from another message, this variable should be something like
"auth-source-pass-old-search" (or even "...-obsolete-search").

>  (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,41 @@ auth-source-pass--build-result
>                                      (seq-subseq retval 0 -2)) ;; remove 
> password
>          retval))))

LGTM.

>  
> +(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))

LGTM.

> +
> +(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))
> +    (if (eq auth-source-pass-extra-query-keywords 'test)
> +        (reverse rv)

The value `test' is not documented.  Is it used in tests?  If it is, I
think an internal variable would be better.

> +      (let (out)
> +        (dolist (e rv out)
> +          (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))))
> +          (push e out))))))
> +

LGTM.

>  ;;;###autoload
>  (defun auth-source-pass-enable ()
>    "Enable auth-source-password-store."
> @@ -206,6 +257,62 @@ auth-source-pass--find-match
>                  hosts
>                (list hosts))))
>  
> +(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
> +  (when-let ((m (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)))

LGTM.

> +
> +(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)))))

LGTM.

> +
> +;; For now, this ignores the contents of files and only considers path
> +;;  components when matching.

The file name contains host, user and port, so parsing contents is not
needed at all.

> +(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))
> +        port-number-p
> +        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))

Can "auth-source-pass--disambiguate" return host with the protocol part?

> +            (setq p nil))
> +          (dolist (user (or users (list u)))
> +            (dolist (port (or ports (list p)))
> +              (setq port-number-p (equal 'integer (type-of port)))

Just saw the first use of "type-of".  Doesn't "(integerp port)" work?

> +              (dolist (e entries)
> +                (when-let*
> +                    ((m (or (gethash e seen) 
> (auth-source-pass--retrieve-parsed
> +                                              seen e port-number-p)))
> +                     ((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))
> +                     (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)

LGTM.

> +                  (when (or (zerop (cl-decf max))
> +                            (null (setq entries (delete e entries))))

Can the delete call conflict with the dolist loop?

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

I don't have much idea about these tests, but...

> index f5147a7ce0..718c7cf4ba 100644
> --- a/test/lisp/auth-source-pass-tests.el
> +++ b/test/lisp/auth-source-pass-tests.el
> @@ -488,6 +488,150 @@ 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 result (plist-put result :secret (auth-info-password result))))
> +      (should (equal results '((:host "x.com" :secret "a")))))))

How this is testing auth-source-pass?

> +
> +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
> +  (let ((auth-source-pass-extra-query-keywords 'test))
> +    (auth-source-pass--with-store '(("x.com" (secret . "a"))
> +                                    ("x.com:42" (secret . "b")))
> +      (auth-source-pass-enable)
> +      (should (equal (auth-source-search :host "x.com" :port 22 :max 2)
> +                     '((: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 result (plist-put 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 ()
> +  (let ((auth-source-pass-extra-query-keywords 'test))
> +    (auth-source-pass--with-store '(("x.com" (secret . "a"))
> +                                    ("x.com:42" (secret . "b")))
> +      (auth-source-pass-enable)
> +      (should (equal (auth-source-search :host "x.com" :port 42 :max 2)
> +                     '((: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 'test))
> +    (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 result (plist-put 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 ()
> +  (let ((auth-source-pass-extra-query-keywords 'test))
> +    (auth-source-pass--with-store '(("x.com" (secret . "a"))
> +                                    ("akib@disroot.org" (secret . "b"))
> +                                    ("z.com" (secret . "c")))
> +      (auth-source-pass-enable)
> +      (should (equal (auth-source-search :host "disroot.org" :max 2)
> +                     '((:host "disroot.org" :user "akib" :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 'test))
> +    (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 'test))
> +    (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
> +      (auth-source-pass-enable)
> +      (should (equal (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 (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 ()
> +  (let ((auth-source-pass-extra-query-keywords 'test))
> +    (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)
> +      (should (equal (auth-source-search :host '("x.com" "gnu.org") :max 3)
> +                     ;; 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

-- 
Akib Azmain Turja --- https://akib.codeberg.page/
GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5
Fediverse: akib@hostux.social, Codeberg: akib
emailselfdefense.fsf.org | "Nothing can be secure without encryption."

signature.asc
Description: PGP signature