test/lisp/auth-source-pass-tests.el

   1 ;;; auth-source-pass-tests.el --- Tests for auth-source-pass.el  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013, 2017-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Damien Cassou <damien.cassou@gmail.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Tests for auth-source-pass.el
  25
  26 ;;; Code:
  27
  28 (require 'ert)
  29
  30 (require 'auth-source-pass)
  31
  32 (eval-when-compile (require 'cl-lib))
  33
  34 (ert-deftest auth-source-pass-parse-simple ()
  35   (let ((content "pass\nkey1:val1\nkey2:val2\n"))
  36     (should (equal (auth-source-pass--parse-data content)
  37                    '(("key1" . "val1")
  38                      ("key2" . "val2"))))))
  39
  40 (ert-deftest auth-source-pass-parse-with-dash-line ()
  41   (let ((content "pass\n--\nkey1:val1\nkey2:val2\n"))
  42     (should (equal (auth-source-pass--parse-data content)
  43                    '(("key1" . "val1")
  44                      ("key2" . "val2"))))))
  45
  46 (ert-deftest auth-source-pass-parse-with-trailing-spaces ()
  47   (let ((content "pass\n--\nkey1 :val1   \nkey2:   val2\n\n"))
  48     (should (equal (auth-source-pass--parse-data content)
  49                    '(("key1" . "val1")
  50                      ("key2" . "val2"))))))
  51
  52 (defvar auth-source-pass--debug-log nil
  53   "Contains a list of all messages passed to `auth-source-do-debug`.")
  54
  55 (defun auth-source-pass--should-have-message-containing (regexp)
  56   "Assert that at least one `auth-source-do-debug` matched REGEXP."
  57   (should (seq-find (lambda (message)
  58                       (string-match regexp message))
  59                     auth-source-pass--debug-log)))
  60
  61 (defun auth-source-pass--debug (&rest msg)
  62   "Format MSG and add that to `auth-source-pass--debug-log`.
  63 This function is intended to be set to `auth-source-debug`."
  64   (add-to-list 'auth-source-pass--debug-log (apply #'format msg) t))
  65
  66 (defmacro auth-source-pass--with-store (store &rest body)
  67   "Use STORE as password-store while executing BODY."
  68   (declare (indent 1))
  69   `(cl-letf (((symbol-function 'auth-source-pass-parse-entry) (lambda (entry) (cdr (cl-find entry ,store :key #'car :test #'string=))) )
  70              ((symbol-function 'auth-source-pass-entries) (lambda () (mapcar #'car ,store)))
  71              ((symbol-function 'auth-source-pass--entry-valid-p) (lambda (_entry) t)))
  72      (let ((auth-source-debug #'auth-source-pass--debug)
  73            (auth-source-pass--debug-log nil))
  74        ,@body)))
  75
  76 (ert-deftest auth-source-pass-any-host ()
  77   (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
  78                                   ("bar"))
  79     (should-not (auth-source-pass-search :host t))))
  80
  81 (ert-deftest auth-source-pass-undefined-host ()
  82   (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user"))
  83                                   ("bar"))
  84     (should-not (auth-source-pass-search :host nil))))
  85
  86
  87 (ert-deftest auth-source-pass-find-match-matching-at-entry-name ()
  88   (auth-source-pass--with-store '(("foo"))
  89     (should (equal (auth-source-pass--find-match "foo" nil nil)
  90                    "foo"))))
  91
  92 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-part ()
  93   (auth-source-pass--with-store '(("foo"))
  94     (should (equal (auth-source-pass--find-match "https://foo" nil nil)
  95                    "foo"))))
  96
  97 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-ignoring-user ()
  98   (auth-source-pass--with-store '(("foo"))
  99     (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
 100                    "foo"))))
 101
 102 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-with-user ()
 103   (auth-source-pass--with-store '(("SomeUser@foo"))
 104     (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
 105                    "SomeUser@foo"))))
 106
 107 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full ()
 108   (auth-source-pass--with-store '(("SomeUser@foo") ("foo"))
 109     (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
 110                    "SomeUser@foo"))))
 111
 112 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-prefer-full-reversed ()
 113   (auth-source-pass--with-store '(("foo") ("SomeUser@foo"))
 114     (should (equal (auth-source-pass--find-match "https://SomeUser@foo" nil nil)
 115                    "SomeUser@foo"))))
 116
 117 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain ()
 118   (auth-source-pass--with-store '(("bar.com"))
 119     (should (equal (auth-source-pass--find-match "foo.bar.com" nil nil)
 120                    "bar.com"))))
 121
 122 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-with-user ()
 123   (auth-source-pass--with-store '(("someone@bar.com"))
 124     (should (equal (auth-source-pass--find-match "foo.bar.com" "someone" nil)
 125                    "someone@bar.com"))))
 126
 127 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-with-bad-user ()
 128   (auth-source-pass--with-store '(("someoneelse@bar.com"))
 129     (should (equal (auth-source-pass--find-match "foo.bar.com" "someone" nil)
 130                    nil))))
 131
 132 (ert-deftest auth-source-pass-find-match-matching-at-entry-name-without-subdomain-prefer-full ()
 133   (auth-source-pass--with-store '(("bar.com") ("foo.bar.com"))
 134     (should (equal (auth-source-pass--find-match "foo.bar.com" nil nil)
 135                    "foo.bar.com"))))
 136
 137 (ert-deftest auth-source-pass-dont-match-at-folder-name ()
 138   (auth-source-pass--with-store '(("foo.bar.com/foo"))
 139     (should (equal (auth-source-pass--find-match "foo.bar.com" nil nil)
 140                    nil))))
 141
 142 (ert-deftest auth-source-pass-find-match-matching-extracting-user-from-host ()
 143   (auth-source-pass--with-store '(("foo.com/bar"))
 144     (should (equal (auth-source-pass--find-match "https://bar@foo.com" nil nil)
 145                    "foo.com/bar"))))
 146
 147 (ert-deftest auth-source-pass-search-with-user-first ()
 148   (auth-source-pass--with-store '(("foo") ("user@foo"))
 149     (should (equal (auth-source-pass--find-match "foo" "user" nil)
 150                    "user@foo"))
 151     (auth-source-pass--should-have-message-containing "Found 1 match")))
 152
 153 (ert-deftest auth-source-pass-give-priority-to-desired-user ()
 154   (auth-source-pass--with-store '(("foo") ("subdir/foo" ("user" . "someone")))
 155     (should (equal (auth-source-pass--find-match "foo" "someone" nil)
 156                    "subdir/foo"))
 157     (auth-source-pass--should-have-message-containing "Found 2 matches")
 158     (auth-source-pass--should-have-message-containing "matching user field")))
 159
 160 (ert-deftest auth-source-pass-give-priority-to-desired-user-reversed ()
 161   (auth-source-pass--with-store '(("foo" ("user" . "someone")) ("subdir/foo"))
 162     (should (equal (auth-source-pass--find-match "foo" "someone" nil)
 163                    "foo"))
 164     (auth-source-pass--should-have-message-containing "Found 2 matches")
 165     (auth-source-pass--should-have-message-containing "matching user field")))
 166
 167 (ert-deftest auth-source-pass-return-first-when-several-matches ()
 168   (auth-source-pass--with-store '(("foo") ("subdir/foo"))
 169     (should (equal (auth-source-pass--find-match "foo" nil nil)
 170                    "foo"))
 171     (auth-source-pass--should-have-message-containing "Found 2 matches")
 172     (auth-source-pass--should-have-message-containing "the first one")))
 173
 174 (ert-deftest auth-source-pass-make-divansantana-happy ()
 175   (auth-source-pass--with-store '(("host.com"))
 176     (should (equal (auth-source-pass--find-match "smtp.host.com" "myusername@host.co.za" nil)
 177                    "host.com"))))
 178
 179 (ert-deftest auth-source-pass-find-host-without-port ()
 180   (auth-source-pass--with-store '(("host.com"))
 181     (should (equal (auth-source-pass--find-match "host.com:8888" "someuser" nil)
 182                    "host.com"))))
 183
 184 (defmacro auth-source-pass--with-store-find-foo (store &rest body)
 185   "Use STORE while executing BODY.  \"foo\" is the matched entry."
 186   (declare (indent 1))
 187   `(auth-source-pass--with-store ,store
 188      (cl-letf (((symbol-function 'auth-source-pass-find-match)
 189                 (lambda (_host _user)
 190                   "foo")))
 191        ,@body)))
 192
 193 (ert-deftest auth-source-pass-build-result-return-parameters ()
 194   (auth-source-pass--with-store-find-foo '(("foo"))
 195     (let ((result (auth-source-pass--build-result "foo" 512 "user")))
 196       (should (equal (plist-get result :port) 512))
 197       (should (equal (plist-get result :user) "user")))))
 198
 199 (ert-deftest auth-source-pass-build-result-return-entry-values ()
 200   (auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser")))
 201     (let ((result (auth-source-pass--build-result "foo" nil nil)))
 202       (should (equal (plist-get result :port) 512))
 203       (should (equal (plist-get result :user) "anuser")))))
 204
 205 (ert-deftest auth-source-pass-build-result-entry-takes-precedence ()
 206   (auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser")))
 207     (let ((result (auth-source-pass--build-result "foo" 1024 "anotheruser")))
 208       (should (equal (plist-get result :port) 512))
 209       (should (equal (plist-get result :user) "anuser")))))
 210
 211 (ert-deftest auth-source-pass-build-result-passes-full-host-to-find-match ()
 212   (let (passed-host)
 213     (cl-letf (((symbol-function 'auth-source-pass--find-match)
 214                (lambda (host _user _port) (setq passed-host host))))
 215       (auth-source-pass--build-result "https://user@host.com:123" nil nil)
 216       (should (equal passed-host "https://user@host.com:123"))
 217       (auth-source-pass--build-result "https://user@host.com" nil nil)
 218       (should (equal passed-host "https://user@host.com"))
 219       (auth-source-pass--build-result "user@host.com" nil nil)
 220       (should (equal passed-host "user@host.com"))
 221       (auth-source-pass--build-result "user@host.com:443" nil nil)
 222       (should (equal passed-host "user@host.com:443")))))
 223
 224 (ert-deftest auth-source-pass-only-return-entries-that-can-be-open ()
 225   (cl-letf (((symbol-function 'auth-source-pass-entries)
 226              (lambda () '("foo.site.com" "bar.site.com" "mail/baz.site.com/scott")))
 227             ((symbol-function 'auth-source-pass--entry-valid-p)
 228              ;; only foo.site.com and "mail/baz.site.com/scott" are valid
 229              (lambda (entry) (member entry '("foo.site.com" "mail/baz.site.com/scott")))))
 230     (should (equal (auth-source-pass--find-all-by-entry-name "foo.site.com" "someuser")
 231                    '("foo.site.com")))
 232     (should (equal (auth-source-pass--find-all-by-entry-name "bar.site.com" "someuser")
 233                    '()))
 234     (should (equal (auth-source-pass--find-all-by-entry-name "baz.site.com" "scott")
 235                    '("mail/baz.site.com/scott")))))
 236
 237 (ert-deftest auth-source-pass-entry-is-not-valid-when-unreadable ()
 238   (cl-letf (((symbol-function 'auth-source-pass--read-entry)
 239              (lambda (entry)
 240                ;; only foo is a valid entry
 241                (if (string-equal entry "foo")
 242                    "password"
 243                  nil))))
 244     (should (auth-source-pass--entry-valid-p "foo"))
 245     (should-not (auth-source-pass--entry-valid-p "bar"))))
 246
 247 (ert-deftest auth-source-pass-can-start-from-auth-source-search ()
 248   (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
 249     (auth-source-pass-enable)
 250     (let ((result (car (auth-source-search :host "gitlab.com"))))
 251       (should (equal (plist-get result :user) "someone"))
 252       (should (equal (plist-get result :host) "gitlab.com")))))
 253
 254 (provide 'auth-source-pass-tests)
 255
 256 ;;; auth-source-pass-tests.el ends here