test/lisp/auth-source-tests.el

   1 ;;; auth-source-tests.el --- Tests for auth-source.el  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Damien Cassou <damien@cassou.me>,
   6 ;;         Nicolas Petton <nicolas@petton.fr>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;
  26
  27 ;;; Code:
  28
  29 (require 'ert)
  30 (require 'cl-lib)
  31 (require 'auth-source)
  32 (require 'secrets)
  33
  34 (defun auth-source-ensure-ignored-backend (source)
  35     (auth-source-validate-backend source '((:source . "")
  36                                            (:type . ignore))))
  37
  38 (defun auth-source-validate-backend (source validation-alist)
  39   (let ((backend (auth-source-backend-parse source)))
  40     (should (auth-source-backend-p backend))
  41     (dolist (pair validation-alist)
  42       (should (equal (eieio-oref backend (car pair)) (cdr pair))))))
  43
  44 (ert-deftest auth-source-backend-parse-macos-keychain ()
  45   (auth-source-validate-backend '(:source (:macos-keychain-generic foobar))
  46                                 '((:source . "foobar")
  47                                   (:type . macos-keychain-generic)
  48                                   (:search-function . auth-source-macos-keychain-search)
  49                                   (:create-function . auth-source-macos-keychain-create))))
  50
  51 (ert-deftest auth-source-backend-parse-macos-keychain-generic-string ()
  52   (auth-source-validate-backend "macos-keychain-generic:foobar"
  53                                 '((:source . "foobar")
  54                                   (:type . macos-keychain-generic)
  55                                   (:search-function . auth-source-macos-keychain-search)
  56                                   (:create-function . auth-source-macos-keychain-create))))
  57
  58 (ert-deftest auth-source-backend-parse-macos-keychain-internet-string ()
  59   (auth-source-validate-backend "macos-keychain-internet:foobar"
  60                                 '((:source . "foobar")
  61                                   (:type . macos-keychain-internet)
  62                                   (:search-function . auth-source-macos-keychain-search)
  63                                   (:create-function . auth-source-macos-keychain-create))))
  64
  65 (ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol ()
  66   (auth-source-validate-backend 'macos-keychain-internet
  67                                 '((:source . "default")
  68                                   (:type . macos-keychain-internet)
  69                                   (:search-function . auth-source-macos-keychain-search)
  70                                   (:create-function . auth-source-macos-keychain-create))))
  71
  72 (ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol ()
  73   (auth-source-validate-backend 'macos-keychain-generic
  74                                 '((:source . "default")
  75                                   (:type . macos-keychain-generic)
  76                                   (:search-function . auth-source-macos-keychain-search)
  77                                   (:create-function . auth-source-macos-keychain-create))))
  78
  79 (ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string ()
  80   (auth-source-validate-backend 'macos-keychain-internet
  81                                 '((:source . "default")
  82                                   (:type . macos-keychain-internet)
  83                                   (:search-function . auth-source-macos-keychain-search)
  84                                   (:create-function . auth-source-macos-keychain-create))))
  85
  86 (ert-deftest auth-source-backend-parse-plstore ()
  87   (auth-source-validate-backend '(:source "foo.plist")
  88                                 '((:source . "foo.plist")
  89                                   (:type . plstore)
  90                                   (:search-function . auth-source-plstore-search)
  91                                   (:create-function . auth-source-plstore-create))))
  92
  93 (ert-deftest auth-source-backend-parse-netrc ()
  94   (auth-source-validate-backend '(:source "foo")
  95                                 '((:source . "foo")
  96                                   (:type . netrc)
  97                                   (:search-function . auth-source-netrc-search)
  98                                   (:create-function . auth-source-netrc-create))))
  99
 100 (ert-deftest auth-source-backend-parse-netrc-string ()
 101   (auth-source-validate-backend "foo"
 102                                 '((:source . "foo")
 103                                   (:type . netrc)
 104                                   (:search-function . auth-source-netrc-search)
 105                                   (:create-function . auth-source-netrc-create))))
 106
 107 (ert-deftest auth-source-backend-parse-secrets ()
 108   (provide 'secrets) ; simulates the presence of the `secrets' package
 109   (let ((secrets-enabled t))
 110     (auth-source-validate-backend '(:source (:secrets "foo"))
 111                                   '((:source . "foo")
 112                                     (:type . secrets)
 113                                     (:search-function . auth-source-secrets-search)
 114                                     (:create-function . auth-source-secrets-create)))))
 115
 116 (ert-deftest auth-source-backend-parse-secrets-strings ()
 117   (provide 'secrets) ; simulates the presence of the `secrets' package
 118   (let ((secrets-enabled t))
 119     (auth-source-validate-backend "secrets:foo"
 120                                   '((:source . "foo")
 121                                     (:type . secrets)
 122                                     (:search-function . auth-source-secrets-search)
 123                                     (:create-function . auth-source-secrets-create)))))
 124
 125 (ert-deftest auth-source-backend-parse-secrets-alias ()
 126   (provide 'secrets) ; simulates the presence of the `secrets' package
 127   (let ((secrets-enabled t))
 128     ;; Redefine `secrets-get-alias' to map 'foo to "foo"
 129     (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
 130       (auth-source-validate-backend '(:source (:secrets foo))
 131                                     '((:source . "foo")
 132                                       (:type . secrets)
 133                                       (:search-function . auth-source-secrets-search)
 134                                       (:create-function . auth-source-secrets-create))))))
 135
 136 (ert-deftest auth-source-backend-parse-secrets-symbol ()
 137   (provide 'secrets) ; simulates the presence of the `secrets' package
 138   (let ((secrets-enabled t))
 139     ;; Redefine `secrets-get-alias' to map 'default to "foo"
 140     (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
 141       (auth-source-validate-backend 'default
 142                                     '((:source . "foo")
 143                                       (:type . secrets)
 144                                       (:search-function . auth-source-secrets-search)
 145                                       (:create-function . auth-source-secrets-create))))))
 146
 147 (ert-deftest auth-source-backend-parse-secrets-no-alias ()
 148   (provide 'secrets) ; simulates the presence of the `secrets' package
 149   (let ((secrets-enabled t))
 150     ;; Redefine `secrets-get-alias' to map 'foo to nil (so that
 151     ;; "Login" is used by default
 152     (cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil)))
 153       (auth-source-validate-backend '(:source (:secrets foo))
 154                                     '((:source . "Login")
 155                                       (:type . secrets)
 156                                       (:search-function . auth-source-secrets-search)
 157                                       (:create-function . auth-source-secrets-create))))))
 158
 159 (ert-deftest auth-source-backend-parse-invalid-or-nil-source ()
 160   (provide 'secrets) ; simulates the presence of the `secrets' package
 161   (let ((secrets-enabled t))
 162     (auth-source-ensure-ignored-backend nil)
 163     (auth-source-ensure-ignored-backend '(:source '(foo)))
 164     (auth-source-ensure-ignored-backend '(:source nil))))
 165
 166 (defun auth-source--test-netrc-parse-entry (entry host user port)
 167   "Parse a netrc entry from buffer."
 168   (auth-source-forget-all-cached)
 169   (setq port (auth-source-ensure-strings port))
 170   (with-temp-buffer
 171     (insert entry)
 172     (goto-char (point-min))
 173     (let* ((check (lambda(alist)
 174                     (and alist
 175                          (auth-source-search-collection
 176                           host
 177                           (or
 178                            (auth-source--aget alist "machine")
 179                            (auth-source--aget alist "host")
 180                            t))
 181                          (auth-source-search-collection
 182                           user
 183                           (or
 184                            (auth-source--aget alist "login")
 185                            (auth-source--aget alist "account")
 186                            (auth-source--aget alist "user")
 187                            t))
 188                          (auth-source-search-collection
 189                           port
 190                           (or
 191                            (auth-source--aget alist "port")
 192                            (auth-source--aget alist "protocol")
 193                            t)))))
 194            (entries (auth-source-netrc-parse-entries check 1)))
 195       entries)))
 196
 197 (ert-deftest auth-source-test-netrc-parse-entry ()
 198   (should (equal (auth-source--test-netrc-parse-entry
 199                   "machine mymachine1 login user1 password pass1\n" t t t)
 200                  '((("password" . "pass1")
 201                     ("login" . "user1")
 202                     ("machine" . "mymachine1")))))
 203   (should (equal (auth-source--test-netrc-parse-entry
 204                   "machine mymachine1 login user1 password pass1 port 100\n"
 205                   t t t)
 206                  '((("port" . "100")
 207                     ("password" . "pass1")
 208                     ("login" . "user1")
 209                     ("machine" . "mymachine1"))))))
 210
 211 (ert-deftest auth-source-test-netrc-parse-one ()
 212   (should (equal (auth-source--test-netrc-parse-one--all
 213                   "machine host1\n# comment\n")
 214                  '("machine" "host1")))
 215   (should (equal (auth-source--test-netrc-parse-one--all
 216                   "machine host1\n  \n  \nmachine host2\n")
 217                  '("machine" "host1" "machine" "host2"))))
 218
 219 (defun auth-source--test-netrc-parse-one--all (text)
 220   "Parse TEXT with `auth-source-netrc-parse-one' until end,return list."
 221   (with-temp-buffer
 222     (insert text)
 223     (goto-char (point-min))
 224     (let ((one (auth-source-netrc-parse-one)) all)
 225       (while one
 226         (push one all)
 227         (setq one (auth-source-netrc-parse-one)))
 228       (nreverse all))))
 229
 230 (ert-deftest auth-source-test-format-prompt ()
 231   (should (equal (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
 232                  "test user host %p")))
 233
 234 (ert-deftest auth-source-test-remembrances-of-things-past ()
 235   (let ((password-cache t)
 236         (password-data (copy-hash-table password-data)))
 237     (auth-source-remember '(:host "wedd") '(4 5 6))
 238     (should (auth-source-remembered-p '(:host "wedd")))
 239     (should-not (auth-source-remembered-p '(:host "xedd")))
 240     (auth-source-remember '(:host "xedd") '(1 2 3))
 241     (should (auth-source-remembered-p '(:host "xedd")))
 242     (should-not (auth-source-remembered-p '(:host "zedd")))
 243     (should (auth-source-recall '(:host "xedd")))
 244     (should-not (auth-source-recall nil))
 245     (auth-source-forget+ :host t)
 246     (should-not (auth-source-remembered-p '(:host "xedd")))
 247     (should-not (auth-source-remembered-p '(:host t)))))
 248
 249 (ert-deftest auth-source-test-searches ()
 250   "Test auth-source searches with various parameters"
 251   :tags '(auth-source auth-source/netrc)
 252   (let* ((entries '("machine a1 port a2 user a3 password a4"
 253                     "machine b1 port b2 user b3 password b4"
 254                     "machine c1 port c2 user c3 password c4"))
 255          ;; First element: test description.
 256          ;; Second element: expected return data, serialized to a string.
 257          ;; Rest of elements: the parameters for `auth-source-search'.
 258          (tests '(("any host, max 1"
 259                    "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
 260                    :max 1 :host t)
 261                   ("any host, default max is 1"
 262                    "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
 263                    :host t)
 264                   ("any host, boolean return"
 265                    "t"
 266                    :host t :max 0)
 267                   ("no parameters, default max is 1"
 268                    "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
 269                    )
 270                   ("host c1, default max is 1"
 271                    "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
 272                    :host "c1")
 273                   ("host list of (c1), default max is 1"
 274                    "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
 275                    :host ("c1"))
 276                   ("any host, max 4"
 277                    "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\") (:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\") (:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
 278                    :host t :max 4)
 279                   ("host b1, default max is 1"
 280                   "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
 281                    :host "b1")
 282                   ("host b1, port b2, user b3, default max is 1"
 283                   "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
 284                    :host "b1" :port "b2" :user "b3")
 285                   ))
 286
 287          (netrc-file (make-temp-file "auth-source-test" nil nil
 288                                      (mapconcat 'identity entries "\n")))
 289          (auth-sources (list netrc-file))
 290          (auth-source-do-cache nil)
 291          found found-as-string)
 292
 293     (dolist (test tests)
 294       (cl-destructuring-bind (testname needed &rest parameters) test
 295         (setq found (apply #'auth-source-search parameters))
 296         (when (listp found)
 297           (dolist (f found)
 298             (setf f (plist-put f :secret
 299                                (let ((secret (plist-get f :secret)))
 300                                  (if (functionp secret)
 301                                      (funcall secret)
 302                                    secret))))))
 303
 304         (setq found-as-string (format "%s: %S" testname found))
 305         ;; (message "With parameters %S found: [%s] needed: [%s]" parameters found-as-string needed)
 306         (should (equal found-as-string (concat testname ": " needed)))))
 307     (delete-file netrc-file)))
 308
 309 (ert-deftest auth-source-test-secrets-create-secret ()
 310   (skip-unless secrets-enabled)
 311   ;; The "session" collection is temporary for the lifetime of the
 312   ;; Emacs process.  Therefore, we don't care to delete it.
 313   (let ((auth-sources '((:source (:secrets "session"))))
 314         (auth-source-save-behavior t)
 315         (host (md5 (concat (prin1-to-string process-environment)
 316                            (current-time-string))))
 317         (passwd (md5 (concat (prin1-to-string process-environment)
 318                              (current-time-string) (current-time-string))))
 319         auth-info auth-passwd)
 320     ;; Redefine `read-*' in order to avoid interactive input.
 321     (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
 322               ((symbol-function 'read-string)
 323                (lambda (_prompt _initial _history default) default)))
 324       (setq auth-info
 325             (car (auth-source-search
 326                   :max 1 :host host :require '(:user :secret) :create t))))
 327     (should (functionp (plist-get auth-info :save-function)))
 328     (funcall (plist-get auth-info :save-function))
 329
 330     ;; Check, that the item has been created indeed.
 331     (auth-source-forget+ :host t)
 332     (setq auth-info (car (auth-source-search :host host))
 333           auth-passwd (plist-get auth-info :secret)
 334           auth-passwd (if (functionp auth-passwd)
 335                           (funcall auth-passwd)
 336                         auth-passwd))
 337     (should (string-equal (plist-get auth-info :user) (user-login-name)))
 338     (should (string-equal (plist-get auth-info :host) host))
 339     (should (string-equal auth-passwd passwd))
 340
 341     ;; Cleanup.
 342     ;; Should use `auth-source-delete' when implemented for :secrets backend.
 343     (secrets-delete-item
 344      "session"
 345      (format "%s@%s" (plist-get auth-info :user) (plist-get auth-info :host)))))
 346
 347 (provide 'auth-source-tests)
 348 ;;; auth-source-tests.el ends here