(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
(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
(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
(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."
(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)