[Emacs-diffs] master b43ed61 06/14: auth-source-pass: Take care of matching hosts when port is provided

[Nicolas Petton]

branch: master
commit b43ed61ef985e01975b90d7e0ec3cac70d0afefa
Author: Damien Cassou <address@hidden>
Commit: Nicolas Petton <address@hidden>

    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.
---
 lisp/auth-source-pass.el            | 68 ++++++++++++++++---------------------
 test/lisp/auth-source-pass-tests.el | 51 ++++++++++++----------------
 2 files changed, 52 insertions(+), 67 deletions(-)

diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 1785ca3..96aefc8 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 "address@hidden" 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., address@hidden) 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., "address@hidden"), <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 
"address@hidden:%s" user hostname port) user))
+   (and user (auth-source-pass--find-one-by-entry-name (format 
"address@hidden" 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 6d471f4..0f07259 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://address@hidden"; nil)
+    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil 
nil)
                    "foo"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-with-user ()
   (auth-source-pass--with-store '(("address@hidden"))
-    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil)
+    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil 
nil)
                    "address@hidden"))))
 
 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full ()
   (auth-source-pass--with-store '(("address@hidden") ("foo"))
-    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil)
+    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil 
nil)
                    "address@hidden"))))
 
 (ert-deftest 
auth-source-pass-find-match-matching-at-entry-name-prefer-full-reversed ()
   (auth-source-pass--with-store '(("foo") ("address@hidden"))
-    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil)
+    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil 
nil)
                    "address@hidden"))))
 
 (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 '(("address@hidden"))
-    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone")
+    (should (equal (auth-source-pass--find-match "foo.bar.com" "someone" nil)
                    "address@hidden"))))
 
 (ert-deftest 
auth-source-pass-find-match-matching-at-entry-name-without-subdomain-with-bad-user
 ()
   (auth-source-pass--with-store '(("address@hidden"))
-    (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://address@hidden"; nil)
+    (should (equal (auth-source-pass--find-match "https://address@hidden"; nil 
nil)
                    "foo.com/bar"))))
 
 (ert-deftest auth-source-pass-search-with-user-first ()
   (auth-source-pass--with-store '(("foo") ("address@hidden"))
-    (should (equal (auth-source-pass--find-match "foo" "user")
+    (should (equal (auth-source-pass--find-match "foo" "user" nil)
                    "address@hidden"))
     (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" 
"address@hidden")
+    (should (equal (auth-source-pass--find-match "smtp.host.com" 
"address@hidden" 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://address@hidden";) 
"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://address@hidden";) "address@hidden")))
+(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://address@hidden:123"; nil nil)
       (should (equal passed-host "https://address@hidden:123";))
       (auth-source-pass--build-result "https://address@hidden"; nil nil)