758 lines
37 KiB
EmacsLisp
758 lines
37 KiB
EmacsLisp
;;; auth-source-pass-tests.el --- Tests for auth-source-pass.el -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2013, 2017-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Damien Cassou <damien.cassou@gmail.com>
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Tests for auth-source-pass.el
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert-x)
|
|
|
|
(require 'auth-source-pass)
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
(ert-deftest auth-source-pass-parse-simple ()
|
|
(let ((content "pass\nkey1:val1\nkey2:val2\n"))
|
|
(should (equal (auth-source-pass--parse-data content)
|
|
'(("key1" . "val1")
|
|
("key2" . "val2"))))))
|
|
|
|
(ert-deftest auth-source-pass-parse-with-dash-line ()
|
|
(let ((content "pass\n--\nkey1:val1\nkey2:val2\n"))
|
|
(should (equal (auth-source-pass--parse-data content)
|
|
'(("key1" . "val1")
|
|
("key2" . "val2"))))))
|
|
|
|
(ert-deftest auth-source-pass-parse-with-trailing-spaces ()
|
|
(let ((content "pass\n--\nkey1 :val1 \nkey2: val2\n\n"))
|
|
(should (equal (auth-source-pass--parse-data content)
|
|
'(("key1" . "val1")
|
|
("key2" . "val2"))))))
|
|
|
|
(ert-deftest auth-source-pass-parse-with-colons-in-data ()
|
|
(let ((content "pass\n--\nkey1 :val1\nkey2: please: keep my space after colon\n\n"))
|
|
(should (equal (auth-source-pass--parse-data content)
|
|
'(("key1" . "val1")
|
|
("key2" . "please: keep my space after colon"))))))
|
|
|
|
(defvar auth-source-pass--debug-log nil
|
|
"Contains a list of all messages passed to `auth-source-do-debug'.")
|
|
|
|
(defun auth-source-pass--have-message-matching (regexp)
|
|
"Return non-nil if 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'.
|
|
This function is intended to be set to `auth-source-debug'."
|
|
(add-to-list 'auth-source-pass--debug-log (apply #'format msg) t))
|
|
|
|
(defvar auth-source-pass--parse-log nil)
|
|
|
|
(defmacro auth-source-pass--with-store (store &rest body)
|
|
"Use STORE as password-store while executing BODY."
|
|
(declare (indent 1))
|
|
`(cl-letf (((symbol-function 'auth-source-pass-parse-entry)
|
|
(lambda (entry)
|
|
(add-to-list 'auth-source-pass--parse-log entry)
|
|
(cdr (cl-find entry ,store :key #'car :test #'string=))))
|
|
((symbol-function 'auth-source-pass-entries) (lambda () (mapcar #'car ,store))))
|
|
(let ((auth-source-debug #'auth-source-pass--debug)
|
|
(auth-source-pass--debug-log nil)
|
|
(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 if 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 if 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 if 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"))
|
|
(let ((inhibit-message t)) ; silence "... does not handle host wildcards."
|
|
(should-not (auth-source-pass-search :host t)))))
|
|
|
|
(ert-deftest auth-source-pass-undefined-host ()
|
|
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
|
|
("bar"))
|
|
(should-not (auth-source-pass-search :host nil))))
|
|
|
|
(ert-deftest auth-source-pass-not-found ()
|
|
(auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
|
|
("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"))
|
|
("baz:123" ("secret" . "baz:123 password"))
|
|
("baz/foo" ("secret" . "baz/foo password"))
|
|
("foo@baz" ("secret" . "foo@baz password"))
|
|
("baz:123/foo" ("secret" . "baz:123/foo password"))
|
|
("foo@baz:123" ("secret" . "foo@baz:123 password"))
|
|
("bar.baz" ("secret" . "bar.baz password"))
|
|
("bar.baz:123" ("secret" . "bar.baz:123 password"))
|
|
("bar.baz/foo" ("secret" . "bar.baz/foo password"))
|
|
("foo@bar.baz" ("secret" . "foo@bar.baz password"))
|
|
("bar.baz:123/foo" ("secret" . "bar.baz:123/foo password"))
|
|
("foo@bar.baz:123" ("secret" . "foo@bar.baz:123 password")))))
|
|
(auth-source-pass--with-store store-contents
|
|
(auth-source-pass--find-match "bar.baz" "foo" "123")
|
|
(should (equal auth-source-pass--parse-log '("foo@bar.baz:123"))))
|
|
(auth-source-pass--with-store store-contents
|
|
(auth-source-pass--find-match "bar.baz" "foo" nil)
|
|
(should (equal auth-source-pass--parse-log '("foo@bar.baz"))))
|
|
(auth-source-pass--with-store store-contents
|
|
(auth-source-pass--find-match "bar.baz" nil "123")
|
|
(should (equal auth-source-pass--parse-log '("bar.baz:123"))))
|
|
(auth-source-pass--with-store store-contents
|
|
(auth-source-pass--find-match "bar.baz" nil nil)
|
|
(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"))))
|
|
(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-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--matching-entries ()
|
|
(auth-source-pass--with-store '(("bar.com"))
|
|
(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-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-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-find-entries-with-a-port-when-passed-multiple-ports ()
|
|
(auth-source-pass--with-store '(("bar.com:8080"))
|
|
(should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil '("http" "https" "80" "8080")))))
|
|
|
|
(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-matching-entries-with-custom-separator ()
|
|
(let ((auth-source-pass-port-separator "#"))
|
|
(auth-source-pass--with-store '(("bar.com#443/someone"))
|
|
(should (auth-source-pass-match-entry-p "bar.com#443/someone" "bar.com" "someone" "443")))))
|
|
|
|
(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 (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-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."
|
|
(declare (indent 1))
|
|
`(auth-source-pass--with-store ,store
|
|
(cl-letf (((symbol-function 'auth-source-pass-find-match)
|
|
(lambda (_host _user)
|
|
"foo")))
|
|
,@body)))
|
|
|
|
(ert-deftest auth-source-pass-build-result-return-parameters ()
|
|
(auth-source-pass--with-store-find-foo
|
|
'(("foo" ("secret" . "foo password")))
|
|
(let ((result (auth-source-pass--build-result "foo" 512 "user")))
|
|
(should (equal (plist-get result :host) "foo"))
|
|
(should (equal (plist-get result :port) 512))
|
|
(should (equal (plist-get result :user) "user")))))
|
|
|
|
(ert-deftest auth-source-pass-build-result-return-entry-values ()
|
|
(auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser")))
|
|
(let ((result (auth-source-pass--build-result "foo" nil nil)))
|
|
(should (equal (plist-get result :host) "foo"))
|
|
(should (equal (plist-get result :port) 512))
|
|
(should (equal (plist-get result :user) "anuser")))))
|
|
|
|
(ert-deftest auth-source-pass-build-result-entry-takes-precedence ()
|
|
(auth-source-pass--with-store-find-foo '(("foo" ("host" . "bar") ("port" . 512) ("user" . "anuser")))
|
|
(let ((result (auth-source-pass--build-result "foo" 1024 "anotheruser")))
|
|
(should (equal (plist-get result :host) "bar"))
|
|
(should (equal (plist-get result :port) 512))
|
|
(should (equal (plist-get result :user) "anuser")))))
|
|
|
|
(ert-deftest auth-source-pass-build-result-with-multiple-hosts ()
|
|
(auth-source-pass--with-store-find-foo
|
|
'(("foo" ("secret" . "foo password")))
|
|
(let ((result (auth-source-pass--build-result '("bar" "foo") 512 "user")))
|
|
(should (equal (plist-get result :host) "foo"))
|
|
(should (equal (plist-get result :port) 512))
|
|
(should (equal (plist-get result :user) "user")))))
|
|
|
|
(ert-deftest auth-source-pass-build-result-with-multiple-hosts-no-match ()
|
|
(auth-source-pass--with-store-find-foo
|
|
'(("foo" ("secret" . "foo password")))
|
|
(should-not (auth-source-pass--build-result '("bar" "baz") 512 "user"))))
|
|
|
|
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
|
|
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
|
|
(auth-source-pass-enable)
|
|
;; This also asserts an aspect of traditional search behavior
|
|
;; relative to `auth-source-pass-extra-query-keywords'.
|
|
(let* ((auth-source-pass-extra-query-keywords nil)
|
|
(result (car (auth-source-search :host "gitlab.com"))))
|
|
(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\")"))))
|
|
|
|
|
|
;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
|
|
|
|
;; No entry has the requested port, but a result is still returned.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc ()
|
|
(ert-with-temp-file netrc-file
|
|
:text "\
|
|
machine x.com password a
|
|
machine x.com port 42 password b
|
|
"
|
|
(let* ((auth-sources (list netrc-file))
|
|
(auth-source-do-cache nil)
|
|
(results (auth-source-search :host "x.com" :port 22 :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results '((:host "x.com" :secret "a")))))))
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
|
|
(auth-source-pass--with-store '(("x.com" (secret . "a"))
|
|
("x.com:42" (secret . "b")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host "x.com" :port 22 :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results '((:host "x.com" :secret "a")))))))
|
|
|
|
;; One of two entries has the requested port, both returned.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc ()
|
|
(ert-with-temp-file netrc-file
|
|
:text "\
|
|
machine x.com password a
|
|
machine x.com port 42 password b
|
|
"
|
|
(let* ((auth-sources (list netrc-file))
|
|
(auth-source-do-cache nil)
|
|
(results (auth-source-search :host "x.com" :port 42 :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results '((:host "x.com" :secret "a")
|
|
(:host "x.com" :port "42" :secret "b")))))))
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit ()
|
|
(auth-source-pass--with-store '(("x.com" (secret . "a"))
|
|
("x.com:42" (secret . "b")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host "x.com" :port 42 :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "x.com" :secret "a")
|
|
(:host "x.com" :port 42 :secret "b")))))))
|
|
|
|
;; No entry has the requested port, but :port is required, so search fails.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc ()
|
|
(ert-with-temp-file netrc-file
|
|
:text "\
|
|
machine x.com password a
|
|
machine x.com port 42 password b
|
|
"
|
|
(let* ((auth-sources (list netrc-file))
|
|
(auth-source-do-cache nil)
|
|
(results (auth-source-search
|
|
:host "x.com" :port 22 :require '(:port) :max 2)))
|
|
(should-not results))))
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
|
|
(let ((auth-source-pass-extra-query-keywords t))
|
|
(auth-source-pass--with-store '(("x.com" (secret . "a"))
|
|
("x.com:42" (secret . "b")))
|
|
(auth-source-pass-enable)
|
|
(should-not (auth-source-search
|
|
:host "x.com" :port 22 :require '(:port) :max 2)))))
|
|
|
|
;; Specifying a :host without a :user finds a lone entry and does not
|
|
;; include extra fields (i.e., :port nil) in the result.
|
|
;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib ()
|
|
(ert-with-temp-file netrc-file
|
|
:text "\
|
|
machine x.com password a
|
|
machine disroot.org user akib password b
|
|
machine z.com password c
|
|
"
|
|
(let* ((auth-sources (list netrc-file))
|
|
(auth-source-do-cache nil)
|
|
(results (auth-source-search :host "disroot.org" :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "disroot.org" :user "akib" :secret "b")))))))
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--akib ()
|
|
(auth-source-pass--with-store '(("x.com" (secret . "a"))
|
|
("akib@disroot.org" (secret . "b"))
|
|
("z.com" (secret . "c")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host "disroot.org" :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "disroot.org" :user "akib" :secret "b")))))))
|
|
|
|
;; Searches for :host are case-sensitive, and a returned host isn't
|
|
;; normalized.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--netrc-host ()
|
|
(ert-with-temp-file netrc-file
|
|
:text "\
|
|
machine libera.chat password a
|
|
machine Libera.Chat password b
|
|
"
|
|
(let* ((auth-sources (list netrc-file))
|
|
(auth-source-do-cache nil)
|
|
(results (auth-source-search :host "Libera.Chat" :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results '((:host "Libera.Chat" :secret "b")))))))
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--host ()
|
|
(auth-source-pass--with-store '(("libera.chat" (secret . "a"))
|
|
("Libera.Chat" (secret . "b")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host "Libera.Chat" :max 2)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "Libera.Chat" :secret "b")))))))
|
|
|
|
|
|
;; A retrieved store entry mustn't be nil regardless of whether its
|
|
;; path contains port or user components.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--baseline ()
|
|
(let ((auth-source-pass-extra-query-keywords t))
|
|
(auth-source-pass--with-store '(("x.com"))
|
|
(auth-source-pass-enable)
|
|
(should-not (auth-source-search :host "x.com")))))
|
|
|
|
;; Output port type (int or string) matches that of input parameter.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--port-type ()
|
|
(let ((auth-source-pass-extra-query-keywords t)
|
|
(f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r)))
|
|
(auth-source-pass--with-store '(("x.com:42" (secret . "a")))
|
|
(auth-source-pass-enable)
|
|
(should (equal (mapcar f (auth-source-search :host "x.com" :port 42))
|
|
'((:host "x.com" :port 42 :secret "a")))))
|
|
(auth-source-pass--with-store '(("x.com:42" (secret . "a")))
|
|
(auth-source-pass-enable)
|
|
(should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
|
|
'((:host "x.com" :port "42" :secret "a")))))))
|
|
|
|
;; Match precision sometimes takes a back seat to the traversal
|
|
;; ordering. Specifically, the :host (h1, ...) args hold greater sway
|
|
;; over the output because they determine the first coordinate in the
|
|
;; sequence of (host, user, port) combinations visited. (Taking a
|
|
;; tree-wise view, these become the depth-1 nodes in a DFS.)
|
|
|
|
;; Note that all trailing /user forms are demoted for the sake of
|
|
;; predictability (see tests further below for details). This means
|
|
;; that, in the following test, /bar is held in limbo, followed by
|
|
;; /foo, but they both retain priority over "gnu.org", as noted above.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
|
|
(auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
|
|
("gnu.org" (secret . "b"))
|
|
("x.com" (secret . "c"))
|
|
("fake.com" (secret . "d"))
|
|
("x.com/foo" (secret . "e")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host '("x.com" "gnu.org") :max 3)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
;; Notice gnu.org is never considered ^
|
|
'((:host "x.com" :secret "c")
|
|
(:host "x.com" :user "bar" :port "42" :secret "a")
|
|
(:host "x.com" :user "foo" :secret "e")))))))
|
|
|
|
;; This is another example given in the bug thread.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
|
|
(auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
|
|
("foo.com" (secret . "b"))
|
|
("bar.org" (secret . "c"))
|
|
("fake.com" (secret . "d")))
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host "bar.org" :max 3)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results '((:host "bar.org" :secret "c")))))))
|
|
|
|
;; This conveys the same idea as `user-priorities', just below, but
|
|
;; with slightly more realistic and less legible values.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
|
|
(let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a"))
|
|
("s p@m@x.com" (secret . "b"))
|
|
("x.com" (secret . "?"))
|
|
("s p@m@y.org" (secret . "c"))
|
|
("fa ke" (secret . "?"))
|
|
("fa ke/s p@m" (secret . "d"))
|
|
("y.org/s p@m" (secret . "?"))
|
|
("s p@m@fa ke" (secret . "e"))))
|
|
(lambda (&rest _) (zerop (random 2))))))
|
|
(auth-source-pass--with-store store
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host '("x.com" "fa ke" "y.org")
|
|
:user "s p@m"
|
|
:require '(:user) :max 5)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "x.com" :user "s p@m" :secret "b")
|
|
(:host "x.com" :user "s p@m" :port "42" :secret "a")
|
|
(:host "fa ke" :user "s p@m" :secret "e")
|
|
(:host "fa ke" :user "s p@m" :secret "d")
|
|
(:host "y.org" :user "s p@m" :secret "c"))))))))
|
|
|
|
;; This is a more distilled version of `suffixed-user', above. It
|
|
;; better illustrates that search order takes precedence over "/user"
|
|
;; demotion because otherwise * and ** would be swapped, below. It
|
|
;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
|
|
;; h:2/u, u@g:1}.
|
|
|
|
(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
|
|
(let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
|
|
("h:2/u" (secret . "/"))
|
|
("u@h:1" (secret . "@"))
|
|
("u@h:2" (secret . "@"))
|
|
("g:1/u" (secret . "/"))
|
|
("g:2/u" (secret . "/"))
|
|
("u@g:1" (secret . "@"))
|
|
("u@g:2" (secret . "@"))))
|
|
(lambda (&rest _) (zerop (random 2))))))
|
|
(auth-source-pass--with-store store
|
|
(auth-source-pass-enable)
|
|
(let* ((auth-source-pass-extra-query-keywords t)
|
|
(results (auth-source-search :host '("h" "g")
|
|
:port 2
|
|
:max 5)))
|
|
(dolist (result results)
|
|
(setf (plist-get result :secret) (auth-info-password result)))
|
|
(should (equal results
|
|
'((:host "h" :user "u" :port 2 :secret "@")
|
|
(:host "h" :user "u" :port 2 :secret "/") ; *
|
|
(:host "g" :user "u" :port 2 :secret "@") ; **
|
|
(:host "g" :user "u" :port 2 :secret "/"))))))))
|
|
|
|
(provide 'auth-source-pass-tests)
|
|
|
|
;;; auth-source-pass-tests.el ends here
|