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

;; The query requires a user and doesn't specify a user to match against.
;; The only entry matching the host lacks a user, so the search fails.

(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc ()
  (ert-with-temp-file netrc-file
    :text "machine foo password a\n"
    (let ((auth-sources (list netrc-file))
          (auth-source-do-cache nil))
      (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))

(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss ()
  (let ((auth-source-pass-extra-query-keywords t))
    (auth-source-pass--with-store '(("foo" (secret . "a")))
      (auth-source-pass-enable)
      (should-not (auth-source-search :host "foo" :require '(:user) :max 2)))))

;; The query requires a user but does not provide a reference value to
;; match against.  An entry matching the host that specifies a user is
;; selected because any user will do.
(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc ()
  (ert-with-temp-file netrc-file
    :text "machine foo login bob password a\n"
    (let* ((auth-sources (list netrc-file))
           (auth-source-do-cache nil)
           (results (auth-source-search :host "foo" :require '(:user))))
      (dolist (result results)
        (setf (plist-get result :secret) (auth-info-password result)))
      (should (equal results '((:host "foo" :user "bob" :secret "a")))))))

(ert-deftest auth-source-pass-extra-query-keywords--req-param ()
  (let ((auth-source-pass-extra-query-keywords t))
    (auth-source-pass--with-store '(("foo/bob" (secret . "a")))
      (auth-source-pass-enable)
      (let ((results (auth-source-search :host "foo" :require '(:user))))
        (dolist (result results)
          (setf (plist-get result :secret) (auth-info-password result)))
        (should (equal results '((:host "foo" :user "bob" :secret "a"))))))))

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


;; An effectively empty entry in the store returns nothing but the
;; :host field matching the given host parameter.

(ert-deftest auth-source-pass-extra-query-keywords--netrc-baseline ()
  (ert-with-temp-file netrc-file
    :text "machine foo\n"
    (let* ((auth-sources (list netrc-file))
           (auth-source-do-cache nil)
           (results (auth-source-search :host "foo")))
      (should (equal results '((:host "foo")))))))

(ert-deftest auth-source-pass-extra-query-keywords--baseline ()
  (let ((auth-source-pass-extra-query-keywords t))
    (auth-source-pass--with-store '(("foo"))
      (auth-source-pass-enable)
      (should (equal (auth-source-search :host "foo") '((:host "foo")))))))

;; 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