emacs/test/lisp/erc/erc-services-tests.el

586 lines
23 KiB
EmacsLisp

;;; erc-services-tests.el --- Tests for erc-services. -*- lexical-binding:t -*-
;; Copyright (C) 2020-2024 Free Software Foundation, Inc.
;; 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:
;; TODO: move the auth-source tests somewhere else. They've been
;; stashed here for pragmatic reasons.
;;; Code:
(require 'ert-x)
(require 'erc-services)
(require 'erc-compat)
(require 'secrets)
;;;; Core auth-source
(ert-deftest erc--auth-source-determine-params-merge ()
(let ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-session-port 6697)
(erc-network 'fake)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create 'GNU.chat)))
(should (equal (erc--auth-source-determine-params-merge)
'(:host ("GNU.chat" "my.gnu.org" "irc.gnu.org")
:port ("6697" "irc")
:require (:secret))))
(should (equal (erc--auth-source-determine-params-merge :host "fake")
'(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
:port ("6697" "irc")
:require (:secret))))
(should (equal (erc--auth-source-determine-params-merge
:host '("fake") :require :host)
'(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
:require (:host :secret)
:port ("6697" "irc"))))
(should (equal (erc--auth-source-determine-params-merge
:host '("fake" "GNU.chat") :port "1234" :x "x")
'(:host ("fake" "GNU.chat" "my.gnu.org" "irc.gnu.org")
:port ("1234" "6697" "irc")
:x ("x")
:require (:secret))))))
(defun erc-services-tests--wrap-search (s)
(lambda (&rest r) (erc--unfun (apply s r))))
;; Some of the following may be related to bug#23438.
(defun erc-services-tests--auth-source-standard (search)
(setq search (erc-services-tests--wrap-search search))
(ert-info ("Session ID wins")
(let ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-session-port 6697)
(erc-network 'fake)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create 'GNU.chat)))
(should (string= (funcall search :user "#chan") "foo"))))
(ert-info ("Network wins")
(let* ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-session-port 6697)
(erc-network 'GNU.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "foo"))))
(ert-info ("Announced wins")
(let ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-session-port 6697)
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "baz"))))
(ert-info ("Dialed wins")
(let ((erc-session-server "irc.gnu.org")
(erc-session-port 6697)
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "bar")))))
(defun erc-services-tests--auth-source-announced (search)
(setq search (erc-services-tests--wrap-search search))
(let* ((erc--isupport-params (make-hash-table))
(erc-server-parameters '(("CHANTYPES" . "&#")))
(erc--target (erc--target-from-string "&chan")))
;; Pretend #chan is just some account name and not a channel.
(ert-info ("Host priorities reversed when target is local")
(ert-info ("Announced wins")
(let* ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-session-port 6697)
(erc-network 'GNU.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "baz"))))
(ert-info ("Dialed next")
(let* ((erc-server-announced-name "irc.gnu.org")
(erc-session-port 6697)
(erc-network 'GNU.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "bar"))))
(ert-info ("Network used as fallback")
(let* ((erc-session-port 6697)
(erc-network 'GNU.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil)))
(should (string= (funcall search :user "#chan") "foo")))))))
(defun erc-services-tests--auth-source-overrides (search)
(setq search (erc-services-tests--wrap-search search))
(let* ((erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-network 'GNU.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil))
(erc-session-port 6667))
(ert-info ("Specificity and overrides")
(ert-info ("More specific port")
(let ((erc-session-port 6697))
(should (string= (funcall search :user "#chan") "spam"))))
(ert-info ("More specific user (network loses)")
(should (string= (funcall search :user '("#fsf")) "42")))
(ert-info ("Actual override")
(should (string= (funcall search :port "6667") "sesame")))
(ert-info ("Overrides don't interfere with post-processing")
(should (string= (funcall search :host "MyHost") "123"))))))
;; auth-source netrc backend
(defvar erc-services-tests--auth-source-entries
'("machine irc.gnu.org port irc user \"#chan\" password bar"
"machine my.gnu.org port irc user \"#chan\" password baz"
"machine GNU.chat port irc user \"#chan\" password foo"))
;; FIXME explain what this is for
(defun erc-services-tests--auth-source-shuffle (&rest extra)
(string-join `(,@(sort (append erc-services-tests--auth-source-entries extra)
(lambda (&rest _) (zerop (random 2))))
"")
"\n"))
(ert-deftest erc--auth-source-search--netrc-standard ()
(ert-with-temp-file netrc-file
:prefix "erc--auth-source-search--standard"
:text (erc-services-tests--auth-source-shuffle)
(let ((auth-sources (list netrc-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--netrc-announced ()
(ert-with-temp-file netrc-file
:prefix "erc--auth-source-search--announced"
:text (erc-services-tests--auth-source-shuffle)
(let ((auth-sources (list netrc-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--netrc-overrides ()
(ert-with-temp-file netrc-file
:prefix "erc--auth-source-search--overrides"
:text (erc-services-tests--auth-source-shuffle
"machine GNU.chat port 6697 user \"#chan\" password spam"
"machine my.gnu.org port irc user \"#fsf\" password 42"
"machine irc.gnu.org port 6667 password sesame"
"machine MyHost port irc password 456"
"machine MyHost port 6667 password 123")
(let ((auth-sources (list netrc-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
;; auth-source plstore backend
(defun erc-services-test--call-with-plstore (&rest args)
(advice-add 'epg-decrypt-string :override
(lambda (&rest r) (prin1-to-string (cadr r)))
'((name . erc--auth-source-plstore)))
(advice-add 'epg-find-configuration :override
(lambda (&rest _) "" '((program . "/bin/true")))
'((name . erc--auth-source-plstore)))
(unwind-protect
(apply #'erc-auth-source-search args)
(advice-remove 'epg-decrypt-string 'erc--auth-source-plstore)
(advice-remove 'epg-find-configuration 'erc--auth-source-plstore)))
(defvar erc-services-tests--auth-source-plstore-standard-announced "\
;;; public entries -*- mode: plstore -*-
((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
:secret-secret t
:host \"irc.gnu.org\"
:user \"#chan\"
:port \"irc\")
(\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
:secret-secret t
:host \"my.gnu.org\"
:user \"#chan\"
:port \"irc\")
(\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
:secret-secret t
:host \"GNU.chat\"
:user \"#chan\"
:port \"irc\"))
;;; secret entries
((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
(\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
(\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\"))")
(ert-deftest erc--auth-source-search--plstore-standard ()
(ert-with-temp-file plstore-file
:suffix ".plist"
:text erc-services-tests--auth-source-plstore-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard
#'erc-services-test--call-with-plstore))
(kill-buffer (get-file-buffer plstore-file))))
(ert-deftest erc--auth-source-search--plstore-announced ()
(ert-with-temp-file plstore-file
:suffix ".plist"
:text erc-services-tests--auth-source-plstore-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced
#'erc-services-test--call-with-plstore))
(kill-buffer (get-file-buffer plstore-file))))
(ert-deftest erc--auth-source-search--plstore-overrides ()
(ert-with-temp-file plstore-file
:suffix ".plist"
:text "\
;;; public entries -*- mode: plstore -*-
((\"ba950d38118a76d71f9f0591bb373d6cb366a512\"
:secret-secret t :host \"irc.gnu.org\" :user \"#chan\" :port \"irc\")
(\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\"
:secret-secret t :host \"my.gnu.org\" :user \"#chan\" :port \"irc\")
(\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\"
:secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"irc\")
(\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\"
:secret-secret t :host \"GNU.chat\" :user \"#chan\" :port \"6697\")
(\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\"
:secret-secret t :host \"my.gnu.org\" :user \"#fsf\" :port \"irc\")
(\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\"
:secret-secret t :host \"irc.gnu.org\" :port \"6667\")
(\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\"
:secret-secret t :host \"MyHost\" :port \"irc\")
(\"61a6bd552059494f479ff720e8de33e22574650a\"
:secret-secret t :host \"MyHost\" :port \"6667\"))
;;; secret entries
((\"ba950d38118a76d71f9f0591bb373d6cb366a512\" :secret \"bar\")
(\"7f17ca445d11158065e911a6d0f4cbf52ca250e3\" :secret \"baz\")
(\"fcd3c8bd6daf4509de0ad6ee98e744ce0fca9377\" :secret \"foo\")
(\"1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a\" :secret \"spam\")
(\"6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc\" :secret \"42\")
(\"a33e2b3bd2d6f33995a4b88710a594a100c5e41d\" :secret \"sesame\")
(\"ab2fd349b2b7d6a9215bb35a92d054261b0b1537\" :secret \"456\")
(\"61a6bd552059494f479ff720e8de33e22574650a\" :secret \"123\"))"
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-overrides
#'erc-services-test--call-with-plstore))
(kill-buffer (get-file-buffer plstore-file))))
;; auth-source JSON backend
(defvar erc-services-tests--auth-source-json-standard-announced "\
[{\"host\": \"irc.gnu.org\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"bar\"},
{\"host\": \"my.gnu.org\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"baz\"},
{\"host\": \"GNU.chat\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"foo\"}]")
(ert-deftest erc--auth-source-search--json-standard ()
(ert-with-temp-file json-store
:text erc-services-tests--auth-source-json-standard-announced
:suffix ".json"
(let ((auth-sources (list json-store))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--json-announced ()
(ert-with-temp-file plstore-file
:suffix ".json"
:text erc-services-tests--auth-source-json-standard-announced
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--json-overrides ()
(ert-with-temp-file json-file
:suffix ".json"
:text "\
[{\"host\": \"irc.gnu.org\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"bar\"},
{\"host\": \"my.gnu.org\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"baz\"},
{\"host\": \"GNU.chat\",
\"port\": \"irc\",
\"user\": \"#chan\",
\"secret\": \"foo\"},
{\"host\": \"GNU.chat\",
\"user\": \"#chan\",
\"port\": \"6697\",
\"secret\": \"spam\"},
{\"host\": \"my.gnu.org\",
\"user\": \"#fsf\",
\"port\": \"irc\",
\"secret\": \"42\"},
{\"host\": \"irc.gnu.org\",
\"port\": \"6667\",
\"secret\": \"sesame\"},
{\"host\": \"MyHost\",
\"port\": \"irc\",
\"secret\": \"456\"},
{\"host\": \"MyHost\",
\"port\": \"6667\",
\"secret\": \"123\"}]"
(let ((auth-sources (list json-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
;; auth-source-secrets backend
(defvar erc-services-tests--auth-source-secrets-standard-entries
'(("#chan@irc.gnu.org:irc" ; label
(:host . "irc.gnu.org")
(:user . "#chan")
(:port . "irc")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("#chan@my.gnu.org:irc"
(:host . "my.gnu.org")
(:user . "#chan")
(:port . "irc")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("#chan@GNU.chat:irc"
(:host . "GNU.chat")
(:user . "#chan")
(:port . "irc")
(:xdg:schema . "org.freedesktop.Secret.Generic"))))
(defvar erc-services-tests--auth-source-secrets-standard-secrets
'(("#chan@irc.gnu.org:irc" . "bar")
("#chan@my.gnu.org:irc" . "baz")
("#chan@GNU.chat:irc" . "foo")))
(defun erc-services-tests--secrets-search-items (entries _ &rest r)
(mapcan (lambda (s)
(and (seq-every-p (pcase-lambda (`(,k . ,v))
(equal v (alist-get k (cdr s))))
(map-pairs r))
(list (car s))))
entries))
(ert-deftest erc--auth-source-search--secrets-standard ()
(skip-unless (bound-and-true-p secrets-enabled))
(let ((auth-sources '("secrets:Test"))
(auth-source-do-cache nil)
(entries erc-services-tests--auth-source-secrets-standard-entries)
(secrets erc-services-tests--auth-source-secrets-standard-secrets))
(cl-letf (((symbol-function 'secrets-search-items)
(apply-partially #'erc-services-tests--secrets-search-items
entries))
((symbol-function 'secrets-get-secret)
(lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
(lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--secrets-announced ()
(skip-unless (bound-and-true-p secrets-enabled))
(let ((auth-sources '("secrets:Test"))
(auth-source-do-cache nil)
(entries erc-services-tests--auth-source-secrets-standard-entries)
(secrets erc-services-tests--auth-source-secrets-standard-secrets))
(cl-letf (((symbol-function 'secrets-search-items)
(apply-partially #'erc-services-tests--secrets-search-items
entries))
((symbol-function 'secrets-get-secret)
(lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
(lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--secrets-overrides ()
(skip-unless (bound-and-true-p secrets-enabled))
(let ((auth-sources '("secrets:Test"))
(auth-source-do-cache nil)
(entries `(,@erc-services-tests--auth-source-secrets-standard-entries
("#chan@GNU.chat:6697"
(:host . "GNU.chat") (:user . "#chan") (:port . "6697")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("#fsf@my.gnu.org:irc"
(:host . "my.gnu.org") (:user . "#fsf") (:port . "irc")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("irc.gnu.org:6667"
(:host . "irc.gnu.org") (:port . "6667")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("MyHost:irc"
(:host . "MyHost") (:port . "irc")
(:xdg:schema . "org.freedesktop.Secret.Generic"))
("MyHost:6667"
(:host . "MyHost") (:port . "6667")
(:xdg:schema . "org.freedesktop.Secret.Generic"))))
(secrets `(,@erc-services-tests--auth-source-secrets-standard-secrets
("#chan@GNU.chat:6697" . "spam")
("#fsf@my.gnu.org:irc" . "42" )
("irc.gnu.org:6667" . "sesame")
("MyHost:irc" . "456")
("MyHost:6667" . "123"))))
(cl-letf (((symbol-function 'secrets-search-items)
(apply-partially #'erc-services-tests--secrets-search-items
entries))
((symbol-function 'secrets-get-secret)
(lambda (_ label) (assoc-default label secrets)))
((symbol-function 'secrets-get-attributes)
(lambda (_ label) (assoc-default label entries))))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
;; auth-source-pass backend
(require 'auth-source-pass)
;; `auth-source-pass--find-match-unambiguous' returns something like:
;;
;; (list :host "irc.gnu.org"
;; :port "6697"
;; :user "rms"
;; :secret
;; #[0 "\301\302\300\"\207"
;; [((secret . "freedom")) auth-source-pass--get-attr secret] 3])
;;
;; This function gives ^ (faked here to avoid gpg and file IO). See
;; `auth-source-pass--with-store' in ../auth-source-pass-tests.el
(defun erc-services-tests--asp-parse-entry (store entry)
(when-let* ((found (cl-find entry store :key #'car :test #'string=)))
(list (assoc 'secret (cdr found)))))
(defvar erc-join-tests--auth-source-pass-entries
'(("irc.gnu.org:irc/#chan" (secret . "bar"))
("my.gnu.org:irc/#chan" (secret . "baz"))
("GNU.chat:irc/#chan" (secret . "foo"))))
(ert-deftest erc--auth-source-search--pass-standard ()
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
(cl-letf (((symbol-function 'auth-source-pass-parse-entry)
(apply-partially #'erc-services-tests--asp-parse-entry store))
((symbol-function 'auth-source-pass-entries)
(lambda () (mapcar #'car store))))
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-announced ()
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
(cl-letf (((symbol-function 'auth-source-pass-parse-entry)
(apply-partially #'erc-services-tests--asp-parse-entry store))
((symbol-function 'auth-source-pass-entries)
(lambda () (mapcar #'car store))))
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-overrides ()
(let ((store
`(,@erc-join-tests--auth-source-pass-entries
("GNU.chat:6697/#chan" (secret . "spam"))
("my.gnu.org:irc/#fsf" (secret . "42"))
("irc.gnu.org:6667" (secret . "sesame"))
("MyHost:irc" (secret . "456"))
("MyHost:6667" (secret . "123"))))
(auth-sources '(password-store))
(auth-source-do-cache nil))
(cl-letf (((symbol-function 'auth-source-pass-parse-entry)
(apply-partially #'erc-services-tests--asp-parse-entry store))
((symbol-function 'auth-source-pass-entries)
(lambda () (mapcar #'car store))))
(erc-services-tests--auth-source-overrides #'erc-auth-source-search))))
;;;; The services module
(ert-deftest erc-nickserv-get-password ()
(should erc-prompt-for-nickserv-password)
(ert-with-temp-file netrc-file
:prefix "erc-nickserv-get-password"
:text (mapconcat 'identity
'("machine GNU/chat port 6697 user bob password spam"
"machine FSF.chat port 6697 user bob password sesame"
"machine MyHost port irc password 123")
"\n")
(let* ((auth-sources (list netrc-file))
(auth-source-do-cache nil)
(erc-nickserv-passwords '((FSF.chat (("alice" . "foo")
("joe" . "bar")))))
(erc-use-auth-source-for-nickserv-password t)
(erc-session-server "irc.gnu.org")
(erc-server-announced-name "my.gnu.org")
(erc-network 'FSF.chat)
(erc-server-current-nick "tester")
(erc-networks--id (erc-networks--id-create nil))
(erc-session-port 6697)
(search (erc-services-tests--wrap-search
#'erc-nickserv-get-password)))
(ert-info ("Lookup custom option")
(should (string= (funcall search "alice") "foo")))
(ert-info ("Auth source")
(ert-info ("Network")
(should (string= (funcall search "bob") "sesame")))
(ert-info ("Network ID")
(let ((erc-networks--id (erc-networks--id-create 'GNU/chat)))
(should (string= (funcall search "bob") "spam")))))
(ert-info ("Read input")
(should (string=
(ert-simulate-keys "baz\r" (erc-nickserv-get-password "mike"))
"baz")))
(ert-info ("Failed")
(should-not (ert-simulate-keys "\r"
(erc-nickserv-get-password "fake")))))))
;;; erc-services-tests.el ends here