mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 10:31:37 -08:00
Code Issues Projects Releases Wiki Activity
emacs/test/lisp/auth-source-tests.el
Stefan Kangas 385741fae2 Prefer ert-with-temp-(directory|file) 
* test/lisp/abbrev-tests.el (read-write-abbrev-file-test)
(read-write-abbrev-file-test-with-props)
(abbrev-edit-save-to-file-test):
* test/lisp/auth-source-tests.el (auth-source-test-netrc-create-secret)
(auth-source-delete):
* test/lisp/autoinsert-tests.el (autoinsert-tests-auto-insert-file):
* test/lisp/bookmark-tests.el (with-bookmark-test-save-load):
* test/lisp/buff-menu-tests.el (buff-menu-24962):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-export):
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
* test/lisp/dired-tests.el
(dired-test-bug27243-01, dired-test-bug27243-02)
(dired-test-bug27243-03, dired-test-bug27631)
(dired-test-bug27968, dired-test-with-temp-dirs):
* test/lisp/dired-x-tests.el (dired-test-bug25942):
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
* test/lisp/emacs-lisp/check-declare-tests.el (check-declare-tests-scan)
(check-declare-tests-verify-mismatch):
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env):
* test/lisp/emacs-lisp/package-tests.el (with-package-test)
(package-test-signed):
* test/lisp/emacs-lisp/testcover-tests.el (testcover-tests-markup-region)
(testcover-tests-run-test-case):
* test/lisp/emulation/viper-tests.el (viper-test-undo-kmacro):
* test/lisp/epg-tests.el (with-epg-tests):
* test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history):
* test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631):
* test/lisp/ffap-tests.el (ffap-tests-25243):
* test/lisp/files-tests.el (files-tests-bug-18141)
(files-tests-read-file-in-~, files-tests-make-directory)
(files-tests-copy-directory, files-tests-executable-find)
(files-tests-dont-rewrite-precious-files)
(files-tests--save-some-buffers):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27631):
* test/lisp/mail/uudecode-tests.el (uudecode-tests-decode-region-internal)
(uudecode-tests-decode-region-external):
* test/lisp/net/browse-url-tests.el (browse-url-tests-delete-temp-file):
* test/lisp/progmodes/elisp-mode-tests.el (xref--case-insensitive):
* test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list):
* test/lisp/progmodes/flymake-tests.el (ruby-backend):
* test/lisp/progmodes/python-tests.el (python-tests-with-temp-file):
* test/lisp/progmodes/sql-tests.el (with-sql-test-connect-harness):
* test/lisp/saveplace-tests.el (saveplace-test-save-place-to-alist/file)
(saveplace-test-forget-unreadable-files)
(saveplace-test-place-alist-to-file):
* test/lisp/so-long-tests/spelling-tests.el:
* test/lisp/textmodes/reftex-tests.el (reftex-locate-bibliography-files)
(reftex-parse-from-file-test):
* test/lisp/thumbs-tests.el (thumbs-tests-thumbsdir/create-if-missing):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
(vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
* test/lisp/vc/diff-mode-tests.el (diff-mode-test-ignore-trailing-dashes):
* test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-bug32173-02, wdired-test-symlink-name)
(wdired-test-unfinished-edit-01, wdired-test-bug34915)
(wdired-test-bug39280):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-default):
* test/src/filelock-tests.el (filelock-tests--fixture):
* test/src/inotify-tests.el (inotify-file-watch-simple):
* test/src/undo-tests.el (undo-test-file-modified): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
In some cases, this is just cleanup, but in several cases this fixes
bugs where an error would have lead to us not cleaning up.
2021-11-07 01:54:31 +01:00

433 lines
20 KiB
EmacsLisp
Raw Blame History

;;; auth-source-tests.el --- Tests for auth-source.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Damien Cassou <damien@cassou.me>,
;; Nicolas Petton <nicolas@petton.fr>
;; 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:
;;
;;; Code:
(require 'ert)
(eval-when-compile (require 'ert-x))
(require 'cl-lib)
(require 'auth-source)
(require 'secrets)
(defun auth-source-ensure-ignored-backend (source)
(auth-source-validate-backend source '((:source . "")
(:type . ignore))))
(defun auth-source-validate-backend (source validation-alist)
(let ((backend (auth-source-backend-parse source)))
(should (auth-source-backend-p backend))
(dolist (pair validation-alist)
(should (equal (eieio-oref backend (car pair)) (cdr pair))))))
(ert-deftest auth-source-backend-parse-macos-keychain ()
(auth-source-validate-backend '(:source (:macos-keychain-generic foobar))
'((:source . "foobar")
(:type . macos-keychain-generic)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-string ()
(auth-source-validate-backend "macos-keychain-generic:foobar"
'((:source . "foobar")
(:type . macos-keychain-generic)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-string ()
(auth-source-validate-backend "macos-keychain-internet:foobar"
'((:source . "foobar")
(:type . macos-keychain-internet)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-symbol ()
(auth-source-validate-backend 'macos-keychain-internet
'((:source . "default")
(:type . macos-keychain-internet)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-generic-symbol ()
(auth-source-validate-backend 'macos-keychain-generic
'((:source . "default")
(:type . macos-keychain-generic)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-macos-keychain-internet-default-string ()
(auth-source-validate-backend 'macos-keychain-internet
'((:source . "default")
(:type . macos-keychain-internet)
(:search-function . auth-source-macos-keychain-search)
(:create-function . auth-source-macos-keychain-create))))
(ert-deftest auth-source-backend-parse-plstore ()
(auth-source-validate-backend '(:source "foo.plist")
'((:source . "foo.plist")
(:type . plstore)
(:search-function . auth-source-plstore-search)
(:create-function . auth-source-plstore-create))))
(ert-deftest auth-source-backend-parse-netrc ()
(auth-source-validate-backend '(:source "foo")
'((:source . "foo")
(:type . netrc)
(:search-function . auth-source-netrc-search)
(:create-function . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-netrc-string ()
(auth-source-validate-backend "foo"
'((:source . "foo")
(:type . netrc)
(:search-function . auth-source-netrc-search)
(:create-function . auth-source-netrc-create))))
(ert-deftest auth-source-backend-parse-secrets ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend '(:source (:secrets "foo"))
'((:source . "foo")
(:type . secrets)
(:search-function . auth-source-secrets-search)
(:create-function . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-strings ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-validate-backend "secrets:foo"
'((:source . "foo")
(:type . secrets)
(:search-function . auth-source-secrets-search)
(:create-function . auth-source-secrets-create)))))
(ert-deftest auth-source-backend-parse-secrets-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
;; Redefine `secrets-get-alias' to map 'foo to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend '(:source (:secrets foo))
'((:source . "foo")
(:type . secrets)
(:search-function . auth-source-secrets-search)
(:create-function . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-symbol ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
;; Redefine `secrets-get-alias' to map 'default to "foo"
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) "foo")))
(auth-source-validate-backend 'default
'((:source . "foo")
(:type . secrets)
(:search-function . auth-source-secrets-search)
(:create-function . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-secrets-no-alias ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
;; Redefine `secrets-get-alias' to map 'foo to nil (so that
;; "Login" is used by default
(cl-letf (((symbol-function 'secrets-get-alias) (lambda (_) nil)))
(auth-source-validate-backend '(:source (:secrets foo))
'((:source . "Login")
(:type . secrets)
(:search-function . auth-source-secrets-search)
(:create-function . auth-source-secrets-create))))))
(ert-deftest auth-source-backend-parse-invalid-or-nil-source ()
(provide 'secrets) ; simulates the presence of the `secrets' package
(let ((secrets-enabled t))
(auth-source-ensure-ignored-backend nil)
(auth-source-ensure-ignored-backend '(:source '(foo)))
(auth-source-ensure-ignored-backend '(:source nil))))
(defun auth-source--test-netrc-parse-entry (entry host user port)
"Parse a netrc entry from buffer."
(auth-source-forget-all-cached)
(setq port (auth-source-ensure-strings port))
(with-temp-buffer
(insert entry)
(goto-char (point-min))
(let* ((check (lambda(alist)
(and alist
(auth-source-search-collection
host
(or
(auth-source--aget alist "machine")
(auth-source--aget alist "host")
t))
(auth-source-search-collection
user
(or
(auth-source--aget alist "login")
(auth-source--aget alist "account")
(auth-source--aget alist "user")
t))
(auth-source-search-collection
port
(or
(auth-source--aget alist "port")
(auth-source--aget alist "protocol")
t)))))
(entries (auth-source-netrc-parse-entries check 1)))
entries)))
(ert-deftest auth-source-test-netrc-parse-entry ()
(should (equal (auth-source--test-netrc-parse-entry
"machine mymachine1 login user1 password pass1\n" t t t)
'((("password" . "pass1")
("login" . "user1")
("machine" . "mymachine1")))))
(should (equal (auth-source--test-netrc-parse-entry
"machine mymachine1 login user1 password pass1 port 100\n"
t t t)
'((("port" . "100")
("password" . "pass1")
("login" . "user1")
("machine" . "mymachine1"))))))
(ert-deftest auth-source-test-netrc-parse-one ()
(should (equal (auth-source--test-netrc-parse-one--all
"machine host1\n# comment\n")
'("machine" "host1")))
(should (equal (auth-source--test-netrc-parse-one--all
"machine host1\n \n \nmachine host2\n")
'("machine" "host1" "machine" "host2"))))
(defun auth-source--test-netrc-parse-one--all (text)
"Parse TEXT with `auth-source-netrc-parse-one' until end,return list."
(with-temp-buffer
(insert text)
(goto-char (point-min))
(let ((one (auth-source-netrc-parse-one)) all)
(while one
(push one all)
(setq one (auth-source-netrc-parse-one)))
(nreverse all))))
(ert-deftest auth-source-test-format-prompt ()
(should (equal (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host")))
"test user host %p")))
(ert-deftest auth-source-test-remembrances-of-things-past ()
(let ((password-cache t)
(password-data (copy-hash-table password-data)))
(auth-source-remember '(:host "wedd") '(4 5 6))
(should (auth-source-remembered-p '(:host "wedd")))
(should-not (auth-source-remembered-p '(:host "xedd")))
(auth-source-remember '(:host "xedd") '(1 2 3))
(should (auth-source-remembered-p '(:host "xedd")))
(should-not (auth-source-remembered-p '(:host "zedd")))
(should (auth-source-recall '(:host "xedd")))
(should-not (auth-source-recall nil))
(auth-source-forget+ :host t)
(should-not (auth-source-remembered-p '(:host "xedd")))
(should-not (auth-source-remembered-p '(:host t)))))
(ert-deftest auth-source-test-searches ()
"Test auth-source searches with various parameters."
:tags '(auth-source auth-source/netrc)
(let* ((entries '("machine a1 port a2 user a3 password a4"
"machine b1 port b2 user b3 password b4"
"machine c1 port c2 user c3 password c4"))
;; First element: test description.
;; Second element: expected return data, serialized to a string.
;; Rest of elements: the parameters for `auth-source-search'.
(tests '(("any host, max 1"
"((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
:max 1 :host t)
("any host, default max is 1"
"((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
:host t)
("any host, boolean return"
"t"
:host t :max 0)
("no parameters, default max is 1"
"((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
)
("host c1, default max is 1"
"((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
:host "c1")
("host list of (c1), default max is 1"
"((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
:host ("c1"))
("any host, max 4"
"((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\") (:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\") (:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
:host t :max 4)
("host b1, default max is 1"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
:host "b1")
("host b1, port b2, user b3, default max is 1"
"((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
:host "b1" :port "b2" :user "b3")
))
(netrc-file (make-temp-file "auth-source-test" nil nil
(mapconcat 'identity entries "\n")))
(auth-sources (list netrc-file))
(auth-source-do-cache nil)
found found-as-string)
(dolist (test tests)
(cl-destructuring-bind (testname needed &rest parameters) test
(setq found (apply #'auth-source-search parameters))
(when (listp found)
(dolist (f found)
(setf f (plist-put f :secret
(let ((secret (plist-get f :secret)))
(if (functionp secret)
(funcall secret)
secret))))))
(setq found-as-string (format "%s: %S" testname found))
;; (message "With parameters %S found: [%s] needed: [%s]" parameters found-as-string needed)
(should (equal found-as-string (concat testname ": " needed)))))
(delete-file netrc-file)))
(ert-deftest auth-source-test-secrets-create-secret ()
(skip-unless secrets-enabled)
;; The "session" collection is temporary for the lifetime of the
;; Emacs process. Therefore, we don't care to delete it.
(let ((auth-sources '((:source (:secrets "session"))))
(auth-source-save-behavior t)
host auth-info auth-passwd)
(dolist (passwd '("foo" "" nil))
(unwind-protect
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
(lambda (_prompt &optional _initial _history default
_inherit-input-method)
default)))
(setq host
(md5 (concat (prin1-to-string process-environment) passwd))
auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(should (string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (equal auth-passwd passwd))
(when (functionp (plist-get auth-info :save-function))
(funcall (plist-get auth-info :save-function)))
;; Check, that the item has been created indeed.
(auth-source-forget+ :host t)
(setq auth-info (car (auth-source-search :host host))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(if (zerop (length passwd))
(progn
(should-not (plist-get auth-info :user))
(should-not (plist-get auth-info :host))
(should-not auth-passwd))
(should
(string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (string-equal auth-passwd passwd)))))
;; Cleanup.
;; Should use `auth-source-delete' when implemented for :secrets backend.
(secrets-delete-item
"session"
(format "%s@%s" (plist-get auth-info :user) (plist-get auth-info :host))))))
(ert-deftest auth-source-test-netrc-create-secret ()
(ert-with-temp-file netrc-file
:suffix "auth-source-test"
(let* ((auth-sources (list netrc-file))
(auth-source-save-behavior t)
host auth-info auth-passwd)
(dolist (passwd '("foo" "" nil))
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
(lambda (_prompt &optional _initial _history default
_inherit-input-method)
default)))
(setq host
(md5 (concat (prin1-to-string process-environment) passwd))
auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(should (string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (equal auth-passwd passwd))
(when (functionp (plist-get auth-info :save-function))
(funcall (plist-get auth-info :save-function)))
;; Check, that the item has been created indeed.
(auth-source-forget+ :host t)
(setq auth-source-netrc-cache nil)
(setq auth-info (car (auth-source-search :host host))
auth-passwd (plist-get auth-info :secret)
auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
auth-passwd))
(with-temp-buffer
(insert-file-contents netrc-file)
(if (zerop (length passwd))
(progn
(should-not (plist-get auth-info :user))
(should-not (plist-get auth-info :host))
(should-not auth-passwd)
(should-not (search-forward host nil 'noerror)))
(should
(string-equal (plist-get auth-info :user) (user-login-name)))
(should (string-equal (plist-get auth-info :host) host))
(should (string-equal auth-passwd passwd))
(should (search-forward host nil 'noerror)))))))))
(ert-deftest auth-source-delete ()
(ert-with-temp-file netrc-file
:suffix "auth-source-test" :text "\
machine a1 port a2 user a3 password a4
machine b1 port b2 user b3 password b4
machine c1 port c2 user c3 password c4\n"
(let* ((auth-sources (list netrc-file))
(auth-source-do-cache nil)
(expected '((:host "a1" :port "a2" :user "a3" :secret "a4")))
(parameters '(:max 1 :host t))
(found (apply #'auth-source-delete parameters)))
(dolist (f found)
(let ((s (plist-get f :secret)))
(setf f (plist-put f :secret
(if (functionp s) (funcall s) s)))))
;; Note: The netrc backend doesn't delete anything, so
;; this is actually the same as `auth-source-search'.
(should (equal found expected)))))
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
Reference in a new issue View git blame Copy permalink