mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
b068725d40
* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-39-clone-instance-inheritor-with-args): * test/lisp/auth-source-tests.el (auth-source-ensure-ignored-backend) (auth-source-backend-parse-macos-keychain) (auth-source-backend-parse-macos-keychain-generic-string) (auth-source-backend-parse-macos-keychain-internet-string) (auth-source-backend-parse-macos-keychain-internet-symbol) (auth-source-backend-parse-macos-keychain-generic-symbol) (auth-source-backend-parse-macos-keychain-internet-default-string) (auth-source-backend-parse-plstore, auth-source-backend-parse-netrc) (auth-source-backend-parse-netrc-string) (auth-source-backend-parse-secrets) (auth-source-backend-parse-secrets-strings) (auth-source-backend-parse-secrets-alias) (auth-source-backend-parse-secrets-symbol) (auth-source-backend-parse-secrets-no-alias): Use slot names rather than their :initargs.
491 lines
22 KiB
EmacsLisp
491 lines
22 KiB
EmacsLisp
;;; auth-source-tests.el --- Tests for auth-source.el -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2015-2024 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)
|
|
(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")
|
|
)))
|
|
(ert-with-temp-file netrc-file
|
|
:text (mapconcat 'identity entries "\n")
|
|
(let ((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 (auth-info-password f)))))
|
|
|
|
(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)))))))))
|
|
|
|
(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 (auth-info-password auth-info))
|
|
(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 (auth-info-password auth-info))
|
|
(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 (auth-info-password auth-info))
|
|
(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 (auth-info-password auth-info))
|
|
(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)
|
|
(setf f (plist-put f :secret (auth-info-password f))))
|
|
;; Note: The netrc backend doesn't delete anything, so
|
|
;; this is actually the same as `auth-source-search'.
|
|
(should (equal found expected)))))
|
|
|
|
(ert-deftest auth-source-test-netrc-credentials ()
|
|
(let ((data (auth-source-netrc-parse-all (ert-resource-file "authinfo"))))
|
|
(should data)
|
|
(let ((imap (seq-find (lambda (elem)
|
|
(equal (cdr (assoc "machine" elem))
|
|
"imap.example.org"))
|
|
data)))
|
|
(should (equal (cdr (assoc "login" imap)) "jrh@example.org"))
|
|
(should (equal (cdr (assoc "password" imap)) "*foobar*")))
|
|
(let ((imap (seq-find (lambda (elem)
|
|
(equal (cdr (assoc "machine" elem))
|
|
"ftp.example.org"))
|
|
data)))
|
|
(should (equal (cdr (assoc "login" imap)) "jrh"))
|
|
(should (equal (cdr (assoc "password" imap)) "*baz*")))))
|
|
|
|
(ert-deftest auth-source-test-netrc-credentials-2 ()
|
|
(let ((data (auth-source-netrc-parse-all
|
|
(ert-resource-file "netrc-folding"))))
|
|
(should
|
|
(equal data
|
|
'((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
|
|
(("machine" . "YM") ("login" . "YL") ("password" . "YP")))))))
|
|
|
|
(ert-deftest auth-source-test-macos-keychain-search ()
|
|
"Test if the constructed command line arglist is correct."
|
|
(let ((auth-sources '(macos-keychain-internet macos-keychain-generic)))
|
|
;; Redefine `call-process' to check command line arguments.
|
|
(cl-letf (((symbol-function 'call-process)
|
|
(lambda (_program _infile _destination _display
|
|
&rest args)
|
|
;; Arguments must be all strings.
|
|
(should (cl-every #'stringp args))
|
|
;; Argument number should be even.
|
|
(should (cl-evenp (length args)))
|
|
(should
|
|
(cond
|
|
((string= (car args) "find-internet-password")
|
|
(let ((protocol-r (cl-member "-r" args :test #'string=))
|
|
(protocol-P (cl-member "-P" args :test #'string=)))
|
|
(cond (protocol-r
|
|
(= 4 (length (cadr protocol-r))))
|
|
(protocol-P
|
|
(string-match-p
|
|
"\\`[[:digit:]]+\\'" (cadr protocol-P)))
|
|
(t))))
|
|
((string= (car args) "find-generic-password")
|
|
t))))))
|
|
(auth-source-search
|
|
:user '("a" "b") :host '("example.org")
|
|
:port '("irc" "ftp" "https" 123)))))
|
|
|
|
(provide 'auth-source-tests)
|
|
;;; auth-source-tests.el ends here
|