Extract user from host when searching for entries in auth-source-pass

* lisp/auth-source-pass.el (auth-source-pass--user): New function.
(auth-source-pass--find-match): Use it.  When the user is not
explicitly specified and no entry is found, extract the user from
the host and then search again.  (Bug#29045)
* test/lisp/auth-source-pass-tests.el
(auth-source-pass-find-match-matching-extracting-user-from-host):
Add a new test case.

Copyright-paperwork-exempt: yes

diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 8f69ce323e74fc716ad97df5c5b72f0587609657..f4f096160ef73cb8d7186b2103c4475142db83c4 100644 (file)
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -139,11 +139,6 @@ CONTENTS is the contents of a password-store formatted file."
                                     (mapconcat #'identity (cdr pair) ":")))))
                         (cdr lines)))))
 
-(defun auth-source-pass--user-match-p (entry user)
-  "Return true iff ENTRY match USER."
-  (or (null user)
-      (string= user (auth-source-pass-get "user" entry))))
-
 (defun auth-source-pass--hostname (host)
   "Extract hostname from HOST."
   (let ((url (url-generic-parse-url host)))
@@ -159,6 +154,11 @@ CONTENTS is the contents of a password-store formatted file."
      (hostname hostname)
      (t host))))
 
+(defun auth-source-pass--user (host)
+  "Extract user from HOST and return it.
+Return nil if no match was found."
+  (url-user (url-generic-parse-url host)))
+
 (defun auth-source-pass--do-debug (&rest msg)
   "Call `auth-source-do-debug` with MSG and a prefix."
   (apply #'auth-source-do-debug
@@ -235,14 +235,17 @@ matching USER."
 If many matches are found, return the first one.  If no match is
 found, return nil."
   (or
-   (if (url-user (url-generic-parse-url host))
+   (if (auth-source-pass--user host)
        ;; if HOST contains a user (e.g., "user@host.com"), <HOST>
        (auth-source-pass--find-one-by-entry-name (auth-source-pass--hostname-with-user host) user)
      ;; otherwise, if USER is provided, search for <USER>@<HOST>
      (when (stringp user)
        (auth-source-pass--find-one-by-entry-name (concat user "@" (auth-source-pass--hostname host)) user)))
-   ;; if that didn't work, search for HOST without it's user component if any
+   ;; if that didn't work, search for HOST without its user component, if any
    (auth-source-pass--find-one-by-entry-name (auth-source-pass--hostname host) user)
+   ;; if that didn't work, search for HOST with user extracted from it
+   (auth-source-pass--find-one-by-entry-name
+    (auth-source-pass--hostname host) (auth-source-pass--user host))
    ;; if that didn't work, remove subdomain: foo.bar.com -> bar.com
    (let ((components (split-string host "\\.")))
      (when (= (length components) 3)

diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 9b6b5687cabe9a9b3afa078d0b1ca0088b739bb6..84423b7d06d186b379eb2f1ec3c13300e67ec51e 100644 (file)
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -128,6 +128,11 @@ This function is intended to be set to `auth-source-debug`."
     (should (equal (auth-source-pass--find-match "foo.bar.com" nil)
                    nil))))
 
+(ert-deftest auth-source-pass-find-match-matching-extracting-user-from-host ()
+  (auth-source-pass--with-store '(("foo.com/bar"))
+    (should (equal (auth-source-pass--find-match "https://bar@foo.com" nil)
+                   "foo.com/bar"))))
+
 (ert-deftest auth-source-pass-search-with-user-first ()
   (auth-source-pass--with-store '(("foo") ("user@foo"))
     (should (equal (auth-source-pass--find-match "foo" "user")