mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

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

Browse Source 
* 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
This commit is contained in:
Łukasz Jędrzejewski 2017-11-04 12:24:49 +02:00 committed by Eli Zaretskii
parent 5ea5b2536e
commit e973c5f5f4
2 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lisp/auth-source-pass.el
View File

@ -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)

5
test/lisp/auth-source-pass-tests.el
View File

@ -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")