;;; auth-source-tests.el --- Tests for auth-source.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2024 Free Software Foundation, Inc. ;; Author: Damien Cassou , ;; Nicolas Petton ;; 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 . ;;; 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