mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
Refactoring of auth-source-pass
* lisp/auth-source-pass.el (auth-source-pass--find-match): Refactor by moving some code to auth-source-pass--disambiguate. (auth-source-pass--disambiguate) (auth-source-pass--entries-matching-suffix): New function. (auth-source-pass--find-match-unambiguous) (auth-source-pass--select-from-entries) (auth-source-pass--entry-reducer): Refactor to simplify and improve logging. (auth-source-pass--matching-entries) (auth-source-pass--accumulate-matches): Remove. * test/lisp/auth-source-pass-tests.el: Complete rewrite to facilitate maintenance. (auth-source-pass--have-message-containing): Remove. (auth-source-pass--have-message-matching) (auth-source-pass--explain--have-message-matching) (auth-source-pass--explain-match-entry-p) (auth-source-pass--includes-sorted-entries) (auth-source-pass--explain-includes-sorted-entries) (auth-source-pass--explain-match-any-entry-p) (auth-source-pass--matching-entries) (auth-source-pass-match-entry-p) (auth-source-pass-match-any-entry-p): New function.
This commit is contained in:
Damien Cassou
parent
736f78bb1a
commit
7022e3fde6
@ -197,10 +197,17 @@ CONTENTS is the contents of a password-store formatted file."
|
||||
|
||||
Disambiguate between user provided inside HOST (e.g., user@server.com) and
|
||||
inside USER by giving priority to USER. Same for PORT."
|
||||
(apply #'auth-source-pass--find-match-unambiguous (auth-source-pass--disambiguate host user port)))
|
||||
|
||||
(defun auth-source-pass--disambiguate (host &optional user port)
|
||||
"Return (HOST USER PORT) after disambiguation.
|
||||
Disambiguate between having 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
|
||||
(list
|
||||
(or (url-host url) host)
|
||||
(or user (url-user url))
|
||||
;; url-port returns 443 (because of the https:// above) by default
|
||||
@ -212,74 +219,49 @@ 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."
|
||||
(cl-reduce
|
||||
(lambda (result entries)
|
||||
(or result
|
||||
(pcase (length entries)
|
||||
(0 nil)
|
||||
(1 (auth-source-pass-parse-entry (car entries)))
|
||||
(_ (auth-source-pass--select-from-entries entries user)))))
|
||||
(auth-source-pass--matching-entries hostname user port)
|
||||
:initial-value nil))
|
||||
(let ((all-entries (auth-source-pass-entries))
|
||||
(suffixes (auth-source-pass--generate-entry-suffixes hostname user port)))
|
||||
(auth-source-pass--do-debug "searching for entries matching hostname=%S, user=%S, port=%S"
|
||||
hostname (or user "") (or port ""))
|
||||
(auth-source-pass--do-debug "corresponding suffixes to search for: %S" suffixes)
|
||||
(catch 'auth-source-pass-break
|
||||
(dolist (suffix suffixes)
|
||||
(let* ((matching-entries (auth-source-pass--entries-matching-suffix suffix all-entries))
|
||||
(best-entry-data (auth-source-pass--select-from-entries matching-entries user)))
|
||||
(pcase (length matching-entries)
|
||||
(0 (auth-source-pass--do-debug "found no entries matching %S" suffix))
|
||||
(1 (auth-source-pass--do-debug "found 1 entry matching %S: %S"
|
||||
suffix
|
||||
(car matching-entries)))
|
||||
(_ (auth-source-pass--do-debug "found %s entries matching %S: %S"
|
||||
(length matching-entries)
|
||||
suffix
|
||||
matching-entries)))
|
||||
(when best-entry-data
|
||||
(throw 'auth-source-pass-break best-entry-data)))))))
|
||||
|
||||
(defun auth-source-pass--select-from-entries (entries user)
|
||||
"Return best matching password-store entry data from ENTRIES.
|
||||
|
||||
If USER is non nil, give precedence to entries containing a user field
|
||||
matching USER."
|
||||
(cl-reduce
|
||||
(lambda (result entry)
|
||||
(let ((entry-data (auth-source-pass-parse-entry entry)))
|
||||
(cond ((equal (auth-source-pass--get-attr "user" result) user)
|
||||
result)
|
||||
((equal (auth-source-pass--get-attr "user" entry-data) user)
|
||||
entry-data)
|
||||
(t
|
||||
result))))
|
||||
entries
|
||||
:initial-value (auth-source-pass-parse-entry (car entries))))
|
||||
(let (fallback)
|
||||
(catch 'auth-source-pass-break
|
||||
(dolist (entry entries fallback)
|
||||
(let ((entry-data (auth-source-pass-parse-entry entry)))
|
||||
(when (and entry-data (not fallback))
|
||||
(setq fallback entry-data)
|
||||
(when (or (not user) (equal (auth-source-pass--get-attr "user" entry-data) user))
|
||||
(throw 'auth-source-pass-break entry-data))))))))
|
||||
|
||||
(defun auth-source-pass--matching-entries (hostname user port)
|
||||
"Return all matching password-store entries for HOSTNAME, USER, & PORT.
|
||||
|
||||
The result is a list of lists of password-store entries, where
|
||||
each sublist contains entries that actually exist in the
|
||||
password-store matching one of the entry name formats that
|
||||
auth-source-pass expects, most specific to least specific."
|
||||
(let* ((entries-lists (mapcar
|
||||
#'cdr
|
||||
(auth-source-pass--accumulate-matches hostname user port)))
|
||||
(entries (apply #'cl-concatenate (cons 'list entries-lists))))
|
||||
(if entries
|
||||
(auth-source-pass--do-debug (format "found: %S" entries))
|
||||
(auth-source-pass--do-debug "no matches found"))
|
||||
entries-lists))
|
||||
|
||||
(defun auth-source-pass--accumulate-matches (hostname user port)
|
||||
"Accumulate matching password-store entries into sublists.
|
||||
|
||||
Entries matching supported formats that combine HOSTNAME, USER, &
|
||||
PORT are accumulated into sublists where the car of each sublist
|
||||
is a regular expression for matching paths in the password-store
|
||||
and the remainder is the list of matching entries."
|
||||
(let ((suffix-match-lists
|
||||
(mapcar (lambda (suffix) (list (format "\\(^\\|/\\)%s$" suffix)))
|
||||
(auth-source-pass--generate-entry-suffixes hostname user port))))
|
||||
(cl-reduce #'auth-source-pass--entry-reducer
|
||||
(auth-source-pass-entries)
|
||||
:initial-value suffix-match-lists)))
|
||||
|
||||
(defun auth-source-pass--entry-reducer (match-lists entry)
|
||||
"Match MATCH-LISTS sublists against ENTRY.
|
||||
|
||||
The result is a copy of match-lists with the entry added to the
|
||||
end of any sublists for which the regular expression at the head
|
||||
of the list matches the entry name."
|
||||
(mapcar (lambda (match-list)
|
||||
(if (string-match (car match-list) entry)
|
||||
(append match-list (list entry))
|
||||
match-list))
|
||||
match-lists))
|
||||
(defun auth-source-pass--entries-matching-suffix (suffix entries)
|
||||
"Return entries matching SUFFIX.
|
||||
If ENTRIES is nil, use the result of calling `auth-source-pass-entries' instead."
|
||||
(cl-remove-if-not
|
||||
(lambda (entry) (string-match-p
|
||||
(format "\\(^\\|/\\)%s$" (regexp-quote suffix))
|
||||
entry))
|
||||
(or entries (auth-source-pass-entries))))
|
||||
|
||||
(defun auth-source-pass--generate-entry-suffixes (hostname user port)
|
||||
"Return a list of possible entry path suffixes in the password-store.
|
||||
|
||||
@ -52,11 +52,21 @@
|
||||
(defvar auth-source-pass--debug-log nil
|
||||
"Contains a list of all messages passed to `auth-source-do-debug`.")
|
||||
|
||||
(defun auth-source-pass--should-have-message-containing (regexp)
|
||||
"Assert that at least one `auth-source-do-debug` matched REGEXP."
|
||||
(should (seq-find (lambda (message)
|
||||
(string-match regexp message))
|
||||
auth-source-pass--debug-log)))
|
||||
(defun auth-source-pass--have-message-matching (regexp)
|
||||
"Return non-nil iff at least one `auth-source-do-debug` match REGEXP."
|
||||
(seq-find (lambda (message)
|
||||
(string-match regexp message))
|
||||
auth-source-pass--debug-log))
|
||||
|
||||
(defun auth-source-pass--explain--have-message-matching (regexp)
|
||||
"Explainer function for `auth-source-pass--have-message-matching'.
|
||||
REGEXP is the same as in `auth-source-pass--have-message-matching'."
|
||||
`(regexp
|
||||
,regexp
|
||||
messages
|
||||
,(mapconcat #'identity auth-source-pass--debug-log "\n- ")))
|
||||
|
||||
(put #'auth-source-pass--have-message-matching 'ert-explainer #'auth-source-pass--explain--have-message-matching)
|
||||
|
||||
(defun auth-source-pass--debug (&rest msg)
|
||||
"Format MSG and add that to `auth-source-pass--debug-log`.
|
||||
@ -78,6 +88,82 @@ This function is intended to be set to `auth-source-debug`."
|
||||
(auth-source-pass--parse-log nil))
|
||||
,@body)))
|
||||
|
||||
(defun auth-source-pass--explain-match-entry-p (entry hostname &optional user port)
|
||||
"Explainer function for `auth-source-pass-match-entry-p'.
|
||||
|
||||
ENTRY, HOSTNAME, USER and PORT are the same as in `auth-source-pass-match-entry-p'."
|
||||
`(entry
|
||||
,entry
|
||||
store
|
||||
,(auth-source-pass-entries)
|
||||
matching-entries
|
||||
,(auth-source-pass--matching-entries hostname user port)))
|
||||
|
||||
(put 'auth-source-pass-match-entry-p 'ert-explainer #'auth-source-pass--explain-match-entry-p)
|
||||
|
||||
(defun auth-source-pass--includes-sorted-entries (entries hostname &optional user port)
|
||||
"Return non-nil iff ENTRIES matching the parameters are found in store.
|
||||
ENTRIES should be sorted from most specific to least specific.
|
||||
|
||||
HOSTNAME, USER and PORT are passed unchanged to
|
||||
`auth-source-pass--matching-entries'."
|
||||
(if (seq-empty-p entries)
|
||||
t
|
||||
(and
|
||||
(auth-source-pass-match-entry-p (car entries) hostname user port)
|
||||
(auth-source-pass--includes-sorted-entries (cdr entries) hostname user port))))
|
||||
|
||||
(defun auth-source-pass--explain-includes-sorted-entries (entries hostname &optional user port)
|
||||
"Explainer function for `auth-source-pass--includes-sorted-entries'.
|
||||
|
||||
ENTRIES, HOSTNAME, USER and PORT are the same as in `auth-source-pass--includes-sorted-entries'."
|
||||
`(store
|
||||
,(auth-source-pass-entries)
|
||||
matching-entries
|
||||
,(auth-source-pass--matching-entries hostname user port)
|
||||
entries
|
||||
,entries))
|
||||
|
||||
(put 'auth-source-pass--includes-sorted-entries 'ert-explainer #'auth-source-pass--explain-includes-sorted-entries)
|
||||
|
||||
(defun auth-source-pass--explain-match-any-entry-p (hostname &optional user port)
|
||||
"Explainer function for `auth-source-pass-match-any-entry-p'.
|
||||
|
||||
HOSTNAME, USER and PORT are the same as in `auth-source-pass-match-any-entry-p'."
|
||||
`(store
|
||||
,(auth-source-pass-entries)
|
||||
matching-entries
|
||||
,(auth-source-pass--matching-entries hostname user port)))
|
||||
|
||||
(put 'auth-source-pass-match-any-entry-p 'ert-explainer #'auth-source-pass--explain-match-any-entry-p)
|
||||
|
||||
(defun auth-source-pass--matching-entries (hostname &optional user port)
|
||||
"Return password-store entries matching HOSTNAME, USER, PORT.
|
||||
|
||||
The result is a list of lists of password-store entries. Each
|
||||
sublist contains the password-store entries whose names match a
|
||||
suffix in `auth-source-pass--generate-entry-suffixes'. The
|
||||
result is ordered the same way as the suffixes."
|
||||
(let ((entries (auth-source-pass-entries)))
|
||||
(mapcar (lambda (suffix) (auth-source-pass--entries-matching-suffix suffix entries))
|
||||
(auth-source-pass--generate-entry-suffixes hostname user port))))
|
||||
|
||||
(defun auth-source-pass-match-entry-p (entry hostname &optional user port)
|
||||
"Return non-nil iff an ENTRY matching the parameters is found in store.
|
||||
|
||||
HOSTNAME, USER and PORT are passed unchanged to
|
||||
`auth-source-pass--matching-entries'."
|
||||
(cl-find-if
|
||||
(lambda (entries) (cl-find entry entries :test #'string=))
|
||||
(auth-source-pass--matching-entries hostname user port)))
|
||||
|
||||
(defun auth-source-pass-match-any-entry-p (hostname &optional user port)
|
||||
"Return non-nil iff there is at least one entry matching the parameters.
|
||||
|
||||
HOSTNAME, USER and PORT are passed unchanged to
|
||||
`auth-source-pass--matching-entries'."
|
||||
(cl-find-if #'identity (auth-source-pass--matching-entries hostname user port)))
|
||||
|
||||
(ert-deftest auth-source-pass-any-host ()
|
||||
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
|
||||
("bar"))
|
||||
@ -93,6 +179,101 @@ This function is intended to be set to `auth-source-debug`."
|
||||
("bar"))
|
||||
(should-not (auth-source-pass-search :host "baz"))))
|
||||
|
||||
(ert-deftest auth-source-pass--disambiguate-extract-host-from-hostname ()
|
||||
;; no user or port
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "foo")) "foo"))
|
||||
;; only user
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "user@foo")) "foo"))
|
||||
;; only port
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "https://foo")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "foo:80")) "foo"))
|
||||
;; both user and port
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "https://user@foo")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "user@foo:80")) "foo"))
|
||||
;; all of the above with a trailing path
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "foo/path")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "user@foo/path")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "https://foo/path")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "foo:80/path")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "https://user@foo/path")) "foo"))
|
||||
(should (equal (cl-first (auth-source-pass--disambiguate "user@foo:80/path")) "foo")))
|
||||
|
||||
(ert-deftest auth-source-pass--disambiguate-extract-user-from-hostname ()
|
||||
;; no user or port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo")) nil))
|
||||
;; only user
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo")) "user"))
|
||||
;; only port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://foo")) nil))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo:80")) nil))
|
||||
;; both user and port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://user@foo")) "user"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo:80")) "user"))
|
||||
;; all of the above with a trailing path
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo/path")) nil))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo/path")) "user"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://foo/path")) nil))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo:80/path")) nil))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://user@foo/path")) "user"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo:80/path")) "user")))
|
||||
|
||||
(ert-deftest auth-source-pass--disambiguate-prefer-user-parameter ()
|
||||
;; no user or port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo" "user2")) "user2"))
|
||||
;; only user
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo" "user2")) "user2"))
|
||||
;; only port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://foo" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo:80" "user2")) "user2"))
|
||||
;; both user and port
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://user@foo" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo:80" "user2")) "user2"))
|
||||
;; all of the above with a trailing path
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo/path" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo/path" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://foo/path" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "foo:80/path" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "https://user@foo/path" "user2")) "user2"))
|
||||
(should (equal (cl-second (auth-source-pass--disambiguate "user@foo:80/path" "user2")) "user2")))
|
||||
|
||||
(ert-deftest auth-source-pass--disambiguate-extract-port-from-hostname ()
|
||||
;; no user or port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo")) "443"))
|
||||
;; only user
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo")) "443"))
|
||||
;; only port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://foo")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo:80")) "80"))
|
||||
;; both user and port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://user@foo")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo:80")) "80"))
|
||||
;; all of the above with a trailing path
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo/path")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo/path")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://foo/path")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo:80/path")) "80"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://user@foo/path")) "443"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo:80/path")) "80")))
|
||||
|
||||
(ert-deftest auth-source-pass--disambiguate-prefer-port-parameter ()
|
||||
;; no user or port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo" "user2" "8080")) "8080"))
|
||||
;; only user
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo" "user2" "8080")) "8080"))
|
||||
;; only port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://foo" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo:80" "user2" "8080")) "8080"))
|
||||
;; both user and port
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://user@foo" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo:80" "user2" "8080")) "8080"))
|
||||
;; all of the above with a trailing path
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo/path" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo/path" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://foo/path" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "foo:80/path" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "https://user@foo/path" "user2" "8080")) "8080"))
|
||||
(should (equal (cl-third (auth-source-pass--disambiguate "user@foo:80/path" "user2" "8080")) "8080")))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-minimal-parsing ()
|
||||
(let ((store-contents
|
||||
'(("baz" ("secret" . "baz password"))
|
||||
@ -121,156 +302,110 @@ This function is intended to be set to `auth-source-debug`."
|
||||
(should (equal auth-source-pass--parse-log '("bar.baz"))))
|
||||
(auth-source-pass--with-store store-contents
|
||||
(auth-source-pass--find-match "baz" nil nil)
|
||||
(should (equal auth-source-pass--parse-log '("baz"))))))
|
||||
(should (equal auth-source-pass--parse-log '("baz"))))
|
||||
(auth-source-pass--with-store
|
||||
'(("dir1/bar.com" ("key" . "val"))
|
||||
("dir2/bar.com" ("key" . "val"))
|
||||
("dir3/bar.com" ("key" . "val")))
|
||||
(auth-source-pass--find-match "bar.com" nil nil)
|
||||
(should (= (length auth-source-pass--parse-log) 1)))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password")))
|
||||
(let ((result (auth-source-pass--find-match "foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo password")))))
|
||||
(ert-deftest auth-source-pass--find-match-return-parsed-data ()
|
||||
(auth-source-pass--with-store '(("bar.com" ("key" . "val")))
|
||||
(should (consp (auth-source-pass--find-match "bar.com" nil nil))))
|
||||
(auth-source-pass--with-store '(("dir1/bar.com" ("key1" . "val1")) ("dir2/bar.com" ("key2" . "val2")))
|
||||
(should (consp (auth-source-pass--find-match "bar.com" nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name-part ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password")))
|
||||
(let ((result (auth-source-pass--find-match "https://foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name-ignoring-user ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password")))
|
||||
(let ((result (auth-source-pass--find-match "https://SomeUser@foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name-with-user ()
|
||||
(auth-source-pass--with-store
|
||||
'(("SomeUser@foo" ("secret" . "SomeUser@foo password")))
|
||||
(let ((result (auth-source-pass--find-match "https://SomeUser@foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"SomeUser@foo password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full ()
|
||||
(auth-source-pass--with-store
|
||||
'(("SomeUser@foo" ("secret" . "SomeUser@foo password"))
|
||||
("foo" ("secret" . "foo password")))
|
||||
(let ((result (auth-source-pass--find-match "https://SomeUser@foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"SomeUser@foo password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full-reversed ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password"))
|
||||
("SomeUser@foo" ("secret" . "SomeUser@foo password")))
|
||||
(let ((result (auth-source-pass--find-match "https://SomeUser@foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"SomeUser@foo password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-name-without-subdomain ()
|
||||
(ert-deftest auth-source-pass--matching-entries ()
|
||||
(auth-source-pass--with-store '(("bar.com"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo.bar.com" nil nil)
|
||||
'(nil ("bar.com") nil)))))
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "bar.com"))
|
||||
;; match even if sub-domain is asked for
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "foo.bar.com"))
|
||||
;; match even if a user is asked for
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "bar.com" "user"))
|
||||
;; match even if user as an @ sign
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "bar.com" "user@someplace"))
|
||||
;; match even if a port is asked for
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "bar.com" nil "8080"))
|
||||
;; match even if a user and a port are asked for
|
||||
(should (auth-source-pass-match-entry-p "bar.com" "bar.com" "user" "8080"))
|
||||
;; don't match if a '.' is replaced with another character
|
||||
(auth-source-pass--with-store '(("barXcom"))
|
||||
(should-not (auth-source-pass-match-any-entry-p "bar.com" nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-name-without-subdomain-with-user ()
|
||||
(auth-source-pass--with-store '(("someone@bar.com"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo.bar.com" "someone" nil)
|
||||
'(nil nil nil ("someone@bar.com") nil nil nil nil nil)))))
|
||||
(ert-deftest auth-source-pass--matching-entries-find-entries-with-a-username ()
|
||||
(auth-source-pass--with-store '(("user@foo"))
|
||||
(should (auth-source-pass-match-entry-p "user@foo" "foo" "user")))
|
||||
;; match even if sub-domain is asked for
|
||||
(auth-source-pass--with-store '(("user@bar.com"))
|
||||
(should (auth-source-pass-match-entry-p "user@bar.com" "foo.bar.com" "user")))
|
||||
;; don't match if no user is asked for
|
||||
(auth-source-pass--with-store '(("user@foo"))
|
||||
(should-not (auth-source-pass-match-any-entry-p "foo")))
|
||||
;; don't match if user is different
|
||||
(auth-source-pass--with-store '(("user1@foo"))
|
||||
(should-not (auth-source-pass-match-any-entry-p "foo" "user2")))
|
||||
;; don't match if sub-domain is asked for but user is different
|
||||
(auth-source-pass--with-store '(("user1@bar.com"))
|
||||
(should-not (auth-source-pass-match-any-entry-p "foo.bar.com" "user2"))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-name-without-subdomain-with-bad-user ()
|
||||
(auth-source-pass--with-store '(("someoneelse@bar.com"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo.bar.com" "someone" nil)
|
||||
'(nil nil nil nil nil nil nil nil nil)))))
|
||||
(ert-deftest auth-source-pass--matching-entries-find-entries-with-a-port ()
|
||||
(auth-source-pass--with-store '(("bar.com:8080"))
|
||||
(should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil "8080"))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-name-without-subdomain-prefer-full ()
|
||||
(auth-source-pass--with-store '(("bar.com") ("foo.bar.com"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo.bar.com" nil nil)
|
||||
'(("foo.bar.com") ("bar.com") nil)))))
|
||||
(ert-deftest auth-source-pass--matching-entries-find-entries-with-slash ()
|
||||
;; match if entry filename matches user
|
||||
(auth-source-pass--with-store '(("foo.com/user"))
|
||||
(should (auth-source-pass-match-entry-p "foo.com/user" "foo.com" "user")))
|
||||
;; match with port if entry filename matches user
|
||||
(auth-source-pass--with-store '(("foo.com:8080/user"))
|
||||
(should (auth-source-pass-match-entry-p "foo.com:8080/user" "foo.com" "user" "8080")))
|
||||
;; don't match if entry filename doesn't match user
|
||||
(auth-source-pass--with-store '(("foo.com/baz"))
|
||||
(should-not (auth-source-pass-match-any-entry-p "foo.com" "user"))))
|
||||
|
||||
(ert-deftest auth-source-pass-dont-match-at-folder-name ()
|
||||
(auth-source-pass--with-store '(("foo.bar.com/foo"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo.bar.com" nil nil)
|
||||
'(nil nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-host-port-and-subdir-user ()
|
||||
(auth-source-pass--with-store '(("bar.com:443/someone"))
|
||||
(should (equal (auth-source-pass--matching-entries "bar.com" "someone" "443")
|
||||
'(nil ("bar.com:443/someone") nil nil nil nil
|
||||
nil nil nil nil nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-host-port-and-subdir-user-with-custom-separator ()
|
||||
(ert-deftest auth-source-pass-matching-entries-with-custom-separator ()
|
||||
(let ((auth-source-pass-port-separator "#"))
|
||||
(auth-source-pass--with-store '(("bar.com#443/someone"))
|
||||
(should (equal (auth-source-pass--matching-entries "bar.com" "someone" "443")
|
||||
'(nil ("bar.com#443/someone") nil nil nil nil
|
||||
nil nil nil nil nil nil))))))
|
||||
(should (auth-source-pass-match-entry-p "bar.com#443/someone" "bar.com" "someone" "443")))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-extracting-user-from-host ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo.com/bar" ("secret" . "foo.com/bar password")))
|
||||
(let ((result (auth-source-pass--find-match "https://bar@foo.com" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo.com/bar password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-with-user-first ()
|
||||
(ert-deftest auth-source-pass--matching-entries-sort-results ()
|
||||
(auth-source-pass--with-store '(("user@foo") ("foo"))
|
||||
(should (auth-source-pass--includes-sorted-entries '("user@foo" "foo") "foo" "user")))
|
||||
;; same, but store is reversed
|
||||
(auth-source-pass--with-store '(("foo") ("user@foo"))
|
||||
(should (equal (auth-source-pass--matching-entries "foo" "user" nil)
|
||||
'(("user@foo") nil ("foo"))))
|
||||
(auth-source-pass--should-have-message-containing "found: (\"user@foo\" \"foo\"")))
|
||||
(should (auth-source-pass--includes-sorted-entries '("user@foo" "foo") "foo" "user")))
|
||||
;; with sub-domain
|
||||
(auth-source-pass--with-store '(("bar.com") ("foo.bar.com"))
|
||||
(should (auth-source-pass--includes-sorted-entries '("foo.bar.com" "bar.com") "foo.bar.com")))
|
||||
;; matching user in the entry data takes priority
|
||||
(auth-source-pass--with-store '(("dir1/bar.com") ("dir2/bar.com" ("user" . "user")))
|
||||
(should (auth-source-pass--includes-sorted-entries
|
||||
'("dir2/bar.com" "dir1/bar.com")
|
||||
"bar.com" "user")))
|
||||
;; same, but store is reversed
|
||||
(auth-source-pass--with-store '(("dir2/bar.com" ("user" . "user")) ("dir1/bar.com"))
|
||||
(should (auth-source-pass--includes-sorted-entries
|
||||
'("dir2/bar.com" "dir1/bar.com")
|
||||
"bar.com" "user"))))
|
||||
|
||||
(ert-deftest auth-source-pass-give-priority-to-desired-user ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password"))
|
||||
("subdir/foo" ("secret" . "subdir/foo password") ("user" . "someone")))
|
||||
(let ((result (auth-source-pass--find-match "foo" "someone" nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"subdir/foo password"))
|
||||
(should (equal (auth-source-pass--get-attr "user" result)
|
||||
"someone")))
|
||||
(auth-source-pass--should-have-message-containing "found: (\"foo\" \"subdir/foo\"")))
|
||||
|
||||
(ert-deftest auth-source-pass-give-priority-to-desired-user-reversed ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password") ("user" . "someone"))
|
||||
("subdir/foo" ("secret" . "subdir/foo password")))
|
||||
(let ((result (auth-source-pass--find-match "foo" "someone" nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo password")))
|
||||
(auth-source-pass--should-have-message-containing "found: (\"foo\" \"subdir/foo\"")))
|
||||
|
||||
(ert-deftest auth-source-pass-return-first-when-several-matches ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo" ("secret" . "foo password"))
|
||||
("subdir/foo" ("secret" . "subdir/foo password")))
|
||||
(let ((result (auth-source-pass--find-match "foo" nil nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"foo password")))
|
||||
(auth-source-pass--should-have-message-containing "found: (\"foo\" \"subdir/foo\"")))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-make-divansantana-happy ()
|
||||
(auth-source-pass--with-store '(("host.com"))
|
||||
(should (equal (auth-source-pass--matching-entries "smtp.host.com" "myusername@host.co.za" nil)
|
||||
'(nil nil nil nil nil ("host.com") nil nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-find-host-without-port ()
|
||||
(auth-source-pass--with-store
|
||||
'(("host.com" ("secret" . "host.com password")))
|
||||
(let ((result (auth-source-pass--find-match "host.com:8888" "someuser" nil)))
|
||||
(should (equal (auth-source-pass--get-attr "secret" result)
|
||||
"host.com password")))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-host-with-port ()
|
||||
(auth-source-pass--with-store '(("host.com:443"))
|
||||
(should (equal (auth-source-pass--matching-entries "host.com" "someuser" "443")
|
||||
'(nil nil nil nil ("host.com:443") nil
|
||||
nil nil nil nil nil nil)))))
|
||||
|
||||
(ert-deftest auth-source-pass-matching-entries-with-custom-port-separator ()
|
||||
(let ((auth-source-pass-port-separator "#"))
|
||||
(auth-source-pass--with-store '(("host.com#443"))
|
||||
(should (equal (auth-source-pass--matching-entries "host.com" "someuser" "443")
|
||||
'(nil nil nil nil ("host.com#443") nil
|
||||
nil nil nil nil nil nil))))))
|
||||
(ert-deftest auth-source-pass-all-supported-organizations ()
|
||||
;; test every possible entry to store this data: user=rms host=gnu.org port=22
|
||||
(dolist (entry '(;; only host name
|
||||
"gnu.org"
|
||||
;; hostname + user
|
||||
"gnu.org/rms" "rms@gnu.org"
|
||||
;; hostname + port
|
||||
"gnu.org:22"
|
||||
;; hostname + user + port
|
||||
"gnu.org:22/rms" "rms@gnu.org:22"
|
||||
;; all of the above in a random folder
|
||||
"a/b/gnu.org"
|
||||
"a/b/gnu.org/rms" "a/b/rms@gnu.org"
|
||||
"a/b/gnu.org:22"
|
||||
"a/b/gnu.org:22/rms" "a/b/rms@gnu.org:22"))
|
||||
(auth-source-pass--with-store `((,entry))
|
||||
(should (auth-source-pass-match-entry-p entry "gnu.org" "rms" "22")))))
|
||||
|
||||
(defmacro auth-source-pass--with-store-find-foo (store &rest body)
|
||||
"Use STORE while executing BODY. \"foo\" is the matched entry."
|
||||
@ -300,33 +435,6 @@ This function is intended to be set to `auth-source-debug`."
|
||||
(should (equal (plist-get result :port) 512))
|
||||
(should (equal (plist-get result :user) "anuser")))))
|
||||
|
||||
(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 _port)
|
||||
(setq passed-host host)
|
||||
nil)))
|
||||
(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)
|
||||
(should (equal passed-host "https://user@host.com"))
|
||||
(auth-source-pass--build-result "user@host.com" nil nil)
|
||||
(should (equal passed-host "user@host.com"))
|
||||
(auth-source-pass--build-result "user@host.com:443" nil nil)
|
||||
(should (equal passed-host "user@host.com:443")))))
|
||||
|
||||
(ert-deftest auth-source-pass-only-return-entries-that-can-be-open ()
|
||||
(auth-source-pass--with-store
|
||||
'(("foo.site.com" ("secret" . "foo.site.com password"))
|
||||
("bar.site.com") ; An entry name with no data is invalid
|
||||
("mail/baz.site.com/scott" ("secret" . "mail/baz.site.com/scott password")))
|
||||
(should (equal (auth-source-pass--find-match "foo.site.com" "someuser" nil)
|
||||
'(("secret" . "foo.site.com password"))))
|
||||
(should (equal (auth-source-pass--find-match "bar.site.com" "someuser" nil)
|
||||
nil))
|
||||
(should (equal (auth-source-pass--find-match "baz.site.com" "scott" nil)
|
||||
'(("secret" . "mail/baz.site.com/scott password"))))))
|
||||
|
||||
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
|
||||
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
|
||||
(auth-source-pass-enable)
|
||||
@ -334,6 +442,24 @@ This function is intended to be set to `auth-source-debug`."
|
||||
(should (equal (plist-get result :user) "someone"))
|
||||
(should (equal (plist-get result :host) "gitlab.com")))))
|
||||
|
||||
(ert-deftest auth-source-pass-prints-meaningful-debug-log ()
|
||||
(auth-source-pass--with-store '()
|
||||
(auth-source-pass--find-match "gitlab.com" nil nil)
|
||||
(should (auth-source-pass--have-message-matching
|
||||
"entries matching hostname=\"gitlab.com\""))
|
||||
(should (auth-source-pass--have-message-matching
|
||||
"corresponding suffixes to search for: .*\"gitlab.com\""))
|
||||
(should (auth-source-pass--have-message-matching
|
||||
"found no entries matching \"gitlab.com\"")))
|
||||
(auth-source-pass--with-store '(("gitlab.com"))
|
||||
(auth-source-pass--find-match "gitlab.com" nil nil)
|
||||
(should (auth-source-pass--have-message-matching
|
||||
"found 1 entry matching \"gitlab.com\": \"gitlab.com\"")))
|
||||
(auth-source-pass--with-store '(("a/gitlab.com") ("b/gitlab.com"))
|
||||
(auth-source-pass--find-match "gitlab.com" nil nil)
|
||||
(should (auth-source-pass--have-message-matching
|
||||
"found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")"))))
|
||||
|
||||
(provide 'auth-source-pass-tests)
|
||||
|
||||
;;; auth-source-pass-tests.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user