auth-source-pass: Take care of matching hosts when port is provided

* lisp/auth-source-pass.el (auth-source-pass--find-match): Add PORT
parameter and reorganize code by extracting `find-match-unambiguous'.
(auth-source-pass--find-match-unambiguous): New function.
(auth-source-pass--build-result): Fix the call to `find-match'.
(auth-source-pass--hostname, auth-source-pass--hostname-with-user,
auth-source-pass--user): Remove functions.
* test/lisp/auth-source-pass-tests.el: Fix the calls to `find-match'.
(auth-source-pass-find-host-without-port) Add corresponding test.

2 files changed, 52 insertions, 67 deletions

diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 1785ca32550..96aefc8dd7e 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -52,7 +52,7 @@ See `auth-source-search' for details on SPEC."
 
 (defun auth-source-pass--build-result (host port user)
   "Build auth-source-pass entry matching HOST, PORT and USER."
-  (let ((entry (auth-source-pass--find-match host user)))
+  (let ((entry (auth-source-pass--find-match host user port)))
     (when entry
       (let ((retval (list
                      :host host
@@ -139,26 +139,6 @@ CONTENTS is the contents of a password-store formatted file."
                                     (mapconcat #'identity (cdr pair) ":")))))
                         (cdr lines)))))
 
-(defun auth-source-pass--hostname (host)
-  "Extract hostname from HOST."
-  (let ((url (url-generic-parse-url host)))
-    (or (url-host url) host)))
-
-(defun auth-source-pass--hostname-with-user (host)
-  "Extract hostname and user from HOST."
-  (let* ((url (url-generic-parse-url host))
-         (user (url-user url))
-         (hostname (url-host url)))
-    (cond
-     ((and user hostname) (format "%s@%s" user hostname))
-     (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
@@ -230,27 +210,39 @@ matching USER."
          (car matching-entries))
       (_ (auth-source-pass--select-one-entry matching-entries user)))))
 
-(defun auth-source-pass--find-match (host user)
-  "Return a password-store entry name matching HOST and USER.
-If many matches are found, return the first one.  If no match is
-found, return nil."
+(defun auth-source-pass--find-match (host user port)
+  "Return a password-store entry name matching HOST, USER and PORT.
+
+Disambiguate between user provided inside HOST (e.g., user@server.com) and
+inside USER by giving priority to USER.  Same for PORT."
+  (let* ((url (url-generic-parse-url (if (string-match-p ".*://" host)
+                                         host
+                                       (format "https://%s" host)))))
+    (auth-source-pass--find-match-unambiguous
+     (or (url-host url) host)
+     (or user (url-user url))
+     ;; url-port returns 443 (because of the https:// above) by default
+     (or port (number-to-string (url-port url))))))
+
+(defun auth-source-pass--find-match-unambiguous (hostname user port)
+  "Return a password-store entry name matching HOSTNAME, USER and PORT.
+If many matches are found, return the first one.  If no match is found,
+return nil.
+
+HOSTNAME should not contain any username or port number."
   (or
-   (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 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))
+   (and user port (auth-source-pass--find-one-by-entry-name (format "%s@%s:%s" user hostname port) user))
+   (and user (auth-source-pass--find-one-by-entry-name (format "%s@%s" user hostname) user))
+   (and port (auth-source-pass--find-one-by-entry-name (format "%s:%s" hostname port) nil))
+   (auth-source-pass--find-one-by-entry-name hostname user)
    ;; if that didn't work, remove subdomain: foo.bar.com -> bar.com
-   (let ((components (split-string host "\\.")))
+   (let ((components (split-string hostname "\\.")))
      (when (= (length components) 3)
        ;; start from scratch
-       (auth-source-pass--find-match (mapconcat 'identity (cdr components) ".") user)))))
+       (auth-source-pass--find-match-unambiguous
+        (mapconcat 'identity (cdr components) ".")
+        user
+        port)))))
 
 (provide 'auth-source-pass)
 ;;; auth-source-pass.el ends here
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 6d471f4e342..0f072592d00 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -75,107 +75,100 @@ This function is intended to be set to `auth-source-debug`."
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name ()
   (auth-source-pass--with-store '(("foo"))
-    (should (equal (auth-source-pass--find-match "foo" nil)
+    (should (equal (auth-source-pass--find-match "foo" nil nil)
                    "foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-part ()
   (auth-source-pass--with-store '(("foo"))
-    (should (equal (auth-source-pass--find-match "https://foo" nil)
+    (should (equal (auth-source-pass--find-match "https://foo" nil nil)
                    "foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-ignoring-user ()
   (auth-source-pass--with-store '(("foo"))
-    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil)
+    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
                    "foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-with-user ()
   (auth-source-pass--with-store '(("SomeUser@foo"))
-    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil)
+    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
                    "SomeUser@foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full ()
   (auth-source-pass--with-store '(("SomeUser@foo") ("foo"))
-    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil)
+    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
                    "SomeUser@foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full-reversed ()
   (auth-source-pass--with-store '(("foo") ("SomeUser@foo"))
-    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil)
+    (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
                    "SomeUser@foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain ()
   (auth-source-pass--with-store '(("bar.com"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" nil)
+    (should (equal (auth-source-pass--find-match "foo.bar.com" nil nil)
                    "bar.com"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-with-user ()
   (auth-source-pass--with-store '(("someone@bar.com"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone")
+    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone" nil)
                    "someone@bar.com"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-with-bad-user ()
   (auth-source-pass--with-store '(("someoneelse@bar.com"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone")
+    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone" nil)
                    nil))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-prefer-full ()
   (auth-source-pass--with-store '(("bar.com") ("foo.bar.com"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" nil)
+    (should (equal (auth-source-pass--find-match "foo.bar.com" nil nil)
                    "foo.bar.com"))))
 
 (ert-deftest auth-source-pass-dont-match-at-folder-name ()
   (auth-source-pass--with-store '(("foo.bar.com/foo"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" nil)
+    (should (equal (auth-source-pass--find-match "foo.bar.com" nil 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)
+    (should (equal (auth-source-pass--find-match "https://bar@foo.com" nil 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")
+    (should (equal (auth-source-pass--find-match "foo" "user" nil)
                    "user@foo"))
     (auth-source-pass--should-have-message-containing "Found 1 match")))
 
 (ert-deftest auth-source-pass-give-priority-to-desired-user ()
   (auth-source-pass--with-store '(("foo") ("subdir/foo" ("user" . "someone")))
-    (should (equal (auth-source-pass--find-match "foo" "someone")
+    (should (equal (auth-source-pass--find-match "foo" "someone" nil)
                    "subdir/foo"))
     (auth-source-pass--should-have-message-containing "Found 2 matches")
     (auth-source-pass--should-have-message-containing "matching user field")))
 
 (ert-deftest auth-source-pass-give-priority-to-desired-user-reversed ()
   (auth-source-pass--with-store '(("foo" ("user" . "someone")) ("subdir/foo"))
-    (should (equal (auth-source-pass--find-match "foo" "someone")
+    (should (equal (auth-source-pass--find-match "foo" "someone" nil)
                    "foo"))
     (auth-source-pass--should-have-message-containing "Found 2 matches")
     (auth-source-pass--should-have-message-containing "matching user field")))
 
 (ert-deftest auth-source-pass-return-first-when-several-matches ()
   (auth-source-pass--with-store '(("foo") ("subdir/foo"))
-    (should (equal (auth-source-pass--find-match "foo" nil)
+    (should (equal (auth-source-pass--find-match "foo" nil nil)
                    "foo"))
     (auth-source-pass--should-have-message-containing "Found 2 matches")
     (auth-source-pass--should-have-message-containing "the first one")))
 
 (ert-deftest auth-source-pass-make-divansantana-happy ()
   (auth-source-pass--with-store '(("host.com"))
-    (should (equal (auth-source-pass--find-match "smtp.host.com" "myusername@host.co.za")
+    (should (equal (auth-source-pass--find-match "smtp.host.com" "myusername@host.co.za" nil)
                    "host.com"))))
 
-(ert-deftest auth-source-pass-hostname ()
-  (should (equal (auth-source-pass--hostname "https://foo.bar:443") "foo.bar"))
-  (should (equal (auth-source-pass--hostname "https://foo.bar") "foo.bar"))
-  (should (equal (auth-source-pass--hostname "http://foo.bar") "foo.bar"))
-  (should (equal (auth-source-pass--hostname "https://SomeUser@foo.bar") "foo.bar")))
-
-(ert-deftest auth-source-pass-hostname-with-user ()
-  (should (equal (auth-source-pass--hostname-with-user "https://foo.bar:443") "foo.bar"))
-  (should (equal (auth-source-pass--hostname-with-user "https://foo.bar") "foo.bar"))
-  (should (equal (auth-source-pass--hostname-with-user "http://foo.bar") "foo.bar"))
-  (should (equal (auth-source-pass--hostname-with-user "https://SomeUser@foo.bar") "SomeUser@foo.bar")))
+(ert-deftest auth-source-pass-find-host-without-port ()
+  (auth-source-pass--with-store '(("host.com"))
+    (should (equal (auth-source-pass--find-match "host.com:8888" "someuser" nil)
+                   "host.com"))))
 
 (defmacro auth-source-pass--with-store-find-foo (store &rest body)
   "Use STORE while executing BODY.  \"foo\" is the matched entry."
@@ -207,7 +200,7 @@ This function is intended to be set to `auth-source-debug`."
 (ert-deftest auth-source-pass-build-result-passes-full-host-to-find-match ()
   (let (passed-host)
     (cl-letf (((symbol-function 'auth-source-pass--find-match)
-               (lambda (host _user) (setq passed-host host))))
+               (lambda (host _user _port) (setq passed-host host))))
       (auth-source-pass--build-result "https://user@host.com:123" nil nil)
       (should (equal passed-host "https://user@host.com:123"))
       (auth-source-pass--build-result "https://user@host.com" nil nil)