From: "J.P." <jp@neverwas.me>
To: Michael Albinus <michael.albinus@gmx.de>,
Damien Cassou <damien@cassou.me>
Cc: 48598@debbugs.gnu.org, Ted Zlatanov <tzz@lifelogs.com>,
emacs-erc@gnu.org, Sam Steingold <sds@gnu.org>
Subject: bug#48598: Questions regarding auth-source integration (bug#48598)
Date: Wed, 20 Apr 2022 07:12:48 -0700 [thread overview]
Message-ID: <878rrz268v.fsf__2835.73416979692$1650467033$gmane$org@neverwas.me> (raw)
In-Reply-To: <87k0bmbage.fsf@gmx.de> (Michael Albinus's message of "Mon, 18 Apr 2022 18:52:33 +0200")
[-- Attachment #1: Type: text/plain, Size: 3489 bytes --]
Hi all,
Damien Cassou <damien@cassou.me> writes:
> I don't feel confident enough in this area to give any feedback (and I
> don't want to spend too much time getting confident enough). Maybe Ted,
> the author of auth-source, could be of a better help?
Totally fair! And I see you've already Cc'd Ted. Thanks!
. . .
Michael Albinus <michael.albinus@gmx.de> writes:
> I have added also another backend to auth-source.el (secrets.el). I'm
> not too familiar with the API, but I might be able to answer some basic
> questions. Hopefully.
>
> Of course, I cannot beat Ted.
That's very generous. Thank you. In fact, I've been playing around a bit
with the secrets back end and am pleased to report that it satisfies all
of ERCs expectations, making it the latest addition to the roster
alongside netrc, json, and plstore (integration tests for all attached).
While it may be tempting to single out pass, this part from the doc
string for `auth-source-search' says that ignoring :max and returning at
most one result is totally acceptable:
:max N means to try to return at most N items (defaults to 1).
More than N items may be returned, depending on the search and
the backend.
Now, I suppose it's safe to assume those back ends in auth-source.el
already supporting :max will continue to do so forever and that the
proposed kludges for pass [1] are likewise safe (as long as we only ever
apply them to 27 and 28).
What I'd like to know is actually something Damien had had the foresight
to raise initially but that I was too dim to grasp fully in the moment:
> if auth-source-pass doesn't implement auth-source protocol, shouldn't
> we try to improve it instead of working around it in all users of the
> library? Am I missing something?
In truth, without such an addition (adding :max to auth-source-pass),
I'm not sure it makes sense for ERC to shoot for pass support at all. So
ERC aside, would such a change be worthwhile from the perspective of
auth-source, seeing as pass is technically already fully compliant?
Thanks everyone,
J.P.
P.S. A couple minor questions crept up while I was typing this (tacked
on below [2]), but feel free to ignore.
[1] The proposed workarounds currently depend on these internal
functions:
- auth-source-pass--get-attr
- auth-source-pass--disambiguate
- auth-source-pass--find-match-unambiguous
- auth-source-backend-parse-parameters
They also include functionality recently provided by this commit:
commit b09ee1406205e8b6298411b9a18c1cd26e201689
Date: Sun Jun 27 17:36:00 2021 +0200
lisp/auth-source-pass.el: Support multiple hosts in search spec
* lisp/auth-source-pass.el (auth-source-pass-search): Accept a
list of strings for argument HOST.
[2] A couple (non-pass specific) questions:
- Is there anything obvious to watch out for in our integration
tests to avoid contaminating existing ones for auth-source or
secrets?
Right now, the only thing we attend to specifically is let-binding
`auth-source-do-cache' around every test.
- Are there any security-related gotchas to heed when retrieving a
bunch of secrets in bulk and sifting through them?
Currently, results are narrowed to the best candidate, and its
secret is returned as a string for (relatively) immediate
transmission. IOW, I don't think any obvious references to the
discarded ones remain, if that matters.
[-- Attachment #2: 0024-Standardize-auth-source-queries-in-ERC.patch --]
[-- Type: text/x-patch, Size: 63167 bytes --]
From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 16 Aug 2021 04:38:18 -0700
Subject: [PATCH 24/34] Standardize auth-source queries in ERC
* lisp/erc/erc.el (erc-password): deprecate variable only used by
`erc-select-read-args'. Server passwords are primarily used as
surrogates for other forms of authentication. Such use is common but
nonstandard and often discouraged in favor of the de facto standard,
SASL. Fans of invoking `erc(-tls)' interactively should be coerced
into using auth-source instead.
(erc-select-read-args): Before this change, `erc-select-read-args'
offered to use the value of a non-nil `erc-password' as the :password
argument for `erc' and `erc-tls', referring to it as the "default"
password. And when `erc-prompt-for-password' was nil and
`erc-password' wasn't, the latter was passed along unconditionally.
This only further complicated an already confusing situation for new
users, who in most cases shouldn't be worried about sending a PASS
command at all. Until SASL arrives, they should provide server
passwords manually or learn to use auth-source.
(erc-auth-source-parameters-function): New user option to provide a
function for determining the default params to use when calling
`auth-source-search'.
(erc-auth-source-determine-params): New helper for
`erc--auth-source-search' with potential for wider role as default
value of custom function. Favors :host and :port fields above others.
Prioritizes network IDs over announced servers and dialed endpoints.
(erc--auth-source-search): New function for consulting auth-source and
sorting result as per default params provided by above functions.
(erc-server-join-channel): Use helper for consulting auth-source
facility. Also accept nil for first argument (instead of server). In
this case, allow default params option above to determine best course
of action.
(erc-cmd-JOIN): use above-mentioned facilities when joining new
channel. Omit server when calling `erc-server-join-channel'. Don't
filter target buffers twice. Don't call `switch-to-buffer', which
would create phantom buffers with names like target/server that were
never used. IOW, only switch to existing target buffers.
(erc-open, erc-determine-parameters, erc-compute-password): Move
password figuring from former to latter, and from there to
`erc-compute-password', which is a new function that figures out how
to call `auth-source-search' based on the value of the new option
`erc-connect-auth-source-host'.
(erc-connect-auth-source-host): Add new option for customizing the
:host param passed to `auth-source-search' while looking up the
initial PASS arg. The default setting preserves existing behavior of
matching against the dialed host name or IP address stored in
`erc-session-server'. Other options allow skipping auth-source lookup
altogether or favoring network ID, when non-nil.
* lisp/erc/erc-services.el (erc-nickserv-get-password): pass network
ID, i.e., effective session ID, when looking up password in
`erc-nickserv-passwords' and when formatting prompt for user input.
(erc-nickserv-passwords): add comment to custom option definition type
tag.
* test/lisp/erc/erc-services-tests.el: add new test file for above
changes. For now, stash auth-source-related tests here until a
suitable home can be found.
* lisp/erc/erc-join.el (erc-autojoin--join): Don't pass session-like
entity from `erc-autojoin-alist' match to `erc-server-join-channel'.
Allow that function to decide for itself which host to look up if
necessary.
* lisp/erc/erc-compat.el (erc-compat--auth-source-pass--couch,
erc-compat--auth-source-pass--find-match,
erc-compat--auth-source-pass--build-result,
erc-compat--auth-source-pass-search,
erc-compat--auth-source-pass-backend-parse): Add some adapters to make
auth-source-pass behave more like netrc in ways ERC relies on.
---
lisp/erc/erc-compat.el | 86 +++
lisp/erc/erc-join.el | 2 +-
lisp/erc/erc-services.el | 40 +-
lisp/erc/erc.el | 217 +++++--
test/lisp/erc/erc-services-tests.el | 845 ++++++++++++++++++++++++++++
5 files changed, 1118 insertions(+), 72 deletions(-)
create mode 100644 test/lisp/erc/erc-services-tests.el
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 16cfb15a5a..4edbd37f94 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -150,6 +150,92 @@ erc-subseq
(setq i (1+ i) start (1+ start)))
res))))))
+;;;; Auth Source
+
+;; We want a unified interface to auth-source, but that depends on
+;; upstream providing a consistent experience. As of at least
+;;
+;; lisp/auth-source-pass.el: Support multiple hosts in search
+;; b09ee1406205e8b6298411b9a18c1cd26e201689 Fri Jul 2 2021
+;;
+;; auth-source-pass only returns singletons on success. But we want
+;; all possible matches. This provides some hacks to do that, but it
+;; depends on internal functions. We also need to pass lists of
+;; candidates for host, user, and port selectors, which aren't yet
+;; fully supported.
+;;
+
+(require 'auth-source)
+
+(declare-function auth-source-pass--get-attr
+ "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+ "auth-source-pass" (host &optional user port))
+(declare-function auth-source-pass--find-match-unambiguous
+ "auth-source-pass" (hostname user port))
+(declare-function auth-source-backend-parse-parameters
+ "auth-source-pass" (entry backend))
+
+(defun erc-compat--auth-source-pass--couch (s)
+ (lambda () (auth-source-pass--get-attr 'secret s)))
+
+(defun erc-compat--auth-source-pass--find-match (hosts ports users)
+ "Return a plist of HOSTS, PORTS, USERS, and secret.
+This is not a drop-in for `auth-source-pass--find-match', which
+returns an alist."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ ;; Try combinations of Hosts x Users x Ports, filter out nonexistent
+ (cl-loop for host in hosts
+ for (h u p) = (auth-source-pass--disambiguate host)
+ append
+ (cl-loop for user in (or users (list u))
+ append
+ (cl-loop for port in (or ports (list p))
+ for s = (auth-source-pass--find-match-unambiguous
+ h user port)
+ when s collect
+ ;; Keep original host
+ `(:host
+ ,host
+ ,@(and user (list :user user))
+ ,@(and port (list :port port))
+ :secret
+ ,(erc-compat--auth-source-pass--couch s))))))
+
+(defun erc-compat--auth-source-pass--build-result (hosts ports users
+ &optional max)
+ "Act like a multi-valued `auth-source-pass--build-result'."
+ (unless max (setq max 1))
+ (let ((entries (erc-compat--auth-source-pass--find-match hosts ports users))
+ (count -1)
+ entry
+ out)
+ (while (and (setq entry (pop entries)) (< (cl-incf count) max))
+ (push entry out))
+ out))
+
+(cl-defun erc-compat--auth-source-pass-search
+ (&rest spec &key backend type host user port max &allow-other-keys)
+ (cl-assert (or (null type) (eq type (oref backend type)))
+ t "Invalid password-store search: %s %s")
+ (cl-assert (and host (not (eq host t)))
+ t "Invalid password-store search: %s %s")
+ (erc-compat--auth-source-pass--build-result host port user max))
+
+;; Temporary until we decide whether to load compat by default
+
+;;;###autoload
+(defun erc-compat--auth-source-pass-backend-parse (entry)
+ (when (eq entry 'password-store)
+ (auth-source-backend-parse-parameters
+ entry (auth-source-backend
+ :source "."
+ :type 'password-store
+ :search-function #'erc-compat--auth-source-pass-search))))
+
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index fcfb961bff..b812dfc512 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -141,7 +141,7 @@ erc-autojoin--join
(let ((buf (erc-get-buffer chan erc-server-process)))
(unless (and buf (with-current-buffer buf
(erc--current-buffer-joined-p)))
- (erc-server-join-channel match chan)))))))
+ (erc-server-join-channel nil chan)))))))
(defun erc-autojoin-after-ident (_network _nick)
"Autojoin channels in `erc-autojoin-channels-alist'.
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index cc5d5701e4..f042a52250 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -202,7 +202,7 @@ erc-nickserv-passwords
(const QuakeNet)
(const Rizon)
(const SlashNET)
- (symbol :tag "Network name"))
+ (symbol :tag "Network name or session ID"))
(repeat :tag "Nickname and password"
(cons :tag "Identity"
(string :tag "Nick")
@@ -431,31 +431,19 @@ erc-nickserv-get-password
lookups stops and this function returns it (or returns nil if it
is empty). Otherwise, no corresponding password was found, and
it returns nil."
- (let (network server port)
- ;; Fill in local vars, switching to the server buffer once only
- (erc-with-server-buffer
- (setq network erc-network
- server erc-session-server
- port erc-session-port))
- (let ((ret
- (or
- (when erc-nickserv-passwords
- (cdr (assoc nick
- (cl-second (assoc network
- erc-nickserv-passwords)))))
- (when erc-use-auth-source-for-nickserv-password
- (auth-source-pick-first-password
- :require '(:secret)
- :host server
- ;; Ensure a string for :port
- :port (format "%s" port)
- :user nick))
- (when erc-prompt-for-nickserv-password
- (read-passwd
- (format "NickServ password for %s on %s (RET to cancel): "
- nick network))))))
- (when (and ret (not (string= ret "")))
- ret))))
+ (when-let*
+ ((esid (erc-networks--id-symbol erc-networks--id))
+ (ret (or (when erc-nickserv-passwords
+ (assoc-default nick
+ (cadr (assq esid erc-nickserv-passwords))))
+ (when erc-use-auth-source-for-nickserv-password
+ (erc--auth-source-search :user nick))
+ (when erc-prompt-for-nickserv-password
+ (read-passwd
+ (format "NickServ password for %s on %s (RET to cancel): "
+ nick esid)))))
+ ((not (string-empty-p ret))))
+ ret))
(defvar erc-auto-discard-away)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 230cfe456f..acb6b40814 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -227,9 +227,14 @@ erc-rename-buffers
"old behavior when t now permanent" "29.1")
(defvar erc-password nil
- "Password to use when authenticating to an IRC server.
-It is not strictly necessary to provide this, since ERC will
-prompt you for it.")
+ "Password to use when authenticating to an IRC server interactively.
+
+This variable only exists for legacy reasons. It's not customizable and
+is limited to a single server password. Users looking for similar
+functionality should consider auth-source instead. See info
+node `(auth) Top' and info node `(erc) Connecting'.")
+
+(make-obsolete-variable 'erc-password "use auth-source instead" "29.1")
(defcustom erc-user-mode "+i"
;; +i "Invisible". Hides user from global /who and /names.
@@ -240,10 +245,32 @@ erc-user-mode
(defcustom erc-prompt-for-password t
- "Asks before using the default password, or whether to enter a new one."
+ "Ask for a server password when invoking `erc-tls' interactively."
:group 'erc
:type 'boolean)
+(defcustom erc-connect-auth-source-host 'server
+ "Host \"type\" for querying auth-source when first connecting.
+This is for determining the \"server password\" argument of the IRC
+\"PASS\" command sent to the server. The entry points `erc' and
+`erc-tls' query auth-source for such a password when a :password
+argument isn't provided. Because ERC also interfaces with auth-source
+for other secrets, such as NickServ passwords and channel keys,
+additional ways of selecting entries are sometimes necessary. See info
+node `(auth) Top'.
+
+Note that there aren't any options for specifying a network, like
+Libera.Chat, or a network-specific server, such as foo.libera.chat,
+because such information isn't available until after initial
+introductions have completed (\"registration\" in IRC speak)."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :group 'erc
+ :type '(choice (const :tag "Don't query auth-source" nil)
+ (const :tag "Dialed host name or IP address" server)
+ (const :tag "Prompt for a machine/host value" prompt)
+ (const :tag "Session ID, if set, otherwise server" t)
+ (string :tag "Literal value to use for :host")))
+
(defcustom erc-warn-about-blank-lines t
"Warn the user if they attempt to send a blank line."
:group 'erc
@@ -2160,15 +2187,6 @@ erc-open
(setq erc-logged-in nil)
;; The local copy of `erc-nick' - the list of nicks to choose
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
- ;; password stuff
- (setq erc-session-password
- (or passwd
- (auth-source-pick-first-password
- :host server
- :user nick
- ;; secrets.el wouldn’t accept a number
- :port (if (numberp port) (number-to-string port) port)
- :require '(:secret))))
;; client certificate (only useful if connecting over TLS)
(setq erc-session-client-certificate client-certificate)
(setq erc-networks--id (if connect
@@ -2190,7 +2208,7 @@ erc-open
(erc-display-prompt)
(goto-char (point-max)))
- (erc-determine-parameters server port nick full-name user)
+ (erc-determine-parameters server port nick full-name user passwd)
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
@@ -2288,11 +2306,9 @@ erc-select-read-args
(setq server user-input)
(setq passwd (if erc-prompt-for-password
- (if (and erc-password
- (y-or-n-p "Use the default password? "))
- erc-password
- (read-passwd "Password: "))
- erc-password))
+ (read-passwd "Server password: ")
+ (with-suppressed-warnings ((obsolete erc-password))
+ erc-password)))
(when (and passwd (string= "" passwd))
(setq passwd nil))
@@ -3305,18 +3321,120 @@ erc-cmd-HELP
(defalias 'erc-cmd-H #'erc-cmd-HELP)
(put 'erc-cmd-HELP 'process-not-needed t)
+(defcustom erc-auth-source-parameters-function
+ #'erc-auth-source-determine-params
+ "A filter providing query params for `auth-source-search'.
+ERC calls this function with keyword arguments recognized by
+`auth-source-search', namely, those deemed most relevant to the current
+context. For example, with NickServ queries, :user will be the
+\"desired\" nickname rather than the current one. Generalized names,
+like :user and :host, are always used over back-end specific ones, like
+:login or :machine. ERC expects a refined plist in return.
+
+The ordering of the returned pairs influences how results are filtered
+as does the ordering of the members of any composite pair values, when
+applicable. If necessary, the former takes priority over the latter.
+For example, if the function returns
+
+ (:host (foo bar) :port (123 456))
+
+the secret from an auth-source entry of host foo and port 456
+will be chosen over another of host bar and port 123. However,
+if the function returns
+
+ (:port (123 456) :host (foo bar))
+
+the opposite will be true. In both cases, two entries with the same
+host but different ports would see the one with port 123 being selected.
+Much the same would happen for entries sharing only a port: the one with
+host foo would win.
+
+Some auth-source back ends may not be compatible; netrc, plstore, json,
+secrets, and pass are currently supported."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :group 'erc
+ :type 'function)
+
+(defun erc-auth-source-determine-params (&rest plist)
+ "Return a plist of keyword args to pass to `auth-source-search'.
+Treat \"recommendations\" in PLIST as authoritative, and accept them
+unconditionally instead of merging them with items derived from the
+current connection context. For keys not present in PLIST, favor a
+network ID over an announced server unless `erc--target' is a local
+channel. And treat the dialed server address as a fallback for the
+announced name in both cases."
+ (let* ((net (and-let* ((esid (erc-networks--id-symbol erc-networks--id))
+ ((symbol-name esid)))))
+ (localp (and erc--target (erc--target-channel-local-p erc--target)))
+ (hosts (if localp
+ (list erc-server-announced-name erc-session-server net)
+ (list net erc-server-announced-name erc-session-server)))
+ (ports (list (cl-typecase erc-session-port
+ (integer (number-to-string erc-session-port))
+ (string (and (string= erc-session-port "irc")
+ erc-session-port)) ; or nil
+ (t erc-session-port))
+ "irc"))
+ (defaults (list :host (delq nil hosts)
+ :port (delq nil ports)
+ :require '(:secret))))
+ (cl-loop for (key value) on defaults by #'cddr
+ when value unless (plist-get plist key)
+ do (setq plist (plist-put plist key value))))
+ plist)
+
+;; If `erc-auth-source-parameters-function' is too inflexible to
+;; support the needed contexts, we could instead filter the args
+;; passed to `erc--auth-source-search'. Obviously, that would entail
+;; dropping the call from the latter's body. We'd then add additional
+;; options, such as an `erc-auth-source-parameters-join-function' or
+;; an `erc-auth-source-parameters-services-function', to supplement
+;; the default one.
+
+(declare-function erc-compat--auth-source-pass-backend-parse
+ "erc-compat" (entry))
+
+(defun erc--auth-source-search (&rest plist)
+ "Ask auth-source for a secret and return it if found.
+Feed PLIST to `erc-auth-source-parameters-function' and use whatever's
+returned as arguments for querying auth-source. Return a string if
+found or nil otherwise."
+ (let* ((auth-source-backend-parser-functions
+ (if (memq 'password-store auth-sources)
+ (cons #'erc-compat--auth-source-pass-backend-parse
+ auth-source-backend-parser-functions)
+ auth-source-backend-parser-functions))
+ (defaults (apply erc-auth-source-parameters-function plist))
+ (priority (map-keys defaults))
+ (test (lambda (a b)
+ (catch 'done
+ (dolist (key priority)
+ (let* ((d (plist-get defaults key))
+ (defval (if (listp d) d (list d)))
+ ;; featurep 'seq via auth-source > json > map
+ (p (seq-position defval (plist-get a key)))
+ (q (seq-position defval (plist-get b key))))
+ (unless (eql p q)
+ (throw 'done (when p (or (not q) (< p q)))))))))))
+ (unless (plist-get (setq plist defaults) :max)
+ (setq plist (plist-put plist :max 5000))) ; `auth-source-netrc-parse'
+ (unless (plist-get defaults :require)
+ (setq plist (plist-put plist :require '(:secret))))
+ (when-let* ((sorted (sort (apply #'auth-source-search plist) test))
+ (secret (plist-get (car sorted) :secret)))
+ (if (functionp secret) (funcall secret) secret))))
+
(defun erc-server-join-channel (server channel &optional secret)
- (let ((password
- (or secret
- (auth-source-pick-first-password
- :host server
- :port "irc"
- :user channel))))
- (erc-log (format "cmd: JOIN: %s" channel))
- (erc-server-send (concat "JOIN " channel
- (if password
- (concat " " password)
- "")))))
+ "Join CHANNEL, optionally with SECRET.
+Without SECRET, consult auth source, using SERVER if non-nil."
+ (unless secret
+ (unless server
+ (when (and erc-server-announced-name (erc-valid-local-channel-p channel))
+ (setq server erc-server-announced-name)))
+ (let ((args `(,@(when server (list :host server)) :user channel)))
+ (setq secret (apply #'erc--auth-source-search args))))
+ (erc-log (format "cmd: JOIN: %s" channel))
+ (erc-server-send (concat "JOIN " channel (when secret (concat " " secret)))))
(defun erc-valid-local-channel-p (channel)
"Non-nil when channel is server-local on a network that allows them."
@@ -3338,19 +3456,12 @@ erc-cmd-JOIN
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (let* ((joined-channels
- (mapcar (lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
- (erc-channel-list erc-server-process)))
- (server (with-current-buffer (process-buffer erc-server-process)
- (or erc-session-server erc-server-announced-name)))
- (chnl-name (car (erc-member-ignore-case chnl joined-channels))))
- (if chnl-name
- (switch-to-buffer (if (get-buffer chnl-name)
- chnl-name
- (concat chnl-name "/" server)))
- (setq erc--server-last-reconnect-count 0)
- (erc-server-join-channel server chnl key)))))
+ (if-let* ((existing (erc-get-buffer chnl erc-server-process))
+ ((with-current-buffer existing
+ (erc-get-channel-user (erc-current-nick)))))
+ (switch-to-buffer existing)
+ (setq erc--server-last-reconnect-count 0)
+ (erc-server-join-channel nil chnl key))))
t)
(defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN)
@@ -6305,7 +6416,7 @@ erc-login
;; connection properties' heuristics
-(defun erc-determine-parameters (&optional server port nick name user)
+(defun erc-determine-parameters (&optional server port nick name user passwd)
"Determine the connection and authentication parameters.
Sets the buffer local variables:
@@ -6314,12 +6425,14 @@ erc-determine-parameters
- `erc-session-port'
- `erc-session-user-full-name'
- `erc-session-username'
+- `erc-session-password'
- `erc-server-current-nick'"
(setq erc-session-connector erc-server-connect-function
erc-session-server (erc-compute-server server)
erc-session-port (or port erc-default-port)
erc-session-user-full-name (erc-compute-full-name name)
- erc-session-username (erc-compute-user user))
+ erc-session-username (erc-compute-user user)
+ erc-session-password (erc-compute-server-password passwd nick))
(erc-set-current-nick (erc-compute-nick nick)))
(defun erc-compute-server (&optional server)
@@ -6356,6 +6469,20 @@ erc-compute-nick
(getenv "IRCNICK")
(user-login-name)))
+(defun erc-compute-server-password (password nick)
+ "Maybe provide a PASSWORD argument for the IRC \"PASS\" command.
+When `erc-connect-auth-source-host' is non-nil, use it to determine the
+machine/host param for querying auth-source, and use NICK for the
+user/login field."
+ (or password
+ (when erc-connect-auth-source-host
+ (let* ((host (pcase erc-connect-auth-source-host
+ ('server erc-session-server)
+ ((and (pred stringp) v) v)
+ ('prompt (read-string "Auth-source host: "
+ nil t (list nil)))))
+ (args `(,@(and host (list :host host)) :user ,nick)))
+ (apply #'erc--auth-source-search args)))))
(defun erc-compute-full-name (&optional full-name)
"Return user's full name.
diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el
new file mode 100644
index 0000000000..3e6cbe1197
--- /dev/null
+++ b/test/lisp/erc/erc-services-tests.el
@@ -0,0 +1,845 @@
+;;; erc-services-tests.el --- Tests for erc-services. -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2021 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
+
+;; Some of the following may be related to bug#23438.
+
+(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"))
+
+(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--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))
+
+ (ert-info ("Normal ordering")
+
+ (ert-info ("Session 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= (erc--auth-source-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= (erc--auth-source-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-network
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (erc--auth-source-search :user "#chan")
+ "baz"))))))))
+
+(ert-deftest erc--auth-source-search--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--isupport-params (make-hash-table))
+ (erc-server-parameters '(("CHANTYPES" . "&#")))
+ (erc--target (erc--target-from-string "&chan")))
+
+ (ert-info ("Announced prioritized")
+
+ (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= (erc--auth-source-search :user "#chan")
+ "baz"))))
+
+ (ert-info ("Peer 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= (erc--auth-source-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= (erc--auth-source-search :user "#chan")
+ "foo"))))))))
+
+(ert-deftest erc--auth-source-search--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-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= (erc--auth-source-search :user "#chan")
+ "spam"))))
+
+ (ert-info ("More specific user (network loses)")
+ (should (string= (erc--auth-source-search :user '("#fsf"))
+ "42")))
+
+ (ert-info ("Actual override")
+ (should (string= (erc--auth-source-search :port "6667")
+ "sesame")))
+
+ (ert-info ("Overrides don't interfere with post-processing")
+ (should (string= (erc--auth-source-search :host "MyHost")
+ "123")))))))
+
+;; 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-entries
+ '(("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")))
+
+(defvar erc-services-tests--auth-source-plstore-standard-secrets
+ '(("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 (concat ";;; public entries -*- mode: plstore -*- \n"
+ (prin1-to-string
+ erc-services-tests--auth-source-plstore-standard-entries)
+ "\n;;; secret entries\n"
+ (prin1-to-string
+ erc-services-tests--auth-source-plstore-standard-secrets)
+ "\n")
+ (let ((auth-sources (list plstore-file))
+ (auth-source-do-cache nil))
+
+ (ert-info ("Normal ordering")
+
+ (ert-info ("Session 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= (erc-services-test--call-with-plstore
+ :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= (erc-services-test--call-with-plstore
+ :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-network
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (erc-services-test--call-with-plstore
+ :user "#chan")
+ "baz"))))))))
+
+(ert-deftest erc--auth-source-search--plstore-announced ()
+ (ert-with-temp-file plstore-file
+ :suffix ".plist"
+ :text (concat ";;; public entries -*- mode: plstore -*- \n"
+ (prin1-to-string
+ erc-services-tests--auth-source-plstore-standard-entries)
+ "\n;;; secret entries\n"
+ (prin1-to-string
+ erc-services-tests--auth-source-plstore-standard-secrets)
+ "\n")
+ (let* ((auth-sources (list plstore-file))
+ (auth-source-do-cache nil)
+ (erc--isupport-params (make-hash-table))
+ (erc-server-parameters '(("CHANTYPES" . "&#")))
+ (erc--target (erc--target-from-string "&chan")))
+
+ (ert-info ("Announced prioritized")
+
+ (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= (erc-services-test--call-with-plstore
+ :user "#chan")
+ "baz"))))
+
+ (ert-info ("Peer 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= (erc-services-test--call-with-plstore
+ :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= (erc-services-test--call-with-plstore
+ :user "#chan")
+ "foo"))))))))
+
+(ert-deftest erc--auth-source-search--plstore-overrides ()
+ (ert-with-temp-file plstore-file
+ :suffix ".plist"
+ :text (concat
+ ";;; public entries -*- mode: plstore -*- \n"
+ (prin1-to-string
+ `(,@erc-services-tests--auth-source-plstore-standard-entries
+ ("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")))
+ "\n;;; secret entries\n"
+ (prin1-to-string
+ `(,@erc-services-tests--auth-source-plstore-standard-secrets
+ ("1b3fab249a8dff77a4d8fe7eb4b0171b25cc711a" :secret "spam")
+ ("6cbcdc39476b8cfcca6f3e9a7876f41ec3f708cc" :secret "42")
+ ("a33e2b3bd2d6f33995a4b88710a594a100c5e41d" :secret "sesame")
+ ("ab2fd349b2b7d6a9215bb35a92d054261b0b1537" :secret "456")
+ ("61a6bd552059494f479ff720e8de33e22574650a" :secret "123")))
+ "\n")
+ (let* ((auth-sources (list plstore-file))
+ (auth-source-do-cache nil)
+ (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 ("More specific port")
+ (let ((erc-session-port 6697))
+ (should (string= (erc-services-test--call-with-plstore :user "#chan")
+ "spam"))))
+
+ (ert-info ("Network wins")
+ (should (string= (erc-services-test--call-with-plstore :user '("#fsf"))
+ "42")))
+
+ (ert-info ("Actual override")
+ (should (string= (erc-services-test--call-with-plstore :port "6667")
+ "sesame")))
+
+ (ert-info ("Overrides don't interfere with post-processing")
+ (should (string= (erc-services-test--call-with-plstore :host "MyHost")
+ "123"))))))
+
+;; auth-source JSON backend
+
+(defvar erc-services-tests--auth-source-json-standard-entries
+ [(: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
+ :suffix ".json"
+ :text (let ((json-object-type 'plist))
+ (json-encode
+ erc-services-tests--auth-source-json-standard-entries))
+ (let ((auth-sources (list json-store))
+ (auth-source-do-cache nil))
+
+ (ert-info ("Normal ordering")
+
+ (ert-info ("Session 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= (erc--auth-source-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= (erc--auth-source-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-network
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (erc--auth-source-search :user "#chan")
+ "baz"))))))))
+
+(ert-deftest erc--auth-source-search--json-announced ()
+ (ert-with-temp-file plstore-file
+ :suffix ".json"
+ :text (let ((json-object-type 'plist))
+ (json-encode
+ erc-services-tests--auth-source-json-standard-entries))
+ (let* ((auth-sources (list plstore-file))
+ (auth-source-do-cache nil)
+ (erc--isupport-params (make-hash-table))
+ (erc-server-parameters '(("CHANTYPES" . "&#")))
+ (erc--target (erc--target-from-string "&chan")))
+
+ (ert-info ("Announced prioritized")
+
+ (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= (erc--auth-source-search :user "#chan")
+ "baz"))))
+
+ (ert-info ("Peer 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= (erc--auth-source-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= (erc--auth-source-search :user "#chan")
+ "foo"))))))))
+
+(ert-deftest erc--auth-source-search--json-overrides ()
+ (ert-with-temp-file json-file
+ :suffix ".json"
+ :text (let ((json-object-type 'plist))
+ (json-encode
+ (vconcat
+ erc-services-tests--auth-source-json-standard-entries
+ [(:secret "spam" :host "GNU.chat" :user "#chan" :port "6697")
+ (:secret "42" :host "my.gnu.org" :user "#fsf" :port "irc")
+ (:secret "sesame" :host "irc.gnu.org" :port "6667")
+ (:secret "456" :host "MyHost" :port "irc")
+ (:secret "123" :host "MyHost" :port "6667")])))
+
+ (let* ((auth-sources (list json-file))
+ (auth-source-do-cache nil)
+ (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 ("More specific port")
+ (let ((erc-session-port 6697))
+ (should (string= (erc--auth-source-search :user "#chan") "spam"))))
+
+ (ert-info ("Network wins")
+ (should (string= (erc--auth-source-search :user '("#fsf")) "42")))
+
+ (ert-info ("Actual override")
+ (should (string= (erc--auth-source-search :port "6667") "sesame")))
+
+ (ert-info ("Overrides don't interfere with post-processing")
+ (should (string= (erc--auth-source-search :host "MyHost") "123"))))))
+
+;; 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")))
+
+(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)
+ (lambda (col &rest r)
+ (should (equal col "Test"))
+ (should (plist-get r :user))
+ (map-keys entries)))
+ ((symbol-function 'secrets-get-secret)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label secrets)))
+ ((symbol-function 'secrets-get-attributes)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label entries))))
+ (ert-info ("Normal ordering")
+
+ (ert-info ("Session 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= (erc--auth-source-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= (erc--auth-source-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-network
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (erc--auth-source-search :user "#chan")
+ "baz"))))))))
+
+(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)
+ (erc--isupport-params (make-hash-table))
+ (erc-server-parameters '(("CHANTYPES" . "&#")))
+ (erc--target (erc--target-from-string "&chan")))
+
+ (cl-letf (((symbol-function 'secrets-search-items)
+ (lambda (col &rest r)
+ (should (equal col "Test"))
+ (should (plist-get r :user))
+ (map-keys entries)))
+ ((symbol-function 'secrets-get-secret)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label secrets)))
+ ((symbol-function 'secrets-get-attributes)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label entries))))
+
+ (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= (erc--auth-source-search :user "#chan") "baz"))))
+
+ (ert-info ("Peer 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= (erc--auth-source-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= (erc--auth-source-search :user "#chan") "foo")))))))
+
+(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")))
+ (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))
+
+ (cl-letf (((symbol-function 'secrets-search-items)
+ (lambda (col &rest _)
+ (should (equal col "Test"))
+ (map-keys entries)))
+ ((symbol-function 'secrets-get-secret)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label secrets)))
+ ((symbol-function 'secrets-get-attributes)
+ (lambda (col label)
+ (should (equal col "Test"))
+ (assoc-default label entries))))
+
+ (ert-info ("More specific port")
+ (let ((erc-session-port 6697))
+ (should (string= (erc--auth-source-search :user "#chan") "spam"))))
+
+ (ert-info ("Network wins")
+ (should (string= (erc--auth-source-search :user '("#fsf")) "42")))
+
+ (ert-info ("Actual override")
+ (should (string= (erc--auth-source-search :port "6667") "sesame")))
+
+ (ert-info ("Overrides don't interfere with post-processing")
+ (should (string= (erc--auth-source-search :host "MyHost") "123"))))))
+
+;; 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"
+ ("port" . "irc") ("user" . "#chan") (secret . "bar"))
+ ("my.gnu.org:irc/#chan"
+ ("port" . "irc") ("user" . "#chan") (secret . "baz"))
+ ("GNU.chat:irc/#chan"
+ ("port" . "irc") ("user" . "#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))))
+
+ (ert-info ("Normal ordering")
+
+ (ert-info ("Session 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= (erc--auth-source-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= (erc--auth-source-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-network
+ (erc-networks--id (erc-networks--id-create nil)))
+ (should (string= (erc--auth-source-search :user "#chan")
+ "baz"))))))))
+
+(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))))
+
+ (let* ((erc--isupport-params (make-hash-table))
+ (erc-server-parameters '(("CHANTYPES" . "&#")))
+ (erc--target (erc--target-from-string "&chan")))
+
+ (ert-info ("Announced prioritized")
+
+ (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= (erc--auth-source-search :user "#chan")
+ "baz"))))
+
+ (ert-info ("Peer 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= (erc--auth-source-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= (erc--auth-source-search :user "#chan")
+ "foo")))))))))
+
+(ert-deftest erc--auth-source-search--pass-overrides ()
+ (let* ((store
+ `(,@erc-join-tests--auth-source-pass-entries
+ ("GNU.chat:6697/#chan"
+ ("port" . "6697") ("user" . "#chan") (secret . "spam"))
+ ("my.gnu.org:irc/#fsf"
+ ("port" . "irc") ("user" . "#fsf") (secret . "42"))
+ ("irc.gnu.org:6667"
+ ("port" . "6667") (secret . "sesame"))
+ ("MyHost:irc"
+ ("port" . "irc") (secret . "456"))
+ ("MyHost:6667"
+ ("port" . "6667") (secret . "123"))))
+ (auth-sources '(password-store))
+ (auth-source-do-cache nil)
+ (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))
+
+ (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))))
+
+ (ert-info ("More specific port")
+ (let ((erc-session-port 6697))
+ (should (string= (erc--auth-source-search :user "#chan") "spam"))))
+
+ (ert-info ("Network wins")
+ (should (string= (erc--auth-source-search :user '("#fsf")) "42")))
+
+ (ert-info ("Actual override")
+ (should (string= (erc--auth-source-search :port "6667") "sesame")))
+
+ (ert-info ("Overrides don't interfere with post-processing")
+ (should (string= (erc--auth-source-search :host "MyHost")
+ "123"))))))
+
+;;;; 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))
+
+ (ert-info ("Lookup custom option")
+ (should (string= (erc-nickserv-get-password "alice") "foo")))
+
+ (ert-info ("Auth source")
+ (ert-info ("Network")
+ (should (string= (erc-nickserv-get-password "bob") "sesame")))
+
+ (ert-info ("Network ID")
+ (let ((erc-networks--id (erc-networks--id-create 'GNU/chat)))
+ (should (string= (erc-nickserv-get-password "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
--
2.35.1
next prev parent reply other threads:[~2022-04-20 14:12 UTC|newest]
Thread overview: 51+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-05-23 1:22 28.0.50; buffer-naming collisions involving bouncers in ERC J.P.
2021-06-02 11:19 ` bug#48598: " J.P.
2021-06-09 14:36 ` Olivier Certner
2021-06-10 14:36 ` bug#48598: " J.P.
2021-06-19 3:04 ` J.P.
2021-06-25 13:18 ` J.P.
[not found] ` <87r1gqaxqf.fsf@neverwas.me>
2021-06-28 7:58 ` Olivier Certner
2021-10-16 21:15 ` Daniel Fleischer
2021-10-16 23:21 ` J.P.
[not found] ` <87o87ofte1.fsf@neverwas.me>
2021-11-11 5:24 ` Lars Ingebrigtsen
[not found] ` <8735o39sdg.fsf@gnus.org>
2021-11-11 10:27 ` J.P.
[not found] ` <87pmr77zsa.fsf@neverwas.me>
2021-11-11 12:08 ` Lars Ingebrigtsen
[not found] ` <87a6ia7v47.fsf@gnus.org>
2021-11-11 15:13 ` J.P.
2021-09-04 16:46 ` bug#48598: Strange ERC/ZNC Bug/Problem acdw
2021-09-07 21:38 ` J.P.
2021-09-10 12:43 ` bug#48598: Duplicate messages from bouncers on 27 and earlier J.P.
2021-11-11 15:15 ` bug#48598: 28.0.50; buffer-naming collisions involving bouncers in ERC J.P.
2022-03-14 13:08 ` J.P.
2022-04-09 21:14 ` bug#48598: Questions regarding layout and composition of tests (bug#48598) J.P.
2022-04-09 21:22 ` bug#48598: Questions regarding auth-source integration (bug#48598) J.P.
[not found] ` <87leweez89.fsf@neverwas.me>
2022-04-10 12:49 ` bug#48598: Questions regarding layout and composition of tests (bug#48598) Lars Ingebrigtsen
[not found] ` <87fsmlp0gy.fsf@gnus.org>
2022-04-11 7:59 ` bug#48598: 28.0.50; buffer-naming collisions involving bouncers in ERC Michael Albinus
[not found] ` <878rsc2gp5.fsf_-_@gmx.de>
2022-04-11 10:21 ` Lars Ingebrigtsen
[not found] ` <878rsbdipd.fsf@gnus.org>
2022-04-11 13:29 ` J.P.
2022-04-11 15:34 ` Lars Ingebrigtsen
2022-04-12 7:50 ` Michael Albinus
[not found] ` <87sfqi2119.fsf@gmx.de>
2022-04-15 13:02 ` J.P.
[not found] ` <87v8vah54l.fsf@neverwas.me>
2022-04-15 15:05 ` Michael Albinus
[not found] ` <87h76ucrq4.fsf@gmx.de>
2022-04-16 1:12 ` J.P.
[not found] ` <87h76tde5k.fsf@neverwas.me>
2022-04-17 8:25 ` Michael Albinus
[not found] ` <87czhgce1s.fsf@gmx.de>
2022-04-18 14:30 ` J.P.
[not found] ` <871qxucvls.fsf@neverwas.me>
2022-04-18 16:43 ` Michael Albinus
[not found] ` <87o80ybauv.fsf@gmx.de>
2022-04-21 13:28 ` J.P.
[not found] ` <87pmlao9ax.fsf@neverwas.me>
2022-04-22 8:54 ` Michael Albinus
[not found] ` <87bkxaeyuw.fsf@neverwas.me>
2022-04-18 13:26 ` bug#48598: Questions regarding auth-source integration (bug#48598) Damien Cassou
2022-04-18 14:24 ` J.P.
[not found] ` <87ee1ucvv3.fsf@neverwas.me>
2022-04-18 15:24 ` Damien Cassou
2022-04-18 16:52 ` Michael Albinus
[not found] ` <87k0bmbage.fsf@gmx.de>
2022-04-20 14:12 ` J.P. [this message]
[not found] ` <878rrz268v.fsf@neverwas.me>
2022-04-21 7:08 ` bug#48598: 28.0.50; buffer-naming collisions involving bouncers in ERC Michael Albinus
[not found] ` <87czha3oc5.fsf_-_@gmx.de>
2022-04-21 13:21 ` J.P.
[not found] ` <87v8v2o9l4.fsf@neverwas.me>
2022-04-22 9:29 ` Michael Albinus
[not found] ` <87k0bh31pt.fsf@gmx.de>
2022-04-22 14:24 ` J.P.
[not found] ` <8735i5nql8.fsf@neverwas.me>
2022-04-23 9:47 ` Michael Albinus
[not found] ` <87bkws2ksn.fsf@gmx.de>
2022-04-25 12:05 ` J.P.
[not found] ` <87czh5z7ui.fsf@neverwas.me>
2022-04-27 12:28 ` Michael Albinus
[not found] ` <874k2epv5n.fsf@gmx.de>
2022-04-28 8:08 ` Michael Albinus
[not found] ` <87levpmxz1.fsf@gmx.de>
2022-04-28 8:13 ` Michael Albinus
2022-04-29 13:03 ` J.P.
2022-05-25 19:29 ` J.P.
2022-05-26 5:17 ` J.P.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='878rrz268v.fsf__2835.73416979692$1650467033$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=48598@debbugs.gnu.org \
--cc=damien@cassou.me \
--cc=emacs-erc@gnu.org \
--cc=michael.albinus@gmx.de \
--cc=sds@gnu.org \
--cc=tzz@lifelogs.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).