From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#29108: 25.3; ERC SASL support Date: Wed, 26 Oct 2022 06:14:43 -0700 Message-ID: <87k04m4th8.fsf__35375.088585873$1666790607$gmane$org@neverwas.me> References: <87h8ud92zl.fsf@gmail.com> <874jx4h6sk.fsf@neverwas.me> <875yhifujk.fsf_-_@neverwas.me> <87edw4swdk.fsf@neverwas.me> <878rljxfxs.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="7516"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: emacs-erc@gnu.org, bandali@gnu.org To: 29108@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Oct 26 15:23:17 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ongNJ-0001eF-5z for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 26 Oct 2022 15:23:17 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ongFO-0006wV-0G; Wed, 26 Oct 2022 09:15:06 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ongFL-0006i1-8R for bug-gnu-emacs@gnu.org; Wed, 26 Oct 2022 09:15:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ongFK-0004It-SE for bug-gnu-emacs@gnu.org; Wed, 26 Oct 2022 09:15:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ongFK-0000PQ-LC for bug-gnu-emacs@gnu.org; Wed, 26 Oct 2022 09:15:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 26 Oct 2022 13:15:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 29108 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 29108-submit@debbugs.gnu.org id=B29108.16667900981543 (code B ref 29108); Wed, 26 Oct 2022 13:15:02 +0000 Original-Received: (at 29108) by debbugs.gnu.org; 26 Oct 2022 13:14:58 +0000 Original-Received: from localhost ([127.0.0.1]:53672 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ongFG-0000Op-Hn for submit@debbugs.gnu.org; Wed, 26 Oct 2022 09:14:58 -0400 Original-Received: from mail-108-mta26.mxroute.com ([136.175.108.26]:37097) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ongFD-0000OL-GD for 29108@debbugs.gnu.org; Wed, 26 Oct 2022 09:14:56 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta26.mxroute.com (ZoneMTA) with ESMTPSA id 184146e5d7c0006e99.001 for <29108@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Wed, 26 Oct 2022 13:14:48 +0000 X-Zone-Loop: 0003491db4110689ac263878e10b73a0315a9fc49de8 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=T38JxOTX/52/BiGnc5RBv7dLpBpH+NL6eUaTYWtxXBM=; b=ICzjKMj2QG5rPRB681Z/FmypaE 7b1ADuMEWpPVIbHcB7R4/J2vxswJ2rNe0aLfYiV1yvSpmEoQweBVD+vlIW16QikrX1zMxs2pUEwM9 uiYOjbVRfsIpGSsBHMqfbIgZeKFofU0rcvubhyZQDS6fj+Oj1WqwBc3nGtkekD/MPkwwAGfAdImRo hq5gulPSkSvtf7j4Z8FdpZG2Qb57eCRilv5HCh6qHTFP00vtNZBYKDyjkglNSzqQbRg/g5mje+mQX jb9gdgnPrVQpZNOMP2HLKNgA8RJGu0SPaEpZ8CXnPPEmoqCNMqDf8wrkxCEzIyyHDLf9riLpQjnm8 GHs0/AUA==; In-Reply-To: <878rljxfxs.fsf@neverwas.me> (J. P.'s message of "Thu, 13 Oct 2022 20:05:51 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: "bug-gnu-emacs" Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:246227 Archived-At: --=-=-= Content-Type: text/plain "J.P." writes: > Note: these patches may not be fully functional because the "actual" > (WIP version) is based atop bug#56340, whereas these have been > modified to produce a smaller diff. I now realize that was probably just confusing (sorry), so I've attached the full set with dependencies for clarity. I'd really like this thing to see some daylight, so if anyone can find the time to take a quick look, please do (Cc. bandali). I think most folks would agree that an ERC without SASL in Emacs 29 would be less than ideal. Thanks. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v4-v5.diff >From 27242c8becae2962972c2a6cfdf4de44d276184b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 26 Oct 2022 00:58:17 -0700 Subject: [PATCH 0/5] *** NOT A PATCH *** *** BLURB HERE *** Dick R. Chiang (1): Move ERC's core dependencies to separate file F. Jason Park (4): Add GS2 authorization to sasl-scram-rfc Support local ERC modules in erc-mode buffers Call erc-login indirectly via new generic wrapper Add non-IRCv3 SASL module to ERC doc/misc/erc.texi | 138 +++++- lisp/erc/erc-backend.el | 137 +++++- lisp/erc/erc-common.el | 283 +++++++++++ lisp/erc/erc-compat.el | 116 +++++ lisp/erc/erc-goodies.el | 18 +- lisp/erc/erc-networks.el | 28 +- lisp/erc/erc-sasl.el | 396 ++++++++++++++++ lisp/erc/erc.el | 447 ++++-------------- lisp/net/sasl-scram-rfc.el | 21 +- test/lisp/erc/erc-networks-tests.el | 2 +- test/lisp/erc/erc-sasl-tests.el | 302 ++++++++++++ test/lisp/erc/erc-scenarios-sasl.el | 161 +++++++ test/lisp/erc/erc-tests.el | 69 ++- test/lisp/erc/resources/sasl/external.eld | 33 ++ test/lisp/erc/resources/sasl/plain-failed.eld | 16 + test/lisp/erc/resources/sasl/plain.eld | 35 ++ test/lisp/erc/resources/sasl/scram-sha-1.eld | 47 ++ .../lisp/erc/resources/sasl/scram-sha-256.eld | 47 ++ 18 files changed, 1889 insertions(+), 407 deletions(-) create mode 100644 lisp/erc/erc-common.el create mode 100644 lisp/erc/erc-sasl.el create mode 100644 test/lisp/erc/erc-sasl-tests.el create mode 100644 test/lisp/erc/erc-scenarios-sasl.el create mode 100644 test/lisp/erc/resources/sasl/external.eld create mode 100644 test/lisp/erc/resources/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/sasl/plain.eld create mode 100644 test/lisp/erc/resources/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/sasl/scram-sha-256.eld Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 25c4481d1d..fee29e7d05 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -99,24 +99,117 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. -;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the -;; reverse is true: -(require 'erc) +(require 'erc-common) + +(defvar erc--target) +(defvar erc-auto-query) +(defvar erc-channel-list) +(defvar erc-channel-users) +(defvar erc-default-nicks) +(defvar erc-default-recipients) +(defvar erc-format-nick-function) +(defvar erc-format-query-as-channel-p) +(defvar erc-hide-prompt) +(defvar erc-input-marker) +(defvar erc-insert-marker) +(defvar erc-invitation) +(defvar erc-join-buffer) +(defvar erc-kill-buffer-on-part) +(defvar erc-kill-server-buffer-on-quit) +(defvar erc-log-p) +(defvar erc-minibuffer-ignored) +(defvar erc-networks--id) +(defvar erc-nick) +(defvar erc-nick-change-attempt-count) +(defvar erc-prompt-for-channel-key) +(defvar erc-prompt-hidden) +(defvar erc-reuse-buffers) +(defvar erc-verbose-server-ping) +(defvar erc-whowas-on-nosuchnick) + +(declare-function erc--open-target "erc" (target)) +(declare-function erc--target-from-string "erc" (string)) +(declare-function erc-active-buffer "erc" nil) +(declare-function erc-add-default-channel "erc" (channel)) +(declare-function erc-banlist-update "erc" (proc parsed)) +(declare-function erc-buffer-filter "erc" (predicate &optional proc)) +(declare-function erc-buffer-list-with-nick "erc" (nick proc)) +(declare-function erc-channel-begin-receiving-names "erc" nil) +(declare-function erc-channel-end-receiving-names "erc" nil) +(declare-function erc-channel-p "erc" (channel)) +(declare-function erc-channel-receive-names "erc" (names-string)) +(declare-function erc-cmd-JOIN "erc" (channel &optional key)) +(declare-function erc-connection-established "erc" (proc parsed)) +(declare-function erc-current-nick "erc" nil) +(declare-function erc-current-nick-p "erc" (nick)) +(declare-function erc-current-time "erc" (&optional specified-time)) +(declare-function erc-default-target "erc" nil) +(declare-function erc-delete-default-channel "erc" (channel &optional buffer)) +(declare-function erc-display-error-notice "erc" (parsed string)) +(declare-function erc-display-server-message "erc" (_proc parsed)) +(declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) +(declare-function erc-format-message "erc" (msg &rest args)) +(declare-function erc-format-privmessage "erc" (nick msg privp msgp)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-handle-login "erc" nil) +(declare-function erc-handle-user-status-change "erc" (type nlh &optional l)) +(declare-function erc-ignored-reply-p "erc" (msg tgt proc)) +(declare-function erc-ignored-user-p "erc" (spec)) +(declare-function erc-is-message-ctcp-and-not-action-p "erc" (message)) +(declare-function erc-is-message-ctcp-p "erc" (message)) +(declare-function erc-log-irc-protocol "erc" (string &optional outbound)) +(declare-function erc-login "erc" nil) +(declare-function erc-make-notice "erc" (message)) +(declare-function erc-network "erc-networks" nil) +(declare-function erc-networks--id-given "erc-networks" (arg &rest args)) +(declare-function erc-networks--id-reload "erc-networks" (arg &rest args)) +(declare-function erc-nickname-in-use "erc" (nick reason)) +(declare-function erc-parse-user "erc" (string)) +(declare-function erc-process-away "erc" (proc away-p)) +(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) +(declare-function erc-query-buffer-p "erc" (&optional buffer)) +(declare-function erc-remove-channel-member "erc" (channel nick)) +(declare-function erc-remove-channel-users "erc" nil) +(declare-function erc-remove-user "erc" (nick)) +(declare-function erc-sec-to-time "erc" (ns)) +(declare-function erc-server-buffer "erc" nil) +(declare-function erc-set-active-buffer "erc" (buffer)) +(declare-function erc-set-current-nick "erc" (nick)) +(declare-function erc-set-modes "erc" (tgt mode-string)) +(declare-function erc-time-diff "erc" (t1 t2)) +(declare-function erc-trim-string "erc" (s)) +(declare-function erc-update-mode-line "erc" (&optional buffer)) +(declare-function erc-update-mode-line-buffer "erc" (buffer)) +(declare-function erc-wash-quit-reason "erc" (reason nick login host)) + +(declare-function erc-display-message "erc" + (parsed type buffer msg &rest args)) +(declare-function erc-get-buffer-create "erc" + (server port target &optional tgt-info id)) +(declare-function erc-process-ctcp-reply "erc" + (proc parsed nick login host msg)) +(declare-function erc-update-channel-topic "erc" + (channel topic &optional modify)) +(declare-function erc-update-modes "erc" + (tgt mode-string &optional _nick _host _login)) +(declare-function erc-update-user-nick "erc" + (nick &optional new-nick host login full-name info)) +(declare-function erc-open "erc" + (&optional server port nick full-name connect passwd tgt-list + channel process client-certificate user id)) +(declare-function erc-update-channel-member "erc" + (channel nick new-nick + &optional add voice halfop op admin owner host + login full-name info update-message-time)) ;;;; Variables and options +(defvar-local erc-session-password nil + "The password used for the current session.") + (defvar erc-server-responses (make-hash-table :test #'equal) "Hash table mapping server responses to their handler hooks.") -(cl-defstruct (erc-response (:conc-name erc-response.)) - (unparsed "" :type string) - (sender "" :type string) - (command "" :type string) - (command-args '() :type list) - (contents "" :type string) - (tags '() :type list)) - ;;; User data (defvar-local erc-server-current-nick nil @@ -1666,16 +1759,6 @@ erc--parse-isupport-value (split-string value ",") (list value))))) -(defmacro erc--with-memoization (table &rest forms) - "Adapter to be migrated to erc-compat." - (declare (indent defun)) - `(cond - ((fboundp 'with-memoization) - (with-memoization ,table ,@forms)) ; 29.1 - ((fboundp 'cl--generic-with-memoization) - (cl--generic-with-memoization ,table ,@forms)) - (t ,@forms))) - (defun erc--get-isupport-entry (key &optional single) "Return an item for \"ISUPPORT\" token KEY, a symbol. When a lookup fails return nil. Otherwise return a list whose @@ -1685,7 +1768,7 @@ erc--get-isupport-entry primitive value." (if-let* ((table (or erc--isupport-params (erc-with-server-buffer erc--isupport-params))) - (value (erc--with-memoization (gethash key table) + (value (erc-compat--with-memoization (gethash key table) (when-let ((v (assoc (symbol-name key) erc-server-parameters))) (if (cdr v) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el new file mode 100644 index 0000000000..90ea56108d --- /dev/null +++ b/lisp/erc/erc-common.el @@ -0,0 +1,283 @@ +;;; erc-common.el --- Macros and types for ERC -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; Maintainer: Amin Bandali , F. Jason Park +;; Keywords: comm, IRC, chat, client, internet +;; +;; 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: + +(eval-when-compile (require 'cl-lib) (require 'subr-x)) +(require 'erc-compat) + +(defvar erc--casemapping-rfc1459) +(defvar erc--casemapping-rfc1459-strict) +(defvar erc--module-name-migrations) +(defvar erc-channel-users) +(defvar erc-dbuf) +(defvar erc-log-p) +(defvar erc-server-users) +(defvar erc-session-server) + +(declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-server-buffer "erc" nil) + +(cl-defstruct erc-input + string insertp sendp) + +(cl-defstruct (erc--input-split (:include erc-input)) + lines cmdp) + +(cl-defstruct (erc-server-user (:type vector) :named) + ;; User data + nickname host login full-name info + ;; Buffers + ;; + ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where + ;; CHANNEL-DATA is either nil or an erc-channel-user struct. + (buffers nil)) + +(cl-defstruct (erc-channel-user (:type vector) :named) + voice halfop op admin owner + ;; Last message time (in the form of the return value of + ;; (current-time) + ;; + ;; This is useful for ordered name completion. + (last-message-time nil)) + +(cl-defstruct erc--target + (string "" :type string :documentation "Received name of target.") + (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) + +;; At some point, it may make sense to add a query type with an +;; account field, which may help support reassociation across +;; reconnects and nick changes (likely requires v3 extensions). +;; +;; These channel variants should probably take on a `joined' field to +;; track "joinedness", which `erc-server-JOIN', `erc-server-PART', +;; etc. should toggle. Functions like `erc--current-buffer-joined-p' +;; may find it useful. + +(cl-defstruct (erc--target-channel (:include erc--target))) +(cl-defstruct (erc--target-channel-local (:include erc--target-channel))) + +(cl-defstruct (erc-response (:conc-name erc-response.)) + (unparsed "" :type string) + (sender "" :type string) + (command "" :type string) + (command-args '() :type list) + (contents "" :type string) + (tags '() :type list)) + +(defun erc--normalize-module-symbol (module) + "Canonicalize symbol MODULE for `erc-modules'." + (or (cdr (assq module erc--module-name-migrations)) module)) + +(defmacro define-erc-module (name alias doc enable-body disable-body + &optional local-p) + "Define a new minor mode using ERC conventions. +Symbol NAME is the name of the module. +Symbol ALIAS is the alias to use, or nil. +DOC is the documentation string to use for the minor mode. +ENABLE-BODY is a list of expressions used to enable the mode. +DISABLE-BODY is a list of expressions used to disable the mode. +If LOCAL-P is non-nil, the mode will be created as a buffer-local +mode, rather than a global one. + +This will define a minor mode called erc-NAME-mode, possibly +an alias erc-ALIAS-mode, as well as the helper functions +erc-NAME-enable, and erc-NAME-disable. Beware that for global +modules, these helpers, as well as the minor-mode toggle, all mutate +the user option `erc-modules'. + +Example: + + ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") + (define-erc-module replace nil + \"This mode replaces incoming text according to `erc-replace-alist'.\" + ((add-hook \\='erc-insert-modify-hook + #\\='erc-replace-insert)) + ((remove-hook \\='erc-insert-modify-hook + #\\='erc-replace-insert)))" + (declare (doc-string 3) (indent defun)) + (let* ((sn (symbol-name name)) + (mode (intern (format "erc-%s-mode" (downcase sn)))) + (group (intern (format "erc-%s" (downcase sn)))) + (enable (intern (format "erc-%s-enable" (downcase sn)))) + (disable (intern (format "erc-%s-disable" (downcase sn))))) + `(progn + (define-minor-mode + ,mode + ,(format "Toggle ERC %S mode. +With a prefix argument ARG, enable %s if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +%s" name name doc) + ;; FIXME: We don't know if this group exists, so this `:group' may + ;; actually just silence a valid warning about the fact that the var + ;; is not associated with any group. + :global ,(not local-p) :group (quote ,group) + (if ,mode + (,enable) + (,disable))) + (defun ,enable () + ,(format "Enable ERC %S mode." + name) + (interactive) + (unless ,local-p + (cl-pushnew (erc--normalize-module-symbol ',name) erc-modules)) + (when (or ,(not local-p) (eq major-mode 'erc-mode)) + (setq ,mode t) + ,@enable-body)) + (defun ,disable () + ,(format "Disable ERC %S mode." + name) + (interactive) + (unless ,local-p + (setq erc-modules (delq (erc--normalize-module-symbol ',name) + erc-modules))) + (when (or ,(not local-p) ,mode) + (setq ,mode nil) + ,@disable-body)) + ,(when (and alias (not (eq name alias))) + `(defalias + ',(intern + (format "erc-%s-mode" + (downcase (symbol-name alias)))) + #',mode)) + ;; For find-function and find-variable. + (put ',mode 'definition-name ',name) + (put ',enable 'definition-name ',name) + (put ',disable 'definition-name ',name)))) + +(defmacro erc-with-buffer (spec &rest body) + "Execute BODY in the buffer associated with SPEC. + +SPEC should have the form + + (TARGET [PROCESS]) + +If TARGET is a buffer, use it. Otherwise, use the buffer +matching TARGET in the process specified by PROCESS. + +If PROCESS is nil, use the current `erc-server-process'. +See `erc-get-buffer' for details. + +See also `with-current-buffer'. + +\(fn (TARGET [PROCESS]) BODY...)" + (declare (indent 1) (debug ((form &optional form) body))) + (let ((buf (make-symbol "buf")) + (proc (make-symbol "proc")) + (target (make-symbol "target")) + (process (make-symbol "process"))) + `(let* ((,target ,(car spec)) + (,process ,(cadr spec)) + (,buf (if (bufferp ,target) + ,target + (let ((,proc (or ,process + (and (processp erc-server-process) + erc-server-process)))) + (if (and ,target ,proc) + (erc-get-buffer ,target ,proc)))))) + (when (buffer-live-p ,buf) + (with-current-buffer ,buf + ,@body))))) + +(defmacro erc-with-server-buffer (&rest body) + "Execute BODY in the current ERC server buffer. +If no server buffer exists, return nil." + (declare (indent 0) (debug (body))) + (let ((buffer (make-symbol "buffer"))) + `(let ((,buffer (erc-server-buffer))) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + ,@body))))) + +(defmacro erc-with-all-buffers-of-server (process pred &rest forms) + "Execute FORMS in all buffers which have same process as this server. +FORMS will be evaluated in all buffers having the process PROCESS and +where PRED matches or in all buffers of the server process if PRED is +nil." + (declare (indent 2) (debug (form form body))) + (macroexp-let2 nil pred pred + `(erc-buffer-filter (lambda () + (when (or (not ,pred) (funcall ,pred)) + ,@forms)) + ,process))) + +(defun erc-log-aux (string) + "Do the debug logging of STRING." + (let ((cb (current-buffer)) + (point 1) + (was-eob nil) + (session-buffer (erc-server-buffer))) + (if session-buffer + (progn + (set-buffer session-buffer) + (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) + (progn + (setq erc-dbuf (get-buffer-create + (concat "*ERC-DEBUG: " + erc-session-server "*"))))) + (set-buffer erc-dbuf) + (setq point (point)) + (setq was-eob (eobp)) + (goto-char (point-max)) + (insert (concat "** " string "\n")) + (if was-eob (goto-char (point-max)) + (goto-char point)) + (set-buffer cb)) + (message "ERC: ** %s" string)))) + +(define-inline erc-log (string) + "Logs STRING if logging is on (see `erc-log-p')." + (inline-quote + (when erc-log-p + (erc-log-aux ,string)))) + +(defun erc-downcase (string) + "Return a downcased copy of STRING with properties. +Use the CASEMAPPING ISUPPORT parameter to determine the style." + (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single)) + (inhibit-read-only t)) + (if (equal mapping "ascii") + (downcase string) + (with-temp-buffer + (insert string) + (translate-region (point-min) (point-max) + (if (equal mapping "rfc1459-strict") + erc--casemapping-rfc1459-strict + erc--casemapping-rfc1459)) + (buffer-string))))) + +(define-inline erc-get-channel-user (nick) + "Find NICK in the current buffer's `erc-channel-users' hash table." + (inline-quote (gethash (erc-downcase ,nick) erc-channel-users))) + +(define-inline erc-get-server-user (nick) + "Find NICK in the current server's `erc-server-users' hash table." + (inline-letevals (nick) + (inline-quote (erc-with-server-buffer + (gethash (erc-downcase ,nick) erc-server-users))))) + +(provide 'erc-common) + +;;; erc-common.el ends here diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 3123f64b88..bc3e1dcfc6 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -260,6 +260,18 @@ erc-compat--sasl-scram--client-final-message (sasl-client-set-property client 'salted-password salted-password) client-final-message)) + +;;;; Misc 29.1 + +(defmacro erc-compat--with-memoization (table &rest forms) + (declare (indent defun)) + (cond + ((fboundp 'with-memoization) + `(with-memoization ,table ,@forms)) ; 29.1 + ((fboundp 'cl--generic-with-memoization) + `(cl--generic-with-memoization ,table ,@forms)) + (t `(progn ,@forms)))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8fef23945d..1af83b58ba 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -29,10 +29,24 @@ ;;; Code: -(require 'erc) - ;;; Imenu support +(eval-when-compile (require 'cl-lib)) +(require 'erc-common) + +(defvar erc-controls-highlight-regexp) +(defvar erc-controls-remove-regexp) +(defvar erc-input-marker) +(defvar erc-insert-marker) +(defvar erc-server-process) +(defvar erc-modules) +(defvar erc-log-p) + +(declare-function erc-buffer-list "erc" (&optional predicate proc)) +(declare-function erc-error "erc" (&rest args)) +(declare-function erc-extract-command-from-line "erc" (line)) +(declare-function erc-beg-of-input-line "erc" nil) + (defun erc-imenu-setup () "Setup Imenu support in an ERC buffer." (setq-local imenu-create-index-function #'erc-create-imenu-index)) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 2c8f8fb72b..667b0c3d76 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -39,8 +39,32 @@ ;;; Code: -(require 'erc) (eval-when-compile (require 'cl-lib)) +(require 'erc-common) + +(defvar erc--target) +(defvar erc-insert-marker) +(defvar erc-kill-buffer-hook) +(defvar erc-kill-server-hook) +(defvar erc-modules) +(defvar erc-rename-buffers) +(defvar erc-reuse-buffers) +(defvar erc-server-announced-name) +(defvar erc-server-connected) +(defvar erc-server-parameters) +(defvar erc-server-process) +(defvar erc-session-server) + +(declare-function erc--default-target "erc" nil) +(declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc-buffer-filter "erc" (predicate &optional proc)) +(declare-function erc-current-nick "erc" nil) +(declare-function erc-display-error-notice "erc" (parsed string)) +(declare-function erc-error "erc" (&rest args)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-server-buffer "erc" nil) +(declare-function erc-server-process-alive "erc-backend" (&optional buffer)) +(declare-function erc-set-active-buffer "erc" (buffer)) ;; Variables @@ -813,7 +837,7 @@ erc-networks--id-given (erc-networks--id-symbol nid)) (cl-generic-define-context-rewriter erc-obsolete-var (var spec) - `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec)) + `((with-suppressed-warnings ((obsolete ,var) (free-vars ,var)) ,var) ,spec)) ;; As a catch-all, derive the symbol from the unquoted printed repr. (cl-defgeneric erc-networks--id-create (id) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7c72085fea..994504d72e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -60,6 +60,9 @@ (load "erc-loaddefs" 'noerror 'nomessage) +(require 'erc-networks) +(require 'erc-goodies) +(require 'erc-backend) (require 'cl-lib) (require 'format-spec) (require 'pp) @@ -69,8 +72,6 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(require 'erc-compat) - (defconst erc-version "5.4.1" "This version of ERC.") @@ -132,29 +133,12 @@ erc-scripts "Running scripts at startup and with /LOAD." :group 'erc) -;; Defined in erc-backend -(defvar erc--server-last-reconnect-count) -(defvar erc--server-reconnecting) -(defvar erc-channel-members-changed-hook) -(defvar erc-network) -(defvar erc-networks--id) -(defvar erc-server-367-functions) -(defvar erc-server-announced-name) -(defvar erc-server-connect-function) -(defvar erc-server-connected) -(defvar erc-server-current-nick) -(defvar erc-server-lag) -(defvar erc-server-last-sent-time) -(defvar erc-server-process) -(defvar erc-server-quitting) -(defvar erc-server-reconnect-count) -(defvar erc-server-reconnecting) -(defvar erc-session-client-certificate) -(defvar erc-session-connector) -(defvar erc-session-port) -(defvar erc-session-server) -(defvar erc-session-user-full-name) -(defvar erc-session-username) +;; Forward declarations +(defvar erc-message-parsed) + +(defvar tabbar--local-hlf) +(defvar motif-version-string) +(defvar gtk-version-string) ;; tunable connection and authentication parameters @@ -349,9 +333,6 @@ erc-channel-hide-list :group 'erc-ignore :type 'erc-message-type) -(defvar-local erc-session-password nil - "The password used for the current session.") - (defcustom erc-disconnected-hook nil "Run this hook with arguments (NICK IP REASON) when disconnected. This happens before automatic reconnection. Note, that @@ -436,69 +417,14 @@ erc--casemapping-rfc1459-strict '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)) (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) -(defun erc-downcase (string) - "Return a downcased copy of STRING with properties. -Use the CASEMAPPING ISUPPORT parameter to determine the style." - (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single)) - (inhibit-read-only t)) - (if (equal mapping "ascii") - (downcase string) - (with-temp-buffer - (insert string) - (translate-region (point-min) (point-max) - (if (equal mapping "rfc1459-strict") - erc--casemapping-rfc1459-strict - erc--casemapping-rfc1459)) - (buffer-string))))) - -(defmacro erc-with-server-buffer (&rest body) - "Execute BODY in the current ERC server buffer. -If no server buffer exists, return nil." - (declare (indent 0) (debug (body))) - (let ((buffer (make-symbol "buffer"))) - `(let ((,buffer (erc-server-buffer))) - (when (buffer-live-p ,buffer) - (with-current-buffer ,buffer - ,@body))))) - -(cl-defstruct (erc-server-user (:type vector) :named) - ;; User data - nickname host login full-name info - ;; Buffers - ;; - ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where - ;; CHANNEL-DATA is either nil or an erc-channel-user struct. - (buffers nil) - ) - -(cl-defstruct (erc-channel-user (:type vector) :named) - voice halfop op admin owner - ;; Last message time (in the form of the return value of - ;; (current-time) - ;; - ;; This is useful for ordered name completion. - (last-message-time nil)) - -(define-inline erc-get-channel-user (nick) - "Find NICK in the current buffer's `erc-channel-users' hash table." - (inline-quote (gethash (erc-downcase ,nick) erc-channel-users))) - -(define-inline erc-get-server-user (nick) - "Find NICK in the current server's `erc-server-users' hash table." - (inline-letevals (nick) - (inline-quote (erc-with-server-buffer - (gethash (erc-downcase ,nick) erc-server-users))))) - -(define-inline erc-add-server-user (nick user) +(defun erc-add-server-user (nick user) "This function is for internal use only. Adds USER with nickname NICK to the `erc-server-users' hash table." - (inline-letevals (nick user) - (inline-quote - (erc-with-server-buffer - (puthash (erc-downcase ,nick) ,user erc-server-users))))) + (erc-with-server-buffer + (puthash (erc-downcase nick) user erc-server-users))) -(define-inline erc-remove-server-user (nick) +(defun erc-remove-server-user (nick) "This function is for internal use only. Removes the user with nickname NICK from the `erc-server-users' @@ -506,10 +432,8 @@ erc-remove-server-user `erc-channel-users' lists of other buffers. See also: `erc-remove-user'." - (inline-letevals (nick) - (inline-quote - (erc-with-server-buffer - (remhash (erc-downcase ,nick) erc-server-users))))) + (erc-with-server-buffer + (remhash (erc-downcase nick) erc-server-users))) (defun erc-change-user-nickname (user new-nick) "This function is for internal use only. @@ -580,55 +504,45 @@ erc-remove-channel-users erc-channel-users) (clrhash erc-channel-users))) -(define-inline erc-channel-user-owner-p (nick) +(defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick - (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) - (and cdata (cdr cdata) - (erc-channel-user-owner (cdr cdata)))))))) - -(define-inline erc-channel-user-admin-p (nick) + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-owner (cdr cdata)))))) + +(defun erc-channel-user-admin-p (nick) "Return non-nil if NICK is an admin in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-admin (cdr cdata)))))))) + (erc-channel-user-admin (cdr cdata)))))) -(define-inline erc-channel-user-op-p (nick) +(defun erc-channel-user-op-p (nick) "Return non-nil if NICK is an operator in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-op (cdr cdata)))))))) + (erc-channel-user-op (cdr cdata)))))) -(define-inline erc-channel-user-halfop-p (nick) +(defun erc-channel-user-halfop-p (nick) "Return non-nil if NICK is a half-operator in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-halfop (cdr cdata)))))))) + (erc-channel-user-halfop (cdr cdata)))))) -(define-inline erc-channel-user-voice-p (nick) +(defun erc-channel-user-voice-p (nick) "Return non-nil if NICK has voice in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-voice (cdr cdata)))))))) + (erc-channel-user-voice (cdr cdata)))))) (defun erc-get-channel-user-list () "Return a list of users in the current channel. @@ -1377,96 +1291,6 @@ erc-debug-log-file (defvar-local erc-dbuf nil) -(defmacro define-erc-module (name alias doc enable-body disable-body - &optional local-p) - "Define a new minor mode using ERC conventions. -Symbol NAME is the name of the module. -Symbol ALIAS is the alias to use, or nil. -DOC is the documentation string to use for the minor mode. -ENABLE-BODY is a list of expressions used to enable the mode. -DISABLE-BODY is a list of expressions used to disable the mode. -If LOCAL-P is non-nil, the mode will be created as a buffer-local -mode, rather than a global one. - -This will define a minor mode called erc-NAME-mode, possibly -an alias erc-ALIAS-mode, as well as the helper functions -erc-NAME-enable, and erc-NAME-disable. - -Example: - - ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") - (define-erc-module replace nil - \"This mode replaces incoming text according to `erc-replace-alist'.\" - ((add-hook \\='erc-insert-modify-hook - #\\='erc-replace-insert)) - ((remove-hook \\='erc-insert-modify-hook - #\\='erc-replace-insert)))" - (declare (doc-string 3) (indent defun)) - (let* ((sn (symbol-name name)) - (mode (intern (format "erc-%s-mode" (downcase sn)))) - (group (intern (format "erc-%s" (downcase sn)))) - (enable (intern (format "erc-%s-enable" (downcase sn)))) - (disable (intern (format "erc-%s-disable" (downcase sn))))) - `(progn - (define-minor-mode - ,mode - ,(format "Toggle ERC %S mode. -With a prefix argument ARG, enable %s if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. -%s" name name doc) - ;; FIXME: We don't know if this group exists, so this `:group' may - ;; actually just silence a valid warning about the fact that the var - ;; is not associated with any group. - :global ,(not local-p) :group (quote ,group) - (if ,mode - (,enable) - (,disable))) - (defun ,enable () - ,(format "Enable ERC %S mode." - name) - (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) - (defun ,disable () - ,(format "Disable ERC %S mode." - name) - (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) - ,(when (and alias (not (eq name alias))) - `(defalias - ',(intern - (format "erc-%s-mode" - (downcase (symbol-name alias)))) - #',mode)) - ;; For find-function and find-variable. - (put ',mode 'definition-name ',name) - (put ',enable 'definition-name ',name) - (put ',disable 'definition-name ',name)))) - -;; The rationale for favoring inheritance here (nicer dispatch) is -;; kinda flimsy since there aren't yet any actual methods. - -(cl-defstruct erc--target - (string "" :type string :documentation "Received name of target.") - (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) - -;; These should probably take on a `joined' field to track joinedness, -;; which should be toggled by `erc-server-JOIN', `erc-server-PART', -;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may -;; find it useful. - -(cl-defstruct (erc--target-channel (:include erc--target))) - -(cl-defstruct (erc--target-channel-local (:include erc--target-channel))) - -;; At some point, it may make sense to add a query type with an -;; account field, which may help support reassociation across -;; reconnects and nick changes (likely requires v3 extensions). - (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." (funcall (if (erc-channel-p string) @@ -1516,12 +1340,6 @@ erc-once-with-server-event (add-hook hook fun nil t) fun)) -(define-inline erc-log (string) - "Logs STRING if logging is on (see `erc-log-p')." - (inline-quote - (when erc-log-p - (erc-log-aux ,string)))) - (defun erc-server-buffer () "Return the server buffer for the current buffer's process. The buffer-local variable `erc-server-process' is used to find @@ -1577,29 +1395,7 @@ erc-ison-p (if erc-online-p "" "not ")) erc-online-p)))) -(defun erc-log-aux (string) - "Do the debug logging of STRING." - (let ((cb (current-buffer)) - (point 1) - (was-eob nil) - (session-buffer (erc-server-buffer))) - (if session-buffer - (progn - (set-buffer session-buffer) - (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) - (progn - (setq erc-dbuf (get-buffer-create - (concat "*ERC-DEBUG: " - erc-session-server "*"))))) - (set-buffer erc-dbuf) - (setq point (point)) - (setq was-eob (eobp)) - (goto-char (point-max)) - (insert (concat "** " string "\n")) - (if was-eob (goto-char (point-max)) - (goto-char point)) - (set-buffer cb)) - (message "ERC: ** %s" string)))) + ;; Last active buffer, to print server messages in the right place @@ -1841,40 +1637,6 @@ erc-member-ignore-case (throw 'result list) (setq list (cdr list)))))) -(defmacro erc-with-buffer (spec &rest body) - "Execute BODY in the buffer associated with SPEC. - -SPEC should have the form - - (TARGET [PROCESS]) - -If TARGET is a buffer, use it. Otherwise, use the buffer -matching TARGET in the process specified by PROCESS. - -If PROCESS is nil, use the current `erc-server-process'. -See `erc-get-buffer' for details. - -See also `with-current-buffer'. - -\(fn (TARGET [PROCESS]) BODY...)" - (declare (indent 1) (debug ((form &optional form) body))) - (let ((buf (make-symbol "buf")) - (proc (make-symbol "proc")) - (target (make-symbol "target")) - (process (make-symbol "process"))) - `(let* ((,target ,(car spec)) - (,process ,(cadr spec)) - (,buf (if (bufferp ,target) - ,target - (let ((,proc (or ,process - (and (processp erc-server-process) - erc-server-process)))) - (if (and ,target ,proc) - (erc-get-buffer ,target ,proc)))))) - (when (buffer-live-p ,buf) - (with-current-buffer ,buf - ,@body))))) - (defun erc-get-buffer (target &optional proc) "Return the buffer matching TARGET in the process PROC. If PROC is not supplied, all processes are searched." @@ -1921,18 +1683,6 @@ erc-buffer-list (setq predicate (lambda () t))) (erc-buffer-filter predicate proc)) -(defmacro erc-with-all-buffers-of-server (process pred &rest forms) - "Execute FORMS in all buffers which have same process as this server. -FORMS will be evaluated in all buffers having the process PROCESS and -where PRED matches or in all buffers of the server process if PRED is -nil." - (declare (indent 1) (debug (form form body))) - (macroexp-let2 nil pred pred - `(erc-buffer-filter (lambda () - (when (or (not ,pred) (funcall ,pred)) - ,@forms)) - ,process))) - (define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1") (defun erc--switch-to-buffer (&optional arg) (read-buffer "Switch to ERC buffer: " @@ -2903,8 +2653,6 @@ erc-lurker-cleanup-interval consumption of lurker state during long Emacs sessions and/or ERC sessions with large numbers of incoming PRIVMSGs.") -(defvar erc-message-parsed) - (defun erc-lurker-update-status (_message) "Update `erc-lurker-state' if necessary. @@ -4116,9 +3864,6 @@ erc-cmd-SERVER t) (put 'erc-cmd-SERVER 'process-not-needed t) -(defvar motif-version-string) -(defvar gtk-version-string) - (defun erc-cmd-SV () "Say the current ERC and Emacs version into channel." (erc-send-message (format "I'm using ERC %s with GNU Emacs %s (%s%s)%s." @@ -5375,6 +5120,12 @@ erc-parse-prefix (setq i (1+ i))) alist)))) +(defcustom erc-channel-members-changed-hook nil + "This hook is called every time the variable `channel-members' changes. +The buffer where the change happened is current while this hook is called." + :group 'erc-hooks + :type 'hook) + (defun erc-channel-receive-names (names-string) "This function is for internal use only. @@ -5418,13 +5169,6 @@ erc-channel-receive-names name name t voice halfop op admin owner))))) (run-hooks 'erc-channel-members-changed-hook))) - -(defcustom erc-channel-members-changed-hook nil - "This hook is called every time the variable `channel-members' changes. -The buffer where the change happened is current while this hook is called." - :group 'erc-hooks - :type 'hook) - (defun erc-update-user-nick (nick &optional new-nick host login full-name info) "Update the stored user information for the user with nickname NICK. @@ -6034,12 +5778,6 @@ erc-user-input (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" "Regular expression used for matching commands in ERC.") -(cl-defstruct erc-input - string insertp sendp) - -(cl-defstruct (erc--input-split (:include erc-input)) - lines cmdp) - (defun erc--discard-trailing-multiline-nulls (state) "Ensure last line of STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil. STATE is @@ -6983,9 +6721,6 @@ erc-format-lag-time (t "")))) ;; erc-goodies is required at end of this file. -(declare-function erc-controls-strip "erc-goodies" (str)) - -(defvar tabbar--local-hlf) ;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat, ;; remove the function invocations from the spec form below. @@ -7474,12 +7209,4 @@ erc-handle-irc-url (provide 'erc) -(require 'erc-backend) - -;; Deprecated. We might eventually stop requiring the goodies automatically. -;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to -;; avoid a recursive require error when byte-compiling the entire package. -(require 'erc-goodies) -(require 'erc-networks) - ;;; erc.el ends here diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 66a334b709..32bdfa11ff 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -20,7 +20,7 @@ ;;; Code: (require 'ert-x) ; cl-lib -(require 'erc-networks) +(require 'erc) (defun erc-networks-tests--create-dead-proc (&optional buf) (let ((p (start-process "true" (or buf (current-buffer)) "true"))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index d3d319ab22..4646c35e25 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -24,7 +24,6 @@ (require 'ert-x) (require 'erc) (require 'erc-ring) -(require 'erc-networks) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) @@ -48,27 +47,6 @@ erc--read-time-period (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) (should (equal (erc--read-time-period "foo: ") 86400)))) -(ert-deftest erc--meta--backend-dependencies () - (with-temp-buffer - (insert-file-contents-literally - (concat (file-name-sans-extension (symbol-file 'erc)) ".el")) - (let ((beg (search-forward ";; Defined in erc-backend")) - (end (search-forward "\n\n")) - vars) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (with-syntax-table lisp-data-mode-syntax-table - (condition-case _ - (while (push (cadr (read (current-buffer))) vars)) - (end-of-file))))) - (should (= (point) end)) - (dolist (var vars) - (setq var (concat "\\_<" (symbol-name var) "\\_>")) - (ert-info (var) - (should (save-excursion (search-forward-regexp var nil t)))))))) - (ert-deftest erc-with-all-buffers-of-server () (let (proc-exnet proc-onet -- 2.37.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Move-ERC-s-core-dependencies-to-separate-file.patch >From 2f66c3f4dcc41195e5578d6a9cf38d98fc1a05d2 Mon Sep 17 00:00:00 2001 From: dickmao Date: Fri, 1 Jul 2022 11:06:51 -0400 Subject: [PATCH 1/5] Move ERC's core dependencies to separate file Asking people to order require's is about as effective as asking kids to keep off the grass. * lisp/erc/erc-backend.el (erc--target, erc-auto-query, erc-channel-list, erc-channel-users, erc-default-nicks, erc-default-recipients, erc-format-nick-function, erc-format-query-as-channel-p, erc-hide-prompt, erc-input-marker, erc-insert-marker, erc-invitation, erc-join-buffer, erc-kill-buffer-on-part, erc-kill-server-buffer-on-quit, erc-log-p, erc-minibuffer-ignored, erc-networks--id, erc-nick, erc-nick-change-attempt-count, erc-prompt-for-channel-key, erc-prompt-hidden, erc-reuse-buffers, erc-verbose-server-ping, erc-whowas-on-nosuchnick): Forward-declare variables. (erc--open-target, erc--target-from-string, erc-active-buffer, erc-add-default-channel, erc-banlist-update, erc-buffer-filter, erc-buffer-list-with-nick, erc-channel-begin-receiving-names, erc-channel-end-receiving-names, erc-channel-p, erc-channel-receive-names, erc-cmd-JOIN, erc-connection-established, erc-current-nick, erc-current-nick-p, erc-current-time, erc-default-target, erc-delete-default-channel, erc-display-error-notice, erc-display-server-message, erc-emacs-time-to-erc-time, erc-format-message, erc-format-privmessage, erc-get-buffer, erc-handle-login, erc-handle-user-status-change, erc-ignored-reply-p, erc-ignored-user-p, erc-is-message-ctcp-and-not-action-p, erc-is-message-ctcp-p, erc-log-irc-protocol, erc-login, erc-make-notice, erc-network, erc-networks--id-given, erc-networks--id-reload, erc-nickname-in-use, erc-parse-user, erc-process-away, erc-process-ctcp-query, erc-query-buffer-p, erc-remove-channel-member, erc-remove-channel-users, erc-remove-user, erc-sec-to-time, erc-server-buffer, erc-set-active-buffer, erc-set-current-nick, erc-set-modes, erc-time-diff, erc-trim-string, erc-update-mode-line, erc-update-mode-line-buffer, erc-wash-quit-reason, erc-display-message, erc-get-buffer-create, erc-process-ctcp-reply, erc-update-channel-topic, erc-update-modes, erc-update-user-nick, erc-open, erc-update-channel-member): Forward-declare functions. (erc-response): Move to lisp/erc/erc-common.el. (erc-compat--with-memoization): Use "erc-compat-" prefixed macro. * lisp/erc/erc-common.el: New file. Change indentation for `erc-with-all-buffers-of-server' from 1 to 2. * lisp/erc/erc-compat.el (erc-compat--with-memoization): Migrate macro from `erc-common' and rename. * lisp/erc/erc-goodies.el: Require `erc-common' instead of `erc'. (erc-controls-highlight-regexp, erc-controls-remove-regexp, erc-input-marker, erc-insert-marker, erc-server-process, erc-modules, erc-log-p): Forward declare variables. (erc-buffer-list, erc-error, erc-extract-command-from-line): Forward-declare functions. * lisp/erc/erc-networks.el (erc--target, erc-insert-marker, erc-kill-buffer-hook, erc-kill-server-hook, erc-modules, erc-rename-buffers, erc-reuse-buffers, erc-server-announced-name, erc-server-connected, erc-server-parameters, erc-server-process, erc-session-server): Forward declare variables. (erc--default-target, erc--get-isupport-entry, erc-buffer-filter, erc-current-nick, erc-display-error-notice, erc-error, erc-get-buffer, erc-server-buffer, erc-server-process-alive): Forward-declare functions. (erc-obsolete-var): Also suppress free-variable warnings. * lisp/erc/erc.el: Require `erc-networks', `erc-goodies', and `erc-backend' at top of file. Don't require `erc-compat'. (erc--server-last-reconnect-count, erc--server-reconnecting, erc-channel-members-changed-hook, erc-network, erc-networks--id, erc-server-367-functions, erc-server-announced-name, erc-server-connect-function, erc-server-connected, erc-server-current-nick, erc-server-lag, erc-server-last-sent-time, erc-server-process, erc-server-quitting, erc-server-reconnect-count, erc-server-reconnecting, erc-session-client-certificate, erc-session-connector, erc-session-port, erc-session-server, erc-session-user-full-name) Remove superfluous forward declarations. (erc-message-parsed, tabbar--local-hlf, motif-version-string): Relocate forward declares to central location. (erc-session-password): Move to `erc-backend'. (erc-downcase, erc-with-server-buffer, erc-server-user, erc-channel-user, erc-get-channel-user, erc-get-server-user): Move to lisp/erc/erc-common.el. (erc-add-server-user, erc-remove-server-user, erc-channel-user-owner-p, erc-channel-user-admin-p, erc-channel-user-op-p, erc-channel-user-halfop-p, erc-channel-user-voice-p): Convert from inline functions to normal functions. (define-erc-module, erc--target, erc--target-channel, erc--target-channel-local, erc-log, erc-log-aux, erc-with-buffer, erc-with-all-buffers-of-server): Move to lisp/erc/erc-common.el. (erc-channel-members-changed-hook): Relocate option to avoid compiler warning. (erc-input, erc--input-split): Move to lisp/erc/erc-common.el. (erc-controls-strip): Remove forward declaration temporarily until this file stops requiring `erc-goodies'. * test/lisp/erc/erc-networks-tests.el: Require `erc' instead of `erc-networks'. * test/lisp/erc/erc.el (erc--meta--backend-dependencies): Remove unused test. Don't require `erc-networks'. Bug#56340. --- lisp/erc/erc-backend.el | 129 ++++++++-- lisp/erc/erc-common.el | 271 +++++++++++++++++++++ lisp/erc/erc-compat.el | 12 + lisp/erc/erc-goodies.el | 17 +- lisp/erc/erc-networks.el | 28 ++- lisp/erc/erc.el | 363 ++++------------------------ test/lisp/erc/erc-networks-tests.el | 2 +- test/lisp/erc/erc-tests.el | 22 -- 8 files changed, 476 insertions(+), 368 deletions(-) create mode 100644 lisp/erc/erc-common.el diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index df9efe4b0c..026b34849a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -99,24 +99,117 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. -;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the -;; reverse is true: -(require 'erc) +(require 'erc-common) + +(defvar erc--target) +(defvar erc-auto-query) +(defvar erc-channel-list) +(defvar erc-channel-users) +(defvar erc-default-nicks) +(defvar erc-default-recipients) +(defvar erc-format-nick-function) +(defvar erc-format-query-as-channel-p) +(defvar erc-hide-prompt) +(defvar erc-input-marker) +(defvar erc-insert-marker) +(defvar erc-invitation) +(defvar erc-join-buffer) +(defvar erc-kill-buffer-on-part) +(defvar erc-kill-server-buffer-on-quit) +(defvar erc-log-p) +(defvar erc-minibuffer-ignored) +(defvar erc-networks--id) +(defvar erc-nick) +(defvar erc-nick-change-attempt-count) +(defvar erc-prompt-for-channel-key) +(defvar erc-prompt-hidden) +(defvar erc-reuse-buffers) +(defvar erc-verbose-server-ping) +(defvar erc-whowas-on-nosuchnick) + +(declare-function erc--open-target "erc" (target)) +(declare-function erc--target-from-string "erc" (string)) +(declare-function erc-active-buffer "erc" nil) +(declare-function erc-add-default-channel "erc" (channel)) +(declare-function erc-banlist-update "erc" (proc parsed)) +(declare-function erc-buffer-filter "erc" (predicate &optional proc)) +(declare-function erc-buffer-list-with-nick "erc" (nick proc)) +(declare-function erc-channel-begin-receiving-names "erc" nil) +(declare-function erc-channel-end-receiving-names "erc" nil) +(declare-function erc-channel-p "erc" (channel)) +(declare-function erc-channel-receive-names "erc" (names-string)) +(declare-function erc-cmd-JOIN "erc" (channel &optional key)) +(declare-function erc-connection-established "erc" (proc parsed)) +(declare-function erc-current-nick "erc" nil) +(declare-function erc-current-nick-p "erc" (nick)) +(declare-function erc-current-time "erc" (&optional specified-time)) +(declare-function erc-default-target "erc" nil) +(declare-function erc-delete-default-channel "erc" (channel &optional buffer)) +(declare-function erc-display-error-notice "erc" (parsed string)) +(declare-function erc-display-server-message "erc" (_proc parsed)) +(declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time)) +(declare-function erc-format-message "erc" (msg &rest args)) +(declare-function erc-format-privmessage "erc" (nick msg privp msgp)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-handle-login "erc" nil) +(declare-function erc-handle-user-status-change "erc" (type nlh &optional l)) +(declare-function erc-ignored-reply-p "erc" (msg tgt proc)) +(declare-function erc-ignored-user-p "erc" (spec)) +(declare-function erc-is-message-ctcp-and-not-action-p "erc" (message)) +(declare-function erc-is-message-ctcp-p "erc" (message)) +(declare-function erc-log-irc-protocol "erc" (string &optional outbound)) +(declare-function erc-login "erc" nil) +(declare-function erc-make-notice "erc" (message)) +(declare-function erc-network "erc-networks" nil) +(declare-function erc-networks--id-given "erc-networks" (arg &rest args)) +(declare-function erc-networks--id-reload "erc-networks" (arg &rest args)) +(declare-function erc-nickname-in-use "erc" (nick reason)) +(declare-function erc-parse-user "erc" (string)) +(declare-function erc-process-away "erc" (proc away-p)) +(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host)) +(declare-function erc-query-buffer-p "erc" (&optional buffer)) +(declare-function erc-remove-channel-member "erc" (channel nick)) +(declare-function erc-remove-channel-users "erc" nil) +(declare-function erc-remove-user "erc" (nick)) +(declare-function erc-sec-to-time "erc" (ns)) +(declare-function erc-server-buffer "erc" nil) +(declare-function erc-set-active-buffer "erc" (buffer)) +(declare-function erc-set-current-nick "erc" (nick)) +(declare-function erc-set-modes "erc" (tgt mode-string)) +(declare-function erc-time-diff "erc" (t1 t2)) +(declare-function erc-trim-string "erc" (s)) +(declare-function erc-update-mode-line "erc" (&optional buffer)) +(declare-function erc-update-mode-line-buffer "erc" (buffer)) +(declare-function erc-wash-quit-reason "erc" (reason nick login host)) + +(declare-function erc-display-message "erc" + (parsed type buffer msg &rest args)) +(declare-function erc-get-buffer-create "erc" + (server port target &optional tgt-info id)) +(declare-function erc-process-ctcp-reply "erc" + (proc parsed nick login host msg)) +(declare-function erc-update-channel-topic "erc" + (channel topic &optional modify)) +(declare-function erc-update-modes "erc" + (tgt mode-string &optional _nick _host _login)) +(declare-function erc-update-user-nick "erc" + (nick &optional new-nick host login full-name info)) +(declare-function erc-open "erc" + (&optional server port nick full-name connect passwd tgt-list + channel process client-certificate user id)) +(declare-function erc-update-channel-member "erc" + (channel nick new-nick + &optional add voice halfop op admin owner host + login full-name info update-message-time)) ;;;; Variables and options +(defvar-local erc-session-password nil + "The password used for the current session.") + (defvar erc-server-responses (make-hash-table :test #'equal) "Hash table mapping server responses to their handler hooks.") -(cl-defstruct (erc-response (:conc-name erc-response.)) - (unparsed "" :type string) - (sender "" :type string) - (command "" :type string) - (command-args '() :type list) - (contents "" :type string) - (tags '() :type list)) - ;;; User data (defvar-local erc-server-current-nick nil @@ -1662,16 +1755,6 @@ erc--parse-isupport-value (split-string value ",") (list value))))) -(defmacro erc--with-memoization (table &rest forms) - "Adapter to be migrated to erc-compat." - (declare (indent defun)) - `(cond - ((fboundp 'with-memoization) - (with-memoization ,table ,@forms)) ; 29.1 - ((fboundp 'cl--generic-with-memoization) - (cl--generic-with-memoization ,table ,@forms)) - (t ,@forms))) - (defun erc--get-isupport-entry (key &optional single) "Return an item for \"ISUPPORT\" token KEY, a symbol. When a lookup fails return nil. Otherwise return a list whose @@ -1681,7 +1764,7 @@ erc--get-isupport-entry primitive value." (if-let* ((table (or erc--isupport-params (erc-with-server-buffer erc--isupport-params))) - (value (erc--with-memoization (gethash key table) + (value (erc-compat--with-memoization (gethash key table) (when-let ((v (assoc (symbol-name key) erc-server-parameters))) (if (cdr v) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el new file mode 100644 index 0000000000..d8aac36eab --- /dev/null +++ b/lisp/erc/erc-common.el @@ -0,0 +1,271 @@ +;;; erc-common.el --- Macros and types for ERC -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; Maintainer: Amin Bandali , F. Jason Park +;; Keywords: comm, IRC, chat, client, internet +;; +;; 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: + +(eval-when-compile (require 'cl-lib) (require 'subr-x)) +(require 'erc-compat) + +(defvar erc--casemapping-rfc1459) +(defvar erc--casemapping-rfc1459-strict) +(defvar erc-channel-users) +(defvar erc-dbuf) +(defvar erc-log-p) +(defvar erc-server-users) +(defvar erc-session-server) + +(declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-server-buffer "erc" nil) + +(cl-defstruct erc-input + string insertp sendp) + +(cl-defstruct (erc--input-split (:include erc-input)) + lines cmdp) + +(cl-defstruct (erc-server-user (:type vector) :named) + ;; User data + nickname host login full-name info + ;; Buffers + ;; + ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where + ;; CHANNEL-DATA is either nil or an erc-channel-user struct. + (buffers nil)) + +(cl-defstruct (erc-channel-user (:type vector) :named) + voice halfop op admin owner + ;; Last message time (in the form of the return value of + ;; (current-time) + ;; + ;; This is useful for ordered name completion. + (last-message-time nil)) + +(cl-defstruct erc--target + (string "" :type string :documentation "Received name of target.") + (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) + +;; At some point, it may make sense to add a query type with an +;; account field, which may help support reassociation across +;; reconnects and nick changes (likely requires v3 extensions). +;; +;; These channel variants should probably take on a `joined' field to +;; track "joinedness", which `erc-server-JOIN', `erc-server-PART', +;; etc. should toggle. Functions like `erc--current-buffer-joined-p' +;; may find it useful. + +(cl-defstruct (erc--target-channel (:include erc--target))) +(cl-defstruct (erc--target-channel-local (:include erc--target-channel))) + +(cl-defstruct (erc-response (:conc-name erc-response.)) + (unparsed "" :type string) + (sender "" :type string) + (command "" :type string) + (command-args '() :type list) + (contents "" :type string) + (tags '() :type list)) + +(defmacro define-erc-module (name alias doc enable-body disable-body + &optional local-p) + "Define a new minor mode using ERC conventions. +Symbol NAME is the name of the module. +Symbol ALIAS is the alias to use, or nil. +DOC is the documentation string to use for the minor mode. +ENABLE-BODY is a list of expressions used to enable the mode. +DISABLE-BODY is a list of expressions used to disable the mode. +If LOCAL-P is non-nil, the mode will be created as a buffer-local +mode, rather than a global one. + +This will define a minor mode called erc-NAME-mode, possibly +an alias erc-ALIAS-mode, as well as the helper functions +erc-NAME-enable, and erc-NAME-disable. + +Example: + + ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") + (define-erc-module replace nil + \"This mode replaces incoming text according to `erc-replace-alist'.\" + ((add-hook \\='erc-insert-modify-hook + #\\='erc-replace-insert)) + ((remove-hook \\='erc-insert-modify-hook + #\\='erc-replace-insert)))" + (declare (doc-string 3) (indent defun)) + (let* ((sn (symbol-name name)) + (mode (intern (format "erc-%s-mode" (downcase sn)))) + (group (intern (format "erc-%s" (downcase sn)))) + (enable (intern (format "erc-%s-enable" (downcase sn)))) + (disable (intern (format "erc-%s-disable" (downcase sn))))) + `(progn + (define-minor-mode + ,mode + ,(format "Toggle ERC %S mode. +With a prefix argument ARG, enable %s if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. +%s" name name doc) + ;; FIXME: We don't know if this group exists, so this `:group' may + ;; actually just silence a valid warning about the fact that the var + ;; is not associated with any group. + :global ,(not local-p) :group (quote ,group) + (if ,mode + (,enable) + (,disable))) + (defun ,enable () + ,(format "Enable ERC %S mode." + name) + (interactive) + (add-to-list 'erc-modules (quote ,name)) + (setq ,mode t) + ,@enable-body) + (defun ,disable () + ,(format "Disable ERC %S mode." + name) + (interactive) + (setq erc-modules (delq (quote ,name) erc-modules)) + (setq ,mode nil) + ,@disable-body) + ,(when (and alias (not (eq name alias))) + `(defalias + ',(intern + (format "erc-%s-mode" + (downcase (symbol-name alias)))) + #',mode)) + ;; For find-function and find-variable. + (put ',mode 'definition-name ',name) + (put ',enable 'definition-name ',name) + (put ',disable 'definition-name ',name)))) + +(defmacro erc-with-buffer (spec &rest body) + "Execute BODY in the buffer associated with SPEC. + +SPEC should have the form + + (TARGET [PROCESS]) + +If TARGET is a buffer, use it. Otherwise, use the buffer +matching TARGET in the process specified by PROCESS. + +If PROCESS is nil, use the current `erc-server-process'. +See `erc-get-buffer' for details. + +See also `with-current-buffer'. + +\(fn (TARGET [PROCESS]) BODY...)" + (declare (indent 1) (debug ((form &optional form) body))) + (let ((buf (make-symbol "buf")) + (proc (make-symbol "proc")) + (target (make-symbol "target")) + (process (make-symbol "process"))) + `(let* ((,target ,(car spec)) + (,process ,(cadr spec)) + (,buf (if (bufferp ,target) + ,target + (let ((,proc (or ,process + (and (processp erc-server-process) + erc-server-process)))) + (if (and ,target ,proc) + (erc-get-buffer ,target ,proc)))))) + (when (buffer-live-p ,buf) + (with-current-buffer ,buf + ,@body))))) + +(defmacro erc-with-server-buffer (&rest body) + "Execute BODY in the current ERC server buffer. +If no server buffer exists, return nil." + (declare (indent 0) (debug (body))) + (let ((buffer (make-symbol "buffer"))) + `(let ((,buffer (erc-server-buffer))) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + ,@body))))) + +(defmacro erc-with-all-buffers-of-server (process pred &rest forms) + "Execute FORMS in all buffers which have same process as this server. +FORMS will be evaluated in all buffers having the process PROCESS and +where PRED matches or in all buffers of the server process if PRED is +nil." + (declare (indent 2) (debug (form form body))) + (macroexp-let2 nil pred pred + `(erc-buffer-filter (lambda () + (when (or (not ,pred) (funcall ,pred)) + ,@forms)) + ,process))) + +(defun erc-log-aux (string) + "Do the debug logging of STRING." + (let ((cb (current-buffer)) + (point 1) + (was-eob nil) + (session-buffer (erc-server-buffer))) + (if session-buffer + (progn + (set-buffer session-buffer) + (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) + (progn + (setq erc-dbuf (get-buffer-create + (concat "*ERC-DEBUG: " + erc-session-server "*"))))) + (set-buffer erc-dbuf) + (setq point (point)) + (setq was-eob (eobp)) + (goto-char (point-max)) + (insert (concat "** " string "\n")) + (if was-eob (goto-char (point-max)) + (goto-char point)) + (set-buffer cb)) + (message "ERC: ** %s" string)))) + +(define-inline erc-log (string) + "Logs STRING if logging is on (see `erc-log-p')." + (inline-quote + (when erc-log-p + (erc-log-aux ,string)))) + +(defun erc-downcase (string) + "Return a downcased copy of STRING with properties. +Use the CASEMAPPING ISUPPORT parameter to determine the style." + (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single)) + (inhibit-read-only t)) + (if (equal mapping "ascii") + (downcase string) + (with-temp-buffer + (insert string) + (translate-region (point-min) (point-max) + (if (equal mapping "rfc1459-strict") + erc--casemapping-rfc1459-strict + erc--casemapping-rfc1459)) + (buffer-string))))) + +(define-inline erc-get-channel-user (nick) + "Find NICK in the current buffer's `erc-channel-users' hash table." + (inline-quote (gethash (erc-downcase ,nick) erc-channel-users))) + +(define-inline erc-get-server-user (nick) + "Find NICK in the current server's `erc-server-users' hash table." + (inline-letevals (nick) + (inline-quote (erc-with-server-buffer + (gethash (erc-downcase ,nick) erc-server-users))))) + +(provide 'erc-common) + +;;; erc-common.el ends here diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 8a00e711ac..03bd8f1352 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -156,6 +156,18 @@ erc-subseq (setq i (1+ i) start (1+ start))) res)))))) + +;;;; Misc 29.1 + +(defmacro erc-compat--with-memoization (table &rest forms) + (declare (indent defun)) + (cond + ((fboundp 'with-memoization) + `(with-memoization ,table ,@forms)) ; 29.1 + ((fboundp 'cl--generic-with-memoization) + `(cl--generic-with-memoization ,table ,@forms)) + (t `(progn ,@forms)))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 8fef23945d..59b5f01f23 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -29,10 +29,23 @@ ;;; Code: -(require 'erc) - ;;; Imenu support +(require 'erc-common) + +(defvar erc-controls-highlight-regexp) +(defvar erc-controls-remove-regexp) +(defvar erc-input-marker) +(defvar erc-insert-marker) +(defvar erc-server-process) +(defvar erc-modules) +(defvar erc-log-p) + +(declare-function erc-buffer-list "erc" (&optional predicate proc)) +(declare-function erc-error "erc" (&rest args)) +(declare-function erc-extract-command-from-line "erc" (line)) +(declare-function erc-beg-of-input-line "erc" nil) + (defun erc-imenu-setup () "Setup Imenu support in an ERC buffer." (setq-local imenu-create-index-function #'erc-create-imenu-index)) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 2c8f8fb72b..667b0c3d76 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -39,8 +39,32 @@ ;;; Code: -(require 'erc) (eval-when-compile (require 'cl-lib)) +(require 'erc-common) + +(defvar erc--target) +(defvar erc-insert-marker) +(defvar erc-kill-buffer-hook) +(defvar erc-kill-server-hook) +(defvar erc-modules) +(defvar erc-rename-buffers) +(defvar erc-reuse-buffers) +(defvar erc-server-announced-name) +(defvar erc-server-connected) +(defvar erc-server-parameters) +(defvar erc-server-process) +(defvar erc-session-server) + +(declare-function erc--default-target "erc" nil) +(declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) +(declare-function erc-buffer-filter "erc" (predicate &optional proc)) +(declare-function erc-current-nick "erc" nil) +(declare-function erc-display-error-notice "erc" (parsed string)) +(declare-function erc-error "erc" (&rest args)) +(declare-function erc-get-buffer "erc" (target &optional proc)) +(declare-function erc-server-buffer "erc" nil) +(declare-function erc-server-process-alive "erc-backend" (&optional buffer)) +(declare-function erc-set-active-buffer "erc" (buffer)) ;; Variables @@ -813,7 +837,7 @@ erc-networks--id-given (erc-networks--id-symbol nid)) (cl-generic-define-context-rewriter erc-obsolete-var (var spec) - `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec)) + `((with-suppressed-warnings ((obsolete ,var) (free-vars ,var)) ,var) ,spec)) ;; As a catch-all, derive the symbol from the unquoted printed repr. (cl-defgeneric erc-networks--id-create (id) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index db39e341b2..e0a4bd3001 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -60,6 +60,9 @@ (load "erc-loaddefs" 'noerror 'nomessage) +(require 'erc-networks) +(require 'erc-goodies) +(require 'erc-backend) (require 'cl-lib) (require 'format-spec) (require 'pp) @@ -69,8 +72,6 @@ (require 'iso8601) (eval-when-compile (require 'subr-x)) -(require 'erc-compat) - (defconst erc-version "5.4.1" "This version of ERC.") @@ -132,29 +133,12 @@ erc-scripts "Running scripts at startup and with /LOAD." :group 'erc) -;; Defined in erc-backend -(defvar erc--server-last-reconnect-count) -(defvar erc--server-reconnecting) -(defvar erc-channel-members-changed-hook) -(defvar erc-network) -(defvar erc-networks--id) -(defvar erc-server-367-functions) -(defvar erc-server-announced-name) -(defvar erc-server-connect-function) -(defvar erc-server-connected) -(defvar erc-server-current-nick) -(defvar erc-server-lag) -(defvar erc-server-last-sent-time) -(defvar erc-server-process) -(defvar erc-server-quitting) -(defvar erc-server-reconnect-count) -(defvar erc-server-reconnecting) -(defvar erc-session-client-certificate) -(defvar erc-session-connector) -(defvar erc-session-port) -(defvar erc-session-server) -(defvar erc-session-user-full-name) -(defvar erc-session-username) +;; Forward declarations +(defvar erc-message-parsed) + +(defvar tabbar--local-hlf) +(defvar motif-version-string) +(defvar gtk-version-string) ;; tunable connection and authentication parameters @@ -349,9 +333,6 @@ erc-channel-hide-list :group 'erc-ignore :type 'erc-message-type) -(defvar-local erc-session-password nil - "The password used for the current session.") - (defcustom erc-disconnected-hook nil "Run this hook with arguments (NICK IP REASON) when disconnected. This happens before automatic reconnection. Note, that @@ -436,69 +417,14 @@ erc--casemapping-rfc1459-strict '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)) (mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) -(defun erc-downcase (string) - "Return a downcased copy of STRING with properties. -Use the CASEMAPPING ISUPPORT parameter to determine the style." - (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single)) - (inhibit-read-only t)) - (if (equal mapping "ascii") - (downcase string) - (with-temp-buffer - (insert string) - (translate-region (point-min) (point-max) - (if (equal mapping "rfc1459-strict") - erc--casemapping-rfc1459-strict - erc--casemapping-rfc1459)) - (buffer-string))))) - -(defmacro erc-with-server-buffer (&rest body) - "Execute BODY in the current ERC server buffer. -If no server buffer exists, return nil." - (declare (indent 0) (debug (body))) - (let ((buffer (make-symbol "buffer"))) - `(let ((,buffer (erc-server-buffer))) - (when (buffer-live-p ,buffer) - (with-current-buffer ,buffer - ,@body))))) - -(cl-defstruct (erc-server-user (:type vector) :named) - ;; User data - nickname host login full-name info - ;; Buffers - ;; - ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where - ;; CHANNEL-DATA is either nil or an erc-channel-user struct. - (buffers nil) - ) - -(cl-defstruct (erc-channel-user (:type vector) :named) - voice halfop op admin owner - ;; Last message time (in the form of the return value of - ;; (current-time) - ;; - ;; This is useful for ordered name completion. - (last-message-time nil)) - -(define-inline erc-get-channel-user (nick) - "Find NICK in the current buffer's `erc-channel-users' hash table." - (inline-quote (gethash (erc-downcase ,nick) erc-channel-users))) - -(define-inline erc-get-server-user (nick) - "Find NICK in the current server's `erc-server-users' hash table." - (inline-letevals (nick) - (inline-quote (erc-with-server-buffer - (gethash (erc-downcase ,nick) erc-server-users))))) - -(define-inline erc-add-server-user (nick user) +(defun erc-add-server-user (nick user) "This function is for internal use only. Adds USER with nickname NICK to the `erc-server-users' hash table." - (inline-letevals (nick user) - (inline-quote - (erc-with-server-buffer - (puthash (erc-downcase ,nick) ,user erc-server-users))))) + (erc-with-server-buffer + (puthash (erc-downcase nick) user erc-server-users))) -(define-inline erc-remove-server-user (nick) +(defun erc-remove-server-user (nick) "This function is for internal use only. Removes the user with nickname NICK from the `erc-server-users' @@ -506,10 +432,8 @@ erc-remove-server-user `erc-channel-users' lists of other buffers. See also: `erc-remove-user'." - (inline-letevals (nick) - (inline-quote - (erc-with-server-buffer - (remhash (erc-downcase ,nick) erc-server-users))))) + (erc-with-server-buffer + (remhash (erc-downcase nick) erc-server-users))) (defun erc-change-user-nickname (user new-nick) "This function is for internal use only. @@ -580,55 +504,45 @@ erc-remove-channel-users erc-channel-users) (clrhash erc-channel-users))) -(define-inline erc-channel-user-owner-p (nick) +(defun erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick - (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) - (and cdata (cdr cdata) - (erc-channel-user-owner (cdr cdata)))))))) - -(define-inline erc-channel-user-admin-p (nick) + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-owner (cdr cdata)))))) + +(defun erc-channel-user-admin-p (nick) "Return non-nil if NICK is an admin in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-admin (cdr cdata)))))))) + (erc-channel-user-admin (cdr cdata)))))) -(define-inline erc-channel-user-op-p (nick) +(defun erc-channel-user-op-p (nick) "Return non-nil if NICK is an operator in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-op (cdr cdata)))))))) + (erc-channel-user-op (cdr cdata)))))) -(define-inline erc-channel-user-halfop-p (nick) +(defun erc-channel-user-halfop-p (nick) "Return non-nil if NICK is a half-operator in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-halfop (cdr cdata)))))))) + (erc-channel-user-halfop (cdr cdata)))))) -(define-inline erc-channel-user-voice-p (nick) +(defun erc-channel-user-voice-p (nick) "Return non-nil if NICK has voice in the current channel." - (inline-letevals (nick) - (inline-quote - (and ,nick + (and nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user ,nick))) + (let ((cdata (erc-get-channel-user nick))) (and cdata (cdr cdata) - (erc-channel-user-voice (cdr cdata)))))))) + (erc-channel-user-voice (cdr cdata)))))) (defun erc-get-channel-user-list () "Return a list of users in the current channel. @@ -1377,96 +1291,6 @@ erc-debug-log-file (defvar-local erc-dbuf nil) -(defmacro define-erc-module (name alias doc enable-body disable-body - &optional local-p) - "Define a new minor mode using ERC conventions. -Symbol NAME is the name of the module. -Symbol ALIAS is the alias to use, or nil. -DOC is the documentation string to use for the minor mode. -ENABLE-BODY is a list of expressions used to enable the mode. -DISABLE-BODY is a list of expressions used to disable the mode. -If LOCAL-P is non-nil, the mode will be created as a buffer-local -mode, rather than a global one. - -This will define a minor mode called erc-NAME-mode, possibly -an alias erc-ALIAS-mode, as well as the helper functions -erc-NAME-enable, and erc-NAME-disable. - -Example: - - ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") - (define-erc-module replace nil - \"This mode replaces incoming text according to `erc-replace-alist'.\" - ((add-hook \\='erc-insert-modify-hook - #\\='erc-replace-insert)) - ((remove-hook \\='erc-insert-modify-hook - #\\='erc-replace-insert)))" - (declare (doc-string 3) (indent defun)) - (let* ((sn (symbol-name name)) - (mode (intern (format "erc-%s-mode" (downcase sn)))) - (group (intern (format "erc-%s" (downcase sn)))) - (enable (intern (format "erc-%s-enable" (downcase sn)))) - (disable (intern (format "erc-%s-disable" (downcase sn))))) - `(progn - (define-minor-mode - ,mode - ,(format "Toggle ERC %S mode. -With a prefix argument ARG, enable %s if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. -%s" name name doc) - ;; FIXME: We don't know if this group exists, so this `:group' may - ;; actually just silence a valid warning about the fact that the var - ;; is not associated with any group. - :global ,(not local-p) :group (quote ,group) - (if ,mode - (,enable) - (,disable))) - (defun ,enable () - ,(format "Enable ERC %S mode." - name) - (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) - (defun ,disable () - ,(format "Disable ERC %S mode." - name) - (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) - ,(when (and alias (not (eq name alias))) - `(defalias - ',(intern - (format "erc-%s-mode" - (downcase (symbol-name alias)))) - #',mode)) - ;; For find-function and find-variable. - (put ',mode 'definition-name ',name) - (put ',enable 'definition-name ',name) - (put ',disable 'definition-name ',name)))) - -;; The rationale for favoring inheritance here (nicer dispatch) is -;; kinda flimsy since there aren't yet any actual methods. - -(cl-defstruct erc--target - (string "" :type string :documentation "Received name of target.") - (symbol nil :type symbol :documentation "Case-mapped name as symbol.")) - -;; These should probably take on a `joined' field to track joinedness, -;; which should be toggled by `erc-server-JOIN', `erc-server-PART', -;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may -;; find it useful. - -(cl-defstruct (erc--target-channel (:include erc--target))) - -(cl-defstruct (erc--target-channel-local (:include erc--target-channel))) - -;; At some point, it may make sense to add a query type with an -;; account field, which may help support reassociation across -;; reconnects and nick changes (likely requires v3 extensions). - (defun erc--target-from-string (string) "Construct an `erc--target' variant from STRING." (funcall (if (erc-channel-p string) @@ -1516,12 +1340,6 @@ erc-once-with-server-event (add-hook hook fun nil t) fun)) -(define-inline erc-log (string) - "Logs STRING if logging is on (see `erc-log-p')." - (inline-quote - (when erc-log-p - (erc-log-aux ,string)))) - (defun erc-server-buffer () "Return the server buffer for the current buffer's process. The buffer-local variable `erc-server-process' is used to find @@ -1577,29 +1395,7 @@ erc-ison-p (if erc-online-p "" "not ")) erc-online-p)))) -(defun erc-log-aux (string) - "Do the debug logging of STRING." - (let ((cb (current-buffer)) - (point 1) - (was-eob nil) - (session-buffer (erc-server-buffer))) - (if session-buffer - (progn - (set-buffer session-buffer) - (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) - (progn - (setq erc-dbuf (get-buffer-create - (concat "*ERC-DEBUG: " - erc-session-server "*"))))) - (set-buffer erc-dbuf) - (setq point (point)) - (setq was-eob (eobp)) - (goto-char (point-max)) - (insert (concat "** " string "\n")) - (if was-eob (goto-char (point-max)) - (goto-char point)) - (set-buffer cb)) - (message "ERC: ** %s" string)))) + ;; Last active buffer, to print server messages in the right place @@ -1841,40 +1637,6 @@ erc-member-ignore-case (throw 'result list) (setq list (cdr list)))))) -(defmacro erc-with-buffer (spec &rest body) - "Execute BODY in the buffer associated with SPEC. - -SPEC should have the form - - (TARGET [PROCESS]) - -If TARGET is a buffer, use it. Otherwise, use the buffer -matching TARGET in the process specified by PROCESS. - -If PROCESS is nil, use the current `erc-server-process'. -See `erc-get-buffer' for details. - -See also `with-current-buffer'. - -\(fn (TARGET [PROCESS]) BODY...)" - (declare (indent 1) (debug ((form &optional form) body))) - (let ((buf (make-symbol "buf")) - (proc (make-symbol "proc")) - (target (make-symbol "target")) - (process (make-symbol "process"))) - `(let* ((,target ,(car spec)) - (,process ,(cadr spec)) - (,buf (if (bufferp ,target) - ,target - (let ((,proc (or ,process - (and (processp erc-server-process) - erc-server-process)))) - (if (and ,target ,proc) - (erc-get-buffer ,target ,proc)))))) - (when (buffer-live-p ,buf) - (with-current-buffer ,buf - ,@body))))) - (defun erc-get-buffer (target &optional proc) "Return the buffer matching TARGET in the process PROC. If PROC is not supplied, all processes are searched." @@ -1921,18 +1683,6 @@ erc-buffer-list (setq predicate (lambda () t))) (erc-buffer-filter predicate proc)) -(defmacro erc-with-all-buffers-of-server (process pred &rest forms) - "Execute FORMS in all buffers which have same process as this server. -FORMS will be evaluated in all buffers having the process PROCESS and -where PRED matches or in all buffers of the server process if PRED is -nil." - (declare (indent 1) (debug (form form body))) - (macroexp-let2 nil pred pred - `(erc-buffer-filter (lambda () - (when (or (not ,pred) (funcall ,pred)) - ,@forms)) - ,process))) - (define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1") (defun erc--switch-to-buffer (&optional arg) (read-buffer "Switch to ERC buffer: " @@ -2877,8 +2627,6 @@ erc-lurker-cleanup-interval consumption of lurker state during long Emacs sessions and/or ERC sessions with large numbers of incoming PRIVMSGs.") -(defvar erc-message-parsed) - (defun erc-lurker-update-status (_message) "Update `erc-lurker-state' if necessary. @@ -4090,9 +3838,6 @@ erc-cmd-SERVER t) (put 'erc-cmd-SERVER 'process-not-needed t) -(defvar motif-version-string) -(defvar gtk-version-string) - (defun erc-cmd-SV () "Say the current ERC and Emacs version into channel." (erc-send-message (format "I'm using ERC %s with GNU Emacs %s (%s%s)%s." @@ -5349,6 +5094,12 @@ erc-parse-prefix (setq i (1+ i))) alist)))) +(defcustom erc-channel-members-changed-hook nil + "This hook is called every time the variable `channel-members' changes. +The buffer where the change happened is current while this hook is called." + :group 'erc-hooks + :type 'hook) + (defun erc-channel-receive-names (names-string) "This function is for internal use only. @@ -5392,13 +5143,6 @@ erc-channel-receive-names name name t voice halfop op admin owner))))) (run-hooks 'erc-channel-members-changed-hook))) - -(defcustom erc-channel-members-changed-hook nil - "This hook is called every time the variable `channel-members' changes. -The buffer where the change happened is current while this hook is called." - :group 'erc-hooks - :type 'hook) - (defun erc-update-user-nick (nick &optional new-nick host login full-name info) "Update the stored user information for the user with nickname NICK. @@ -6008,12 +5752,6 @@ erc-user-input (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" "Regular expression used for matching commands in ERC.") -(cl-defstruct erc-input - string insertp sendp) - -(cl-defstruct (erc--input-split (:include erc-input)) - lines cmdp) - (defun erc--discard-trailing-multiline-nulls (state) "Ensure last line of STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil. STATE is @@ -6957,9 +6695,6 @@ erc-format-lag-time (t "")))) ;; erc-goodies is required at end of this file. -(declare-function erc-controls-strip "erc-goodies" (str)) - -(defvar tabbar--local-hlf) ;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat, ;; remove the function invocations from the spec form below. @@ -7448,12 +7183,4 @@ erc-handle-irc-url (provide 'erc) -(require 'erc-backend) - -;; Deprecated. We might eventually stop requiring the goodies automatically. -;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to -;; avoid a recursive require error when byte-compiling the entire package. -(require 'erc-goodies) -(require 'erc-networks) - ;;; erc.el ends here diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 66a334b709..32bdfa11ff 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -20,7 +20,7 @@ ;;; Code: (require 'ert-x) ; cl-lib -(require 'erc-networks) +(require 'erc) (defun erc-networks-tests--create-dead-proc (&optional buf) (let ((p (start-process "true" (or buf (current-buffer)) "true"))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b2ed29e80e..c88dd9888d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -24,7 +24,6 @@ (require 'ert-x) (require 'erc) (require 'erc-ring) -(require 'erc-networks) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) @@ -48,27 +47,6 @@ erc--read-time-period (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) (should (equal (erc--read-time-period "foo: ") 86400)))) -(ert-deftest erc--meta--backend-dependencies () - (with-temp-buffer - (insert-file-contents-literally - (concat (file-name-sans-extension (symbol-file 'erc)) ".el")) - (let ((beg (search-forward ";; Defined in erc-backend")) - (end (search-forward "\n\n")) - vars) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (with-syntax-table lisp-data-mode-syntax-table - (condition-case _ - (while (push (cadr (read (current-buffer))) vars)) - (end-of-file))))) - (should (= (point) end)) - (dolist (var vars) - (setq var (concat "\\_<" (symbol-name var) "\\_>")) - (ert-info (var) - (should (save-excursion (search-forward-regexp var nil t)))))))) - (ert-deftest erc-with-all-buffers-of-server () (let (proc-exnet proc-onet -- 2.37.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Add-GS2-authorization-to-sasl-scram-rfc.patch >From 05e5bdd488a309b70ca140fc620ad48023befa24 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 19 Sep 2022 21:28:52 -0700 Subject: [PATCH 2/5] Add GS2 authorization to sasl-scram-rfc * lisp/net/sasl-scram-rfc.el (sasl-scram-gs2-header-function, sasl-scram-construct-gs2-header): Add new variable and default function for determining a SCRAM GSS-API message header. `defcustom' not used because library doesn't define any others. (sasl-scram-client-first-message): Use gs2-header function. (sasl-scram--client-final-message): Use dedicated gs2-header function. Also remove whitespace when base64-encoding, as per RFC 5802. Bug#57956. --- lisp/net/sasl-scram-rfc.el | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index ee52ed6e07..f7a2e42541 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -45,14 +45,21 @@ ;;; Generic for SCRAM-* +(defvar sasl-scram-gs2-header-function 'sasl-scram-construct-gs2-header + "Function to create GS2 header. +See https://www.rfc-editor.org/rfc/rfc5801#section-4.") + +(defun sasl-scram-construct-gs2-header (client) + ;; The "n," means the client doesn't support channel binding, and + ;; the trailing comma is included as per RFC 5801. + (let ((authzid (sasl-client-property client 'authenticator-name))) + (concat "n," (and authzid "a=") authzid ","))) + (defun sasl-scram-client-first-message (client _step) (let ((c-nonce (sasl-unique-id))) (sasl-client-set-property client 'c-nonce c-nonce)) (concat - ;; n = client doesn't support channel binding - "n," - ;; TODO: where would we get authorization id from? - "," + (funcall sasl-scram-gs2-header-function client) (sasl-scram--client-first-message-bare client))) (defun sasl-scram--client-first-message-bare (client) @@ -77,11 +84,11 @@ sasl-scram--client-final-message (c-nonce (sasl-client-property client 'c-nonce)) ;; no channel binding, no authorization id - (cbind-input "n,,")) + (cbind-input (funcall sasl-scram-gs2-header-function client))) (unless (string-prefix-p c-nonce nonce) (sasl-error "Invalid nonce from server")) (let* ((client-final-message-without-proof - (concat "c=" (base64-encode-string cbind-input) "," + (concat "c=" (base64-encode-string cbind-input t) "," "r=" nonce)) (password ;; TODO: either apply saslprep or disallow non-ASCII characters @@ -113,7 +120,7 @@ sasl-scram--client-final-message (client-proof (funcall string-xor client-key client-signature)) (client-final-message (concat client-final-message-without-proof "," - "p=" (base64-encode-string client-proof)))) + "p=" (base64-encode-string client-proof t)))) (sasl-client-set-property client 'auth-message auth-message) (sasl-client-set-property client 'salted-password salted-password) client-final-message))) -- 2.37.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Support-local-ERC-modules-in-erc-mode-buffers.patch >From 03812d6e956e83538db5223af473eec621b2f2dd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 12 Jul 2021 03:44:28 -0700 Subject: [PATCH 3/5] Support local ERC modules in erc-mode buffers * lisp/erc/erc.el (erc-migrate-modules): add some missing mappings. (erc--module-name-migrations, erc--features-to-modules, erc--modules-to-features): add alists to support simplified module-name migrations. (erc-update-modules): Change return value to a list of minor-mode commands for local modules that need deferred activation, if any. Use `custom-variable-p' to detect flavor. Currently, all modules are global, meaning so are their accompanying minor modes. (erc-open): Defer enabling of local modules via `erc-update-modules' until after buffer is initialized with other local vars. Also defer major mode hooks so they can detect things like whether the buffer is a server or target buffer. * lisp/erc/erc-common.el (define-erc-modules): Don't enable local modules (minor modes) unless `erc-mode' is the major mode. And don't disable them unless the minor mode is actually active. Also, don't mutate `erc-modules' when dealing with a local module. It's believed that the original authors wanted this functionality. (erc--normalize-module-symbol): Add helper for `erc-migrate-modules'. * lisp/erc/erc-goodies.el: Require cl-lib. Bug#57955. --- lisp/erc/erc-common.el | 26 ++++++++---- lisp/erc/erc-goodies.el | 1 + lisp/erc/erc.el | 83 +++++++++++++++++++++++++------------- test/lisp/erc/erc-tests.el | 47 +++++++++++++++++++++ 4 files changed, 121 insertions(+), 36 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d8aac36eab..90ea56108d 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -28,6 +28,7 @@ (defvar erc--casemapping-rfc1459) (defvar erc--casemapping-rfc1459-strict) +(defvar erc--module-name-migrations) (defvar erc-channel-users) (defvar erc-dbuf) (defvar erc-log-p) @@ -85,6 +86,10 @@ erc--target (contents "" :type string) (tags '() :type list)) +(defun erc--normalize-module-symbol (module) + "Canonicalize symbol MODULE for `erc-modules'." + (or (cdr (assq module erc--module-name-migrations)) module)) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -98,7 +103,9 @@ define-erc-module This will define a minor mode called erc-NAME-mode, possibly an alias erc-ALIAS-mode, as well as the helper functions -erc-NAME-enable, and erc-NAME-disable. +erc-NAME-enable, and erc-NAME-disable. Beware that for global +modules, these helpers, as well as the minor-mode toggle, all mutate +the user option `erc-modules'. Example: @@ -134,16 +141,21 @@ define-erc-module ,(format "Enable ERC %S mode." name) (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) + (unless ,local-p + (cl-pushnew (erc--normalize-module-symbol ',name) erc-modules)) + (when (or ,(not local-p) (eq major-mode 'erc-mode)) + (setq ,mode t) + ,@enable-body)) (defun ,disable () ,(format "Disable ERC %S mode." name) (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) + (unless ,local-p + (setq erc-modules (delq (erc--normalize-module-symbol ',name) + erc-modules))) + (when (or ,(not local-p) ,mode) + (setq ,mode nil) + ,@disable-body)) ,(when (and alias (not (eq name alias))) `(defalias ',(intern diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 59b5f01f23..1af83b58ba 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -31,6 +31,7 @@ ;;; Imenu support +(eval-when-compile (require 'cl-lib)) (require 'erc-common) (defvar erc-controls-highlight-regexp) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e0a4bd3001..23649a5620 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1780,14 +1780,36 @@ erc-default-nicks (defvar-local erc-nick-change-attempt-count 0 "Used to keep track of how many times an attempt at changing nick is made.") +(defconst erc--features-to-modules + '((erc-pcomplete completion pcomplete) + (erc-capab capab-identify) + (erc-join autojoin) + (erc-page page ctcp-page) + (erc-sound sound ctcp-sound) + (erc-stamp stamp timestamp) + (erc-services services nickserv)) + "Migration alist mapping a library feature to module names. +Keys need not be unique: a library may define more than one +module.") + +(defconst erc--modules-to-features + (cl-loop for (feature . names) in erc--features-to-modules + append (mapcar (lambda (name) (cons name feature)) names)) + "Migration alist mapping a module's name to library feature.") + +(defconst erc--module-name-migrations + (let (pairs) + (pcase-dolist (`(,_ ,canonical . ,rest) erc--features-to-modules) + (dolist (obsolete rest) + (push (cons obsolete canonical) pairs))) + pairs) + "Association list of obsolete module names to canonical names.") + (defun erc-migrate-modules (mods) "Migrate old names of ERC modules to new ones." ;; modify `transforms' to specify what needs to be changed ;; each item is in the format '(old . new) - (let ((transforms '((pcomplete . completion)))) - (delete-dups - (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) - mods)))) + (delete-dups (mapcar #'erc--normalize-module-symbol mods))) (defcustom erc-modules '(netsplit fill button match track completion readonly networks ring autojoin noncommands irccontrols @@ -1866,27 +1888,22 @@ erc-modules :group 'erc) (defun erc-update-modules () - "Run this to enable erc-foo-mode for all modules in `erc-modules'." - (let (req) + "Enable global minor mode for all global modules in `erc-modules'. +Return minor-mode commands for all local modules, possibly for +deferred invocation, as done by `erc-open' whenever a new ERC +buffer is created. Local modules were introduced in ERC 5.6." + (let (local-modules) (dolist (mod erc-modules) - (setq req (concat "erc-" (symbol-name mod))) - (cond - ;; yuck. perhaps we should bring the filenames into sync? - ((string= req "erc-capab-identify") - (setq req "erc-capab")) - ((string= req "erc-completion") - (setq req "erc-pcomplete")) - ((string= req "erc-pcomplete") - (setq mod 'completion)) - ((string= req "erc-autojoin") - (setq req "erc-join"))) - (condition-case nil - (require (intern req)) - (error nil)) + (require (or (alist-get mod erc--modules-to-features) + (intern (concat "erc-" (symbol-name mod)))) + nil 'noerror) ; some modules don't have a corresponding feature (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode")))) - (if (fboundp sym) + (unless (and sym (fboundp sym)) + (error "`%s' is not a known ERC module" mod)) + (if (custom-variable-p sym) (funcall sym 1) - (error "`%s' is not a known ERC module" mod)))))) + (push sym local-modules)))) + local-modules)) (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." @@ -1942,18 +1959,22 @@ erc-open (let* ((target (and channel (erc--target-from-string channel))) (buffer (erc-get-buffer-create server port nil target id)) (old-buffer (current-buffer)) - old-point + (old-recon-count erc-server-reconnect-count) + (old-point nil) + (delayed-modules nil) (continued-session (and erc--server-reconnecting (with-suppressed-warnings ((obsolete erc-reuse-buffers)) erc-reuse-buffers)))) (when connect (run-hook-with-args 'erc-before-connect server port nick)) - (erc-update-modules) (set-buffer buffer) (setq old-point (point)) - (let ((old-recon-count erc-server-reconnect-count)) - (erc-mode) - (setq erc-server-reconnect-count old-recon-count)) + (setq delayed-modules (erc-update-modules)) + + (delay-mode-hooks (erc-mode)) + + (setq erc-server-reconnect-count old-recon-count) + (when (setq erc-server-connected (not connect)) (setq erc-server-announced-name (buffer-local-value 'erc-server-announced-name old-buffer))) @@ -2016,6 +2037,12 @@ erc-open (setq erc-dbuf (when erc-log-p (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) + + (erc-determine-parameters server port nick full-name user passwd) + + (save-excursion (run-mode-hooks)) + (dolist (mod delayed-modules) (funcall mod +1)) + ;; set up prompt (unless continued-session (goto-char (point-max)) @@ -2027,8 +2054,6 @@ erc-open (erc-display-prompt) (goto-char (point-max))) - (erc-determine-parameters server port nick full-name user passwd) - ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c88dd9888d..4646c35e25 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -953,4 +953,51 @@ erc-message (kill-buffer "ExampleNet") (kill-buffer "#chan"))) +(ert-deftest erc-migrate-modules () + (should (equal (erc-migrate-modules '(autojoin timestamp button)) + '(autojoin stamp button))) + ;; Default unchanged + (should (equal (erc-migrate-modules erc-modules) erc-modules))) + +(ert-deftest erc-update-modules () + (let* (calls + (erc-modules '(fake-foo fake-bar))) + (cl-letf (((symbol-function 'require) + (lambda (s &rest _) (push s calls))) + ((symbol-function 'erc-fake-foo-mode) + (lambda (n) (push (cons 'fake-foo n) calls))) + ;; Here, foo is a global module (minor mode) + ((get 'erc-fake-foo-mode 'standard-value) #'ignore) + ((symbol-function 'erc-fake-bar-mode) + (lambda (n) (push (cons 'fake-bar n) calls))) + ((symbol-function 'erc-autojoin-mode) + (lambda (n) (push (cons 'autojoin n) calls))) + ((get 'erc-autojoin-mode 'standard-value) #'ignore) + ((symbol-function 'erc-networks-mode) + (lambda (n) (push (cons 'networks n) calls))) + ((symbol-function 'erc-completion-mode) + (lambda (n) (push (cons 'completion n) calls))) + ((get 'erc-completion-mode 'standard-value) #'ignore)) + + (ert-info ("Locals") + (should (equal (erc-update-modules) + '(erc-fake-bar-mode))) + ;; Bar still required + (should (equal (nreverse calls) '(erc-fake-foo + (fake-foo . 1) + erc-fake-bar))) + (setq calls nil)) + + (ert-info ("Module name overrides") + (setq erc-modules '(completion autojoin networks)) + (should-not (erc-update-modules)) ; no locals + (should (equal (nreverse calls) + '(erc-pcomplete + (completion . 1) + erc-join + (autojoin . 1) + erc-networks + (networks . 1)))) + (setq calls nil))))) + ;;; erc-tests.el ends here -- 2.37.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Call-erc-login-indirectly-via-new-generic-wrapper.patch >From cbc776566ee5ed177ee1a923300143695c6d71fc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Sep 2022 01:49:23 -0700 Subject: [PATCH 4/5] Call erc-login indirectly via new generic wrapper * lisp/erc/erc-backend (erc--register-connection): Add new generic function that defers to `erc-login' by default. (erc-process-sentinel, erc-server-connect): Call `erc--register-connection' instead of `erc-login'. --- lisp/erc/erc-backend.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 026b34849a..fee29e7d05 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -625,6 +625,10 @@ erc-open-network-stream (let ((p (plist-put parameters :nowait t))) (apply #'open-network-stream name buffer host service p))) +(cl-defmethod erc--register-connection () + "Perform opening IRC protocol exchange with server." + (erc-login)) + (defun erc-server-connect (server port buffer &optional client-certificate) "Perform the connection and login using the specified SERVER and PORT. We will store server variables in the buffer given by BUFFER. @@ -673,7 +677,7 @@ erc-server-connect ;; waiting for a non-blocking connect - keep the user informed (erc-display-message nil nil buffer "Opening connection..\n") (message "%s...done" msg) - (erc-login)) )) + (erc--register-connection)))) (defun erc-server-reconnect () "Reestablish the current IRC connection. @@ -851,7 +855,7 @@ erc-process-sentinel cproc (process-status cproc) event erc-server-quitting)) (if (string-match "^open" event) ;; newly opened connection (no wait) - (erc-login) + (erc--register-connection) ;; assume event is 'failed (erc-with-all-buffers-of-server cproc nil (setq erc-server-connected nil)) -- 2.37.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Add-non-IRCv3-SASL-module-to-ERC.patch >From 27242c8becae2962972c2a6cfdf4de44d276184b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Sep 2022 01:37:13 -0700 Subject: [PATCH 5/5] Add non-IRCv3 SASL module to ERC * lisp/erc/erc-compat.el (erc-compat--sasl-scram-construct-gs2-header, erc-compat--sasl-scram-client-first-message, erc-compat--sasl-scram--client-final-message): Add minimal authorization support via own variant of `sasl-scram--client-final-message' and supporting sasl-scram-rfc functions introduced in Emacs 29. * lisp/erc/erc.el (erc-modules): Add `sasl'. * lisp/erc/erc-sasl.el: New file. * test/lisp/erc/erc-sasl-tests.el: New file. * test/lisp/erc/erc-scenarios-sasl.el: New file. * test/lisp/erc/resources/sasl/plain-failed.eld: New file. * test/lisp/erc/resources/sasl/plain.eld: New file. * test/lisp/erc/resources/sasl/scram-sha-1.eld: New file. * test/lisp/erc/resources/sasl/scram-sha-256.eld: New file. * test/lisp/erc/resources/sasl/external.eld: New file. --- doc/misc/erc.texi | 138 +++++- lisp/erc/erc-compat.el | 104 +++++ lisp/erc/erc-sasl.el | 396 ++++++++++++++++++ lisp/erc/erc.el | 1 + test/lisp/erc/erc-sasl-tests.el | 302 +++++++++++++ test/lisp/erc/erc-scenarios-sasl.el | 161 +++++++ test/lisp/erc/resources/sasl/external.eld | 33 ++ test/lisp/erc/resources/sasl/plain-failed.eld | 16 + test/lisp/erc/resources/sasl/plain.eld | 35 ++ test/lisp/erc/resources/sasl/scram-sha-1.eld | 47 +++ .../lisp/erc/resources/sasl/scram-sha-256.eld | 47 +++ 11 files changed, 1279 insertions(+), 1 deletion(-) create mode 100644 lisp/erc/erc-sasl.el create mode 100644 test/lisp/erc/erc-sasl-tests.el create mode 100644 test/lisp/erc/erc-scenarios-sasl.el create mode 100644 test/lisp/erc/resources/sasl/external.eld create mode 100644 test/lisp/erc/resources/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/sasl/plain.eld create mode 100644 test/lisp/erc/resources/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/sasl/scram-sha-256.eld diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9..80b4171cdb 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -78,6 +78,7 @@ Top Advanced Usage * Connecting:: Ways of connecting to an IRC server. +* SASL:: Authenticating via SASL. * Sample Configuration:: An example configuration file. * Options:: Options that are available for ERC. @@ -478,6 +479,10 @@ Modules @item ring Enable an input history +@cindex modules, sasl +@item sasl +Enable SASL authentication + @cindex modules, scrolltobottom @item scrolltobottom Scroll to the bottom of the buffer @@ -525,6 +530,7 @@ Advanced Usage @menu * Connecting:: Ways of connecting to an IRC server. +* SASL:: Authenticating via SASL * Sample Configuration:: An example configuration file. * Options:: Options that are available for ERC. @end menu @@ -842,6 +848,7 @@ Connecting @noindent For details, @pxref{Top,,auth-source, auth, Emacs auth-source Library}. +@anchor{ERC auth-source functions} @defopt erc-auth-source-server-function @end defopt @defopt erc-auth-source-services-function @@ -854,7 +861,8 @@ Connecting @code{:user} is the ``desired'' nickname rather than the current one. Generalized names, like @code{:user} and @code{:host}, are always used over back-end specific ones, like @code{:login} or @code{:machine}. -ERC expects a string to use as the secret or nil, if the search fails. +ERC expects a string to use as the secret or @code{nil}, if the search +fails. @findex erc-auth-source-search The default value for all three options is the function @@ -915,6 +923,134 @@ Connecting make the most sense, but any reasonably printable object is acceptable. +@node SASL +@section Authenticating via SASL +@cindex SASL + +@strong{Warning:} ERC's SASL offering is currently limited by a lack +of support for proper IRCv3 capability negotiation. In most cases, +this shouldn't affect your ability to authenticate. If you run into +trouble, please contact us (@pxref{Getting Help and Reporting Bugs}). + +Regardless of the mechanism or the network, you'll likely have to be +registered before first use. Please refer to the network's own +instructions for details. If you're new to IRC and using a bouncer, +know that you almost certainly won't be needing SASL for the +@samp{client -> bouncer} connection. + +Note that @code{sasl} is a ``local'' ERC module. This means invoking +@code{erc-sasl-mode} manually or calling @code{erc-update-modules} +won't do any good. Instead, simply add @code{sasl} to +@code{erc-modules} (or @code{let}-bind it while calling +@code{erc-tls}), and SASL will be enabled for the current connection. +But before that, please explore all custom options pertaining to your +chosen mechanism. + +@defopt erc-sasl-mechanism +The name of an SASL subprotocol type as a @emph{lowercase} symbol. + +@var{plain} and @var{scram} (``password-based''): + +@indentedblock +Here, ``password'' refers to your account password, which is usually +your @samp{NickServ} password. This often differs from any connection +(server) password given to @code{erc-tls} via its @code{:password} +parameter. To make this work, customize both @code{erc-sasl-user} and +@code{erc-sasl-password} or bind them when invoking @code{erc-tls}. +@end indentedblock + +@var{external} (via Client TLS Certificate): + +@indentedblock +You'll want to specify the @code{:client-certificate} param when +opening a new connection, which is typically done by calling +@code{emacs-tls}. But before that, ensure you've registered your +fingerprint with the network. The fingerprint is usually a SHA1 or +SHA256 digest in either "normalized" or "openssl" forms. The first is +lowercase without delims (@samp{deadbeef}) and the second uppercase +with colon seps (@samp{DE:AD:BE:EF}). + +Additional considerations: +@enumerate +@item +There's no reason to send your password after registering. +@item +Most IRCds will allow you to authenticate with a client cert but +without the hassle of SASL (meaning you may not need this module). +@item +Technically, @var{EXTERNAL} merely indicates that an out-of-band mode +of authentication is in effect (being deferred to), so depending on +the specific application or service, there's an off chance client +certs aren't involved. +@end enumerate +@end indentedblock + +@var{ecdsa-nist256p-challenge}: + +@indentedblock +This mechanism is quite complicated and currently requires the +external @samp{openssl} executable, so please use something else if at +all possible. Ignoring that, specify your key file (e.g., +@samp{~/pki/mykey.pem}) as the value of @code{erc-sasl-password}, and +then configure your network settings. On servers running Atheme +services, you can add your public key with @samp{NickServ} like so: + +@example +ERC> /msg NickServ set property \ + pubkey AgGZmlYTUjJlea/BVz7yrjJ6gysiAPaQxzeUzTH4hd5j + +@end example +(You may be able to omit the @samp{property} subcommand.) +@end indentedblock + +@end defopt + +@defopt erc-sasl-user +This should be your network account name, typically the same one +registered with nickname services. Specify this when your +@samp{NickServ} account name differs from the nick you're connecting +with. +@end defopt + +@defopt erc-sasl-password +For ``password-based'' mechanisms, ERC sends any nonempty string as +the authentication password. + +If you instead give a non-@code{nil} symbol, like @samp{Libera.Chat}, +ERC will use it for the @code{:host} field in an auth-source query. +Actually, the same goes for when this option is @code{nil} but an +explicit session ID is already on file (@pxref{Network Identifier}). +For all such queries, ERC specifies the value of @code{erc-sasl-user} +for the @code{:user} (@code{:login}) param. Keep in mind that none of +this matters unless @code{erc-sasl-auth-source-function} holds a +function (it's @code{nil} by default). + +Otherwise, if you set this option to @code{nil} (or the empty string) +or if an auth-source lookup has failed, ERC will try a non-@code{nil} +``server password'', likely whatever you gave as the @var{password} +argument to @code{erc-tls}. This fallback behavior may change, +however, so please don't rely on it. As a last resort, ERC will +prompt you for input. + +Also, if your mechanism is @code{ecdsa-nist256p-challenge}, this +option should instead hold the file name of your key. +@end defopt + +@defopt erc-sasl-auth-source-function +This is nearly identical to the other ERC @samp{auth-source} function +options (@pxref{ERC auth-source functions}) except that the default +value here is @code{nil}, meaning you have to set it to something like +@code{erc-auth-source-search} for queries to be performed. +@end defopt + +@defopt erc-sasl-authzid +In the rarest of circumstances, a network may want you to specify a +specific role or assume an alternate identity. In most cases, this +happens because the server is buggy or misconfigured. If you suspect +such a thing, please contact your network operator. Otherwise, just +leave this set to @code{nil}. +@end defopt + @node Sample Configuration @section Sample Configuration diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f1352..bc3e1dcfc6 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -157,6 +157,110 @@ erc-subseq res)))))) +;;;; SASL + +(declare-function sasl-step-data "sasl" (step)) +(declare-function sasl-error "sasl" (datum)) +(declare-function sasl-client-property "sasl" (client property)) +(declare-function sasl-client-set-property "sasl" (client property value)) +(declare-function sasl-mechanism-name "sasl" (mechanism)) +(declare-function sasl-client-name "sasl" (client)) +(declare-function sasl-client-mechanism "sasl" (client)) +(declare-function sasl-read-passphrase "sasl" (prompt)) +(declare-function sasl-unique-id "sasl" nil) +(declare-function decode-hex-string "hex-util" (string)) +(declare-function rfc2104-hash "rfc2104" (hash block-length hash-length + key text)) +(declare-function sasl-scram--client-first-message-bare "sasl-scram-rfc" + (client)) +(declare-function cl-mapcar "cl-lib" (cl-func cl-x &rest cl-rest)) + +(defun erc-compat--sasl-scram-construct-gs2-header (client) + ;; The "n," means the client doesn't support channel binding, and + ;; the trailing comma is included as per RFC 5801. + (let ((authzid (sasl-client-property client 'authenticator-name))) + (concat "n," (and authzid "a=") authzid ","))) + +(defun erc-compat--sasl-scram-client-first-message (client _step) + (let ((c-nonce (sasl-unique-id))) + (sasl-client-set-property client 'c-nonce c-nonce)) + (concat (erc-compat--sasl-scram-construct-gs2-header client) + (sasl-scram--client-first-message-bare client))) + +;; This is `sasl-scram--client-final-message' from sasl-scram-rfc, +;; with the NO-LINE-BREAK argument of `base64-encode-string' set to t +;; because https://www.rfc-editor.org/rfc/rfc5802#section-2.1 says: +;; +;; > The use of base64 in SCRAM is restricted to the canonical form +;; > with no whitespace. +;; +;; Unfortunately, advising `base64-encode-string' won't work +;; because the byte compiler precomputes the result when all inputs +;; are constants, as they are in the unpatched version. +;; +;; The only other substantial change is the addition of authz support. +;; This can be dropped if adopted by Emacs 29 and `compat'. Changes +;; proposed for 29 are marked with a "; *n", comment below. See older +;; versions of lisp/erc/erc-v3-sasl.el (bug#49860) if needing a true +;; side-by-side diff. This also inlines the internal function +;; `sasl-scram--client-first-message-bare' and takes various liberties +;; with formatting. + +(defun erc-compat--sasl-scram--client-final-message + (hash-fun block-length hash-length client step) + (unless (string-match + "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)" + (sasl-step-data step)) + (sasl-error "Unexpected server response")) + (let* ((hmac-fun + (lambda (text key) + (decode-hex-string + (rfc2104-hash hash-fun block-length hash-length key text)))) + (step-data (sasl-step-data step)) + (nonce (match-string 1 step-data)) + (salt-base64 (match-string 2 step-data)) + (iteration-count (string-to-number (match-string 3 step-data))) + (c-nonce (sasl-client-property client 'c-nonce)) + (cbind-input + (if (string-prefix-p c-nonce nonce) + (erc-compat--sasl-scram-construct-gs2-header client) ; *1 + (sasl-error "Invalid nonce from server"))) + (client-final-message-without-proof + (concat "c=" (base64-encode-string cbind-input t) "," ; *2 + "r=" nonce)) + (password + (sasl-read-passphrase + (format "%s passphrase for %s: " + (sasl-mechanism-name (sasl-client-mechanism client)) + (sasl-client-name client)))) + (salt (base64-decode-string salt-base64)) + (string-xor (lambda (a b) + (apply #'unibyte-string (cl-mapcar #'logxor a b)))) + (salted-password (let ((digest (concat salt (string 0 0 0 1))) + (xored nil)) + (dotimes (_i iteration-count xored) + (setq digest (funcall hmac-fun digest password)) + (setq xored (if (null xored) + digest + (funcall string-xor xored + digest)))))) + (client-key (funcall hmac-fun "Client Key" salted-password)) + (stored-key (decode-hex-string (funcall hash-fun client-key))) + (auth-message (concat "n=" (sasl-client-name client) + ",r=" c-nonce "," step-data + "," client-final-message-without-proof)) + (client-signature (funcall hmac-fun + (encode-coding-string auth-message 'utf-8) + stored-key)) + (client-proof (funcall string-xor client-key client-signature)) + (client-final-message + (concat client-final-message-without-proof "," + "p=" (base64-encode-string client-proof t)))) ; *3 + (sasl-client-set-property client 'auth-message auth-message) + (sasl-client-set-property client 'salted-password salted-password) + client-final-message)) + + ;;;; Misc 29.1 (defmacro erc-compat--with-memoization (table &rest forms) diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el new file mode 100644 index 0000000000..f36a305247 --- /dev/null +++ b/lisp/erc/erc-sasl.el @@ -0,0 +1,396 @@ +;;; erc-sasl.el --- SASL for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2022 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 . + +;;; Commentary: + +;; This "non-IRCv3" implementation resembles many others that have +;; surfaced over the years, the first possibly being: +;; +;; https://lists.gnu.org/archive/html/erc-discuss/2012-02/msg00001.html +;; +;; See options and Info manual for usage. +;; +;; TODO: +;; +;; - Find a way to obfuscate the password in memory (via something +;; like `auth-source--obfuscate'); it's currently visible in +;; backtraces. +;; +;; - Implement a proxy mechanism that chooses the strongest available +;; mechanism for you. Requires CAP 3.2 (see bug#49860). + +;;; Code: +(require 'erc) +(require 'rx) +(require 'sasl) +(require 'sasl-scram-rfc) +(require 'sasl-scram-sha256 nil t) + +(defgroup erc-sasl nil + "SASL for ERC." + :group 'erc + :package-version '(ERC . "5.4")) ; FIXME increment on next release + +(defcustom erc-sasl-mechanism nil + "SASL mechanism to connect with. +Note that any value other than nil or `external' likely requires +`erc-sasl-user' and `erc-sasl-password'." + :type '(choice (const nil) + (const plain) + (const external) + (const scram-sha-1) + (const scram-sha-256) + (const scram-sha-512) + (const ecdsa-nist256p-challenge))) + +(defcustom erc-sasl-user nil + "Optional account username to send when authenticating. +This is also referred to as the authentication identity, or +\"authcid\". When nil, applicable mechanisms will use the +session's current nick." + :type '(choice string (const nil))) + +(defcustom erc-sasl-password nil + "Optional account password to send when authenticating. +When the value is a string, ERC uses it unconditionally for most +mechanisms (see below). As a special case, when the value is a +non-nil symbol, ERC uses it as the value of the `:host' field in +an auth-source query, provided `erc-sasl-auth-source-function' is +set to a function. When nil, ERC will try a non-nil \"session +password\", likely one given as the `:password' argument to +`erc-tls'. As a last resort, ERC will prompt the user for input. + +Note that when `erc-sasl-mechanism' is set to +`ecdsa-nist256p-challenge', this option should hold the file name +of the key, which is typically in PEM format." + :type '(choice (const nil) string symbol)) + +(defcustom erc-sasl-auth-source-function nil + "Function to query auth-source for an SASL password. +Called with keyword params known to `auth-source-search', which +may include a non-nil `erc-sasl-user' for the `:user' field +and a non-nil `erc-sasl-password' for the `:host' field, when +the latter option is a symbol instead of a string. In return, +ERC expects a string to send as the SASL password, or nil, to +move on to the next approach, as described in the doc string for +the option `erc-sasl-password'. See info node `(erc) +Connecting' for details on ERC's auth-source integration." + :type '(choice (const erc-auth-source-search) + (const nil) + function)) + +(defcustom erc-sasl-authzid nil + "SASL authorization identity, likely unneeded for everyday use." + :type '(choice (const nil) string)) + + +;; Analogous to what erc-backend does to persist opening params. +(defvar-local erc-sasl--options nil) + +;; Session-local (server buffer) SASL subproto state +(defvar-local erc-sasl--state nil) + +(cl-defstruct erc-sasl--state + "Holder for client object and subproto state." + (client nil :type vector) + (step nil :type vector) + (pending nil :type string)) + +(defun erc-sasl--read-password (prompt) + "Return configured option or server password. +PROMPT is passed to `read-passwd' if necessary." + (let* ((pass (alist-get 'password erc-sasl--options)) + (found + (or (and (stringp pass) (not (string-empty-p pass)) pass) + (and erc-sasl-auth-source-function + (let ((user (alist-get 'user erc-sasl--options)) + (host (or pass + (erc-networks--id-given erc-networks--id)))) + (apply erc-sasl-auth-source-function + `(,@(and user (list :user user)) + ,@(and host (list :host (symbol-name host))))))) + erc-session-password))) + (if found + (copy-sequence found) + (read-passwd prompt)))) + +(defun erc-sasl--plain-response (client steps) + (let ((sasl-read-passphrase #'erc-sasl--read-password)) + (sasl-plain-response client steps))) + +(declare-function erc-compat--sasl-scram--client-final-message "erc-compat" + (hash-fun block-length hash-length client step)) + +(defun erc-sasl--scram-sha-hack-client-final-message (&rest args) + ;; In the future (29+), we'll hopefully be able to call + ;; `sasl-scram--client-final-message' directly + (require 'erc-compat) + (let ((sasl-read-passphrase #'erc-sasl--read-password)) + (apply #'erc-compat--sasl-scram--client-final-message args))) + +(defun erc-sasl--scram-sha-1-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message 'sha1 64 20 client step)) + +(defun erc-sasl--scram-sha-256-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message 'sasl-scram-sha256 64 32 + client step)) + +(defun erc-sasl--scram-sha512 (object &optional start end binary) + (secure-hash 'sha512 object start end binary)) + +(defun erc-sasl--scram-sha-512-client-final-message (client step) + (erc-sasl--scram-sha-hack-client-final-message #'erc-sasl--scram-sha512 + 128 64 client step)) + +(defun erc-sasl--scram-sha-512-authenticate-server (client step) + (sasl-scram--authenticate-server #'erc-sasl--scram-sha512 + 128 64 client step)) + +(defun erc-sasl--ecdsa-first (client _step) + "Return CLIENT name." + (sasl-client-name client)) + +;; FIXME do this with gnutls somehow +(defun erc-sasl--ecdsa-sign (client step) + "Return signed challenge for CLIENT and current STEP." + (let ((challenge (sasl-step-data step))) + (with-temp-buffer + (set-buffer-multibyte nil) + (insert challenge) + (call-process-region (point-min) (point-max) + "openssl" 'delete t nil "pkeyutl" "-inkey" + (sasl-client-property client 'ecdsa-keyfile) + "-sign") + (buffer-string)))) + +(pcase-dolist + (`(,name . ,steps) + '(("PLAIN" + erc-sasl--plain-response) + ("EXTERNAL" + ignore) + ("SCRAM-SHA-1" + erc-compat--sasl-scram-client-first-message + erc-sasl--scram-sha-1-client-final-message + sasl-scram-sha-1-authenticate-server) + ("SCRAM-SHA-256" + erc-compat--sasl-scram-client-first-message + erc-sasl--scram-sha-256-client-final-message + sasl-scram-sha-256-authenticate-server) + ("SCRAM-SHA-512" + erc-compat--sasl-scram-client-first-message + erc-sasl--scram-sha-512-client-final-message + erc-sasl--scram-sha-512-authenticate-server) + ("ECDSA-NIST256P-CHALLENGE" + erc-sasl--ecdsa-first + erc-sasl--ecdsa-sign))) + (let ((feature (intern (concat "erc-sasl-" (downcase name))))) + (put feature 'sasl-mechanism (sasl-make-mechanism name steps)) + (provide feature))) + +(cl-defgeneric erc-sasl--create-client (mechanism) + "Create and return a new SASL client object for MECHANISM." + (let ((sasl-mechanism-alist (copy-sequence sasl-mechanism-alist)) + (sasl-mechanisms sasl-mechanisms) + (name (upcase (symbol-name mechanism))) + (feature (intern (concat "erc-sasl-" (symbol-name mechanism)))) + client) + (setf (alist-get name sasl-mechanism-alist nil nil #'equal) `(,feature)) + (cl-pushnew name sasl-mechanisms :test #'equal) + (setq client (sasl-make-client (sasl-find-mechanism `(,name)) + (or (alist-get 'user erc-sasl--options) + (erc-downcase (erc-current-nick))) + "N/A" "N/A")) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) + client)) + +(cl-defmethod erc-sasl--create-client ((_m (eql plain))) + "Create and return a new PLAIN client object." + ;; https://tools.ietf.org/html/rfc4616#section-2. + (let* ((sans (remq (assoc "PLAIN" sasl-mechanism-alist) + sasl-mechanism-alist)) + (sasl-mechanism-alist (cons '("PLAIN" erc-sasl-plain) sans)) + (authc (or (alist-get 'user erc-sasl--options) + (erc-downcase (erc-current-nick)))) + (port (if (numberp erc-session-port) + (number-to-string erc-session-port) + "0")) + ;; In most cases, `erc-server-announced-name' won't be known. + (host (or erc-server-announced-name erc-session-server)) + (mech (sasl-find-mechanism '("PLAIN"))) + (client (sasl-make-client mech authc port host))) + (sasl-client-set-property client 'authenticator-name + (alist-get 'authzid erc-sasl--options)) + client)) + +(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-256))) + "Create and return a new SCRAM-SHA-256 client." + (unless (featurep 'sasl-scram-sha256) + (user-error "SASL mechanism %s unsupported" m)) + (cl-call-next-method)) + +(cl-defmethod erc-sasl--create-client ((m (eql scram-sha-512))) + "Create and return a new SCRAM-SHA-512 client." + (unless (featurep 'sasl-scram-sha256) + (user-error "SASL mechanism %s unsupported" m)) + (cl-call-next-method)) + +(cl-defmethod erc-sasl--create-client ((_ (eql ecdsa-nist256p-challenge))) + "Create and return a new ECDSA-NIST256P-CHALLENGE client." + (unless (executable-find "openssl") + (user-error "Could not find openssl command-line utility")) + (let ((keyfile (cdr (assq 'password erc-sasl--options)))) + (unless (and keyfile (file-exists-p keyfile)) + (user-error "`erc-sasl-password' does not point to ECDSA keyfile")) + (let ((client (cl-call-next-method))) + (sasl-client-set-property client 'ecdsa-keyfile keyfile) + client))) + +;; This stands alone because it's also used by bug#49860 +(defun erc-sasl--init () + (setq erc-sasl--state (make-erc-sasl--state) + erc-sasl--options `((user . ,erc-sasl-user) + (password . ,erc-sasl-password) + (mechanism . ,erc-sasl-mechanism) + (authzid . ,erc-sasl-authzid)))) + +(defun erc-sasl--mechanism-offered-p (offered) + "Return non-nil when OFFERED appears among a list of mechanisms." + (string-match-p (rx-to-string + `(: (| bot ",") + ,(symbol-name + (alist-get 'mechanism erc-sasl--options)) + (| eot ","))) + (downcase offered))) + +(defun erc-sasl--authenticate-handler (_proc parsed) + "Handle PARSED `erc-response' from server. +Maybe transition to next state." + (if-let* ((response (car (erc-response.command-args parsed))) + ((= 400 (length response)))) + (cl-callf (lambda (s) (concat s response)) + (erc-sasl--state-pending erc-sasl--state)) + (cl-assert response t) + (when (string= "+" response) + (setq response "")) + (setf response (base64-decode-string + (concat (erc-sasl--state-pending erc-sasl--state) response)) + (erc-sasl--state-pending erc-sasl--state) nil) + ;; The server is done sending, so our turn + (let ((client (erc-sasl--state-client erc-sasl--state)) + (step (erc-sasl--state-step erc-sasl--state)) + data) + (when step + (sasl-step-set-data step response)) + (setq step (setf (erc-sasl--state-step erc-sasl--state) + (sasl-next-step client step)) + data (sasl-step-data step)) + (when (string= data "") + (setq data nil)) + (when data + (setq data (base64-encode-string data t))) + ;; No need for : because no spaces (right?) + (erc-server-send (concat "AUTHENTICATE " (or data "+")))))) + +(erc-define-catalog + 'english + '((s902 . "ERR_NICKLOCKED nick %n unavailable: %s") + (s904 . "ERR_SASLFAIL (authentication failed) %s") + (s905 . "ERR SASLTOOLONG (credentials too long) %s") + (s906 . "ERR_SASLABORTED (authentication aborted) %s") + (s907 . "ERR_SASLALREADY (already authenticated) %s") + (s908 . "RPL_SASLMECHS (unsupported mechanism %m) %s"))) + +(define-erc-module sasl nil + "Non-IRCv3 SASL support for ERC. +This doesn't solicit or validate a suite of supported mechanisms." + ;; See bug#49860 for a full, CAP 3.2-aware implementation, currently + ;; a WIP as of ERC 5.5. + ((unless erc--target + (add-hook 'erc-server-AUTHENTICATE-functions + #'erc-sasl--authenticate-handler 0 t) + (erc-sasl--init) + (let* ((mech (alist-get 'mechanism erc-sasl--options)) + (client (erc-sasl--create-client mech))) + (unless client + (erc-display-error-notice nil (format "Unknown mechanism: %s" mech)) + (erc-error "Unknown mechanism: %s" mech)) + (setf (erc-sasl--state-client erc-sasl--state) client)))) + ((remove-hook 'erc-server-AUTHENTICATE-functions + #'erc-sasl--authenticate-handler t) + (kill-local-variable 'erc-sasl--options)) + 'local) + +;; FIXME use generic mechanism instead of hooks after bug#49860. +(define-erc-response-handler (AUTHENTICATE) + "Maybe authenticate to server." nil) + +(defun erc-sasl--destroy (proc) + (run-hook-with-args 'erc-quit-hook proc) + (delete-process proc) + (erc-error "Disconnected from %s; please review SASL settings" proc)) + +(define-erc-response-handler (902) + "Handle a ERR_NICKLOCKED response." nil + (erc-display-message parsed '(notice error) 'active 's902 + ?n (car (erc-response.command-args parsed)) + ?s (erc-response.contents parsed)) + (erc-sasl--destroy proc)) + +(define-erc-response-handler (903) + "Handle a RPL_SASLSUCCESS response." nil + (when erc-sasl-mode + (unless erc-server-connected + (erc-server-send "CAP END"))) + (erc-handle-unknown-server-response proc parsed)) + +(define-erc-response-handler (907) + "Handle a RPL_SASLALREADY response." nil + (erc-display-message parsed '(notice error) 'active 's907 + ?s (erc-response.contents parsed))) + +(define-erc-response-handler (904 905 906) + "Handle various SASL-related error responses." nil + (erc-display-message parsed '(notice error) 'active + (intern (format "s%s" (erc-response.command parsed))) + ?s (erc-response.contents parsed)) + (erc-sasl--destroy proc)) + +(define-erc-response-handler (908) + "Handle a RPL_SASLALREADY response." nil + (erc-display-message parsed '(notice error) 'active 's908 + '?m (alist-get 'mechanism erc-sasl--options) + '?s (erc-response.contents parsed)) + (erc-sasl--destroy proc)) + +(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t))) + "Send speculative/pipelined CAP and AUTHENTICATE and hope for the best." + (erc-server-send "CAP REQ :sasl") + (erc-login) + (let* ((c (erc-sasl--state-client erc-sasl--state)) + (m (sasl-mechanism-name (sasl-client-mechanism c)))) + (erc-server-send (format "AUTHENTICATE %s" m)))) + +(provide 'erc-sasl) +;;; erc-sasl.el ends here +;; +;; Local Variables: +;; generated-autoload-file: "erc-loaddefs.el" +;; End: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 23649a5620..994504d72e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1871,6 +1871,7 @@ erc-modules (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) (const :tag "ring: Enable an input history" ring) + (const :tag "sasl: Enable SASL authentication" sasl) (const :tag "scrolltobottom: Scroll to the bottom of the buffer" scrolltobottom) (const :tag "services: Identify to Nickserv (IRC Services) automatically" diff --git a/test/lisp/erc/erc-sasl-tests.el b/test/lisp/erc/erc-sasl-tests.el new file mode 100644 index 0000000000..112303baf5 --- /dev/null +++ b/test/lisp/erc/erc-sasl-tests.el @@ -0,0 +1,302 @@ +;;; erc-sasl-tests.el --- Tests for erc-sasl. -*- lexical-binding:t -*- + +;; Copyright (C) 2020-2022 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(require 'erc-sasl) + +(ert-deftest erc-sasl--mechanism-offered-p () + (let ((erc-sasl--options '((mechanism . external)))) + (should (erc-sasl--mechanism-offered-p "foo,external")) + (should (erc-sasl--mechanism-offered-p "external,bar")) + (should (erc-sasl--mechanism-offered-p "foo,external,bar")) + (should-not (erc-sasl--mechanism-offered-p "fooexternal")) + (should-not (erc-sasl--mechanism-offered-p "externalbar")))) + +(ert-deftest erc-sasl--read-password () + (ert-info ("Explicit erc-sasl-password") + (let ((erc-sasl--options '((password . "foo")))) + (should (string= (erc-sasl--read-password nil) "foo")))) + + (ert-info ("Fallback to erc-session-password") + (let ((erc-session-password "bar") + (erc-networks--id (erc-networks--id-create nil))) + (should (string= (erc-sasl--read-password nil) "bar"))) + (let ((erc-session-password "bar") + (erc-sasl--options '((user . "tester") (password))) + (erc-networks--id (erc-networks--id-create nil))) + (should (string= (erc-sasl--read-password nil) "bar")))) + + (let* ((entries (list + "machine FSF.chat port 6697 user bob password sesame" + ;; This must come *after* ^, else *1 (below) always passes + "machine GNU/chat port 6697 user bob password spam" + "machine MyHost port irc password 123")) + (netrc-file (make-temp-file "auth-source-test" nil nil + (mapconcat 'identity entries "\n"))) + (auth-sources (list netrc-file)) + (erc-session-server "irc.gnu.org") + (erc-session-port 6697) + (erc-networks--id (erc-networks--id-create nil)) + ;; + (erc-sasl-auth-source-function #'erc--auth-source-search) + erc-server-announced-name ; too early + auth-source-do-cache) + + (unwind-protect + (ert-info ("Auth source") + + (ert-info ("Symbol as password specifies machine") + (let ((erc-sasl--options '((user . "bob") + (password . FSF.chat))) + (erc-networks--id (make-erc-networks--id))) + (should (string= (erc-sasl--read-password nil) "sesame")))) + + (ert-info ("Use session ID when password empty") ; *1 + (let ((erc-sasl--options '((user . "bob") (password))) + (erc-networks--id (erc-networks--id-create 'GNU/chat))) + (should (string= (erc-sasl--read-password nil) "spam"))))) + + (delete-file netrc-file)) + + (ert-info ("Prompt when search fails and server password null") + (let ((erc-sasl-auth-source-function #'ignore)) + (should (string= (ert-simulate-keys "baz\r" + (erc-sasl--read-password "pwd:")) + "baz")))))) + +(ert-deftest erc-sasl-create-client--plain () + (let* ((erc-session-password "password123") + (erc-server-current-nick "tester") + (erc-session-port 1667) + (erc-session-server "localhost") + (client (erc-sasl--create-client 'plain)) + (result (sasl-next-step client nil))) + (should (equal (format "%S" [erc-sasl--plain-response + "\0tester\0password123"]) + (format "%S" result))) + (should (string= (sasl-step-data result) "\0tester\0password123")) + (should-not (sasl-next-step client result))) + (should (equal (assoc-default "PLAIN" sasl-mechanism-alist) '(sasl-plain)))) + +(ert-deftest erc-sasl-create-client--external () + (let* ((erc-server-current-nick "tester") + (client (erc-sasl--create-client 'external)) + (result (sasl-next-step client nil))) + (should (equal (format "%S" [ignore nil]) (format "%S" result))) + (should-not (sasl-step-data result)) + (should-not (sasl-next-step client result))) + (should-not (member "EXTERNAL" sasl-mechanisms)) + (should-not (assoc-default "EXTERNAL" sasl-mechanism-alist))) + +(ert-deftest erc-sasl-create-client--scram-sha-1 () + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (erc-sasl--options '((authzid . "jilles"))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-1)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb," + "s=5mJO6d4rjCnsBU1X," + "i=4096")) + (req (concat "c=bixhPWppbGxlcyw=," + "r=c5RqLCZy0L4fGkKAZ0hujFBsXQoKcivqCw9iDZPSpb," + "p=OVUhgPu8wEm2cDoVLfaHzVUYPWU="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-1-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=ZWR23c9MJir0ZgfGf5jEtLOn6Ng=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-256 () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (erc-sasl--options '((authzid . "jilles"))) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-256)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,a=jilles,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3," + "s=MTk2M2VkMzM5ZmU0NDRiYmI0MzIyOGVhN2YwNzYwNmI=," + "i=4096")) + (req (concat + "c=bixhPWppbGxlcyw=," + "r=c5RqLCZy0L4fGkKAZ0hujFBse697140729d8445fb95ec94ceacb14b3," + "p=1vDesVBzJmv0lX0Ae1kHFtdVHkC6j4gISKVqaR45HFg="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-256-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=gUePTYSZN9xgcE06KSyKO9fUmSwH26qifoapXyEs75s=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-256--no-authzid () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-256)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37," + "s=ZTg1MmE1YmFhZGI1NDcyMjk3NzYwZmRjZDM3Y2I1OTM=," + "i=4096")) + (req (concat + "c=biws," + "r=c5RqLCZy0L4fGkKAZ0hujFBsd4067f0afdb54c3dbd4fe645b84cae37," + "p=LP4sjJrjJKp5qTsARyZCppXpKLu4FMM284hNESPvGhI="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format "%S" + `[erc-sasl--scram-sha-256-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp "v=847WXfnmReGyE1qlq1And6R4bPBNROTZ7EMS/QrJtUM=")) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(ert-deftest erc-sasl-create-client--scram-sha-512--no-authzid () + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha512")) + (let* ((erc-server-current-nick "jilles") + (erc-session-password "sesame") + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (client (erc-sasl--create-client 'scram-sha-512)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (let ((req "n,,n=jilles,r=c5RqLCZy0L4fGkKAZ0hujFBs")) + (should (equal (format "%S" + `[erc-compat--sasl-scram-client-first-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's initial response") + (let ((resp (concat + "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6," + "s=YzMzOWZiY2U0YzcwNDA0M2I4ZGE2M2ZjOTBjODExZTM=," + "i=4096")) + (req (concat + "c=biws," + "r=c5RqLCZy0L4fGkKAZ0hujFBs54c592745ce14e559fcc3f27b15464f6," + "p=vMBb9tKxFAfBtel087/GLbo4objAIYr1wM+mFv/jYLKXE" + "NUF0vynm81qQbywQE5ScqFFdAfwYMZq/lj4s0V1OA=="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should (equal (format + "%S" `[erc-sasl--scram-sha-512-client-final-message + ,req]) + (format "%S" step))) + (should (string= (sasl-step-data step) req)))) + (ert-info ("Server's final message") + (let ((resp (concat "v=Va7NIvt8wCdhvxnv+bZriSxGoto6On5EVnRHO/ece8zs0" + "qpQassdqir1Zlwh3e3EmBq+kcSy+ClNCsbzBpXe/w=="))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + (should-not (sasl-step-data step))))) + (should (eq sasl-unique-id-function #'sasl-unique-id-function))) + +(defconst erc-sasl-tests-ecdsa-key-file " +-----BEGIN EC PARAMETERS----- +BggqhkjOPQMBBw== +-----END EC PARAMETERS----- +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIIJueQ3W2IrGbe9wKdOI75yGS7PYZSj6W4tg854hlsvmoAoGCCqGSM49 +AwEHoUQDQgAEAZmaVhNSMmV5r8FXPvKuMnqDKyIA9pDHN5TNMfiF3mMeikGgK10W +IRX9cyi2wdYg9mUUYyh9GKdBCYHGUJAiCA== +-----END EC PRIVATE KEY----- +") + +(ert-deftest erc-sasl-create-client-ecdsa () + (unless (executable-find "openssl") + (ert-skip "System lacks openssl")) + (ert-with-temp-file keyfile + :prefix "ecdsa_key" + :suffix ".pem" + :text erc-sasl-tests-ecdsa-key-file + (let* ((erc-server-current-nick "jilles") + (erc-sasl--options `((password . ,keyfile))) + (client (erc-sasl--create-client 'ecdsa-nist256p-challenge)) + (step (sasl-next-step client nil))) + (ert-info ("Client's initial request") + (should (equal (format "%S" [erc-sasl--ecdsa-first "jilles"]) + (format "%S" step))) + (should (string= (sasl-step-data step) "jilles"))) + (ert-info ("Server's initial response") + (let ((resp (concat "\0\1\2\3\4\5\6\7\10\11\12\13\14\15\16\17\20" + "\21\22\23\24\25\26\27\30\31\32\33\34\35\36\37"))) + (sasl-step-set-data step resp) + (setq step (sasl-next-step client step)) + ;; FIXME this is dumb + (should (<= 68 (length (sasl-step-data step)) 72)))) + (should-not (sasl-next-step client step))))) + +;;; erc-sasl-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-sasl.el b/test/lisp/erc/erc-scenarios-sasl.el new file mode 100644 index 0000000000..3ff7cc805d --- /dev/null +++ b/test/lisp/erc/erc-scenarios-sasl.el @@ -0,0 +1,161 @@ +;;; erc-scenarios-sasl.el --- SASL tests for ERC -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; This file is part of GNU Emacs. +;; +;; This program 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. +;; +;; This program 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 this program. If not, see +;; . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(declare-function sasl-client-name "sasl" (client)) + +(require 'erc-scenarios-common) +(require 'erc-sasl) + +(ert-deftest erc-scenarios-sasl--plain () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-d-linger-secs 0.5) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-mechanism 'plain) + (erc-sasl-password "password123") + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg")) + + (ert-info ("Notices received") + (with-current-buffer "ExampleOrg" + (funcall expect 10 "This server is in debug mode") + ;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0) + (should (string= erc-sasl-password "password123")))))) + +(ert-deftest erc-scenarios-sasl--external () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-d-linger-secs 0.5) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'external)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-mechanism 'external) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg")) + + (ert-info ("Notices received") + (with-current-buffer "ExampleOrg" + (funcall expect 10 "903 * Authentication successful") + (funcall expect 10 "This server is in debug mode"))))) + +(ert-deftest erc-scenarios-sasl--plain-fail () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-d-linger-secs 0.5) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-failed)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-password "wrong") + (erc-sasl-mechanism 'plain) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter)) + (buf nil)) + + (ert-info ("Connect") + (setq buf (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester")) + (let ((err (should-error + (with-current-buffer buf + (funcall expect 20 "Connection failed!"))))) + (should (string-search "please review" (cadr err))) + (with-current-buffer buf + (funcall expect 10 "Opening connection") + (funcall expect 20 "SASL authentication failed") + (should-not (erc-server-process-alive))))))) + +(defun erc-scenarios--common--sasl (mech) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "sasl") + (erc-d-linger-secs 0.5) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t mech)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'sasl erc-modules)) + (erc-sasl-password "sesame") + (erc-sasl-mechanism mech) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "jilles" + :full-name "jilles") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "jaguar")) + + (ert-info ("Notices received") + (with-current-buffer "jaguar" + (funcall expect 10 "Found your hostname") + (funcall expect 20 "marked as being away"))))) + +(ert-deftest erc-scenarios-sasl--scram-sha-1 () + :tags '(:expensive-test) + (let ((erc-sasl-authzid "jilles")) + (erc-scenarios--common--sasl 'scram-sha-1))) + +(ert-deftest erc-scenarios-sasl--scram-sha-256 () + :tags '(:expensive-test) + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (erc-scenarios--common--sasl 'scram-sha-256)) + +;;; erc-scenarios-sasl.el ends here diff --git a/test/lisp/erc/resources/sasl/external.eld b/test/lisp/erc/resources/sasl/external.eld new file mode 100644 index 0000000000..2cd237ec4d --- /dev/null +++ b/test/lisp/erc/resources/sasl/external.eld @@ -0,0 +1,33 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester")) + +((auth-req 3.2 "AUTHENTICATE EXTERNAL") + (0.0 ":irc.example.org CAP * ACK :sasl") + (0.0 "AUTHENTICATE +")) + +((auth-noop 3.2 "AUTHENTICATE +") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 3.2 "CAP END") + (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)") + (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.example.org 253 tester 0 :unregistered connections") + (0.0 ":irc.example.org 254 tester 0 :channels formed") + (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) diff --git a/test/lisp/erc/resources/sasl/plain-failed.eld b/test/lisp/erc/resources/sasl/plain-failed.eld new file mode 100644 index 0000000000..336700290c --- /dev/null +++ b/test/lisp/erc/resources/sasl/plain-failed.eld @@ -0,0 +1,16 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname") + (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 3.2 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org AUTHENTICATE +")) + +((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgB3cm9uZw==") + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 904 * :SASL authentication failed: Invalid account credentials")) + +((cap-end 3.2 "CAP END")) diff --git a/test/lisp/erc/resources/sasl/plain.eld b/test/lisp/erc/resources/sasl/plain.eld new file mode 100644 index 0000000000..9c6ce3feeb --- /dev/null +++ b/test/lisp/erc/resources/sasl/plain.eld @@ -0,0 +1,35 @@ +;; -*- mode: lisp-data; -*- +((cap-req 10 "CAP REQ :sasl")) +((nick 1 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname") + (0.0 ":irc.example.org CAP * ACK :sasl")) + +((authenticate-plain 3.2 "AUTHENTICATE PLAIN") + (0.0 ":irc.example.org AUTHENTICATE +")) + +((authenticate-gimme 3.2 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw==") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 3.2 "CAP END") + (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2021 09:06:42 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.example.org 005 tester AWAYLEN=200 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1 server(s)") + (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.example.org 253 tester 0 :unregistered connections") + (0.0 ":irc.example.org 254 tester 0 :channels formed") + (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) diff --git a/test/lisp/erc/resources/sasl/scram-sha-1.eld b/test/lisp/erc/resources/sasl/scram-sha-1.eld new file mode 100644 index 0000000000..49980e9e12 --- /dev/null +++ b/test/lisp/erc/resources/sasl/scram-sha-1.eld @@ -0,0 +1,47 @@ +;;; -*- mode: lisp-data -*- +((cap-req 5.2 "CAP REQ :sasl")) +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-1") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5MEw0ZkdrS0FaMGh1akZCcw==") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBTcGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng==")) + +((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlVZUFdVPQ==") + (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10.2 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 1.2 "MODE jilles +i") + (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/sasl/scram-sha-256.eld b/test/lisp/erc/resources/sasl/scram-sha-256.eld new file mode 100644 index 0000000000..74de9a23ec --- /dev/null +++ b/test/lisp/erc/resources/sasl/scram-sha-256.eld @@ -0,0 +1,47 @@ +;;; -*- mode: lisp-data -*- +((cap-req 5.2 "CAP REQ :sasl")) +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-256") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnM=") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNkYmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1kySTFPVE09LGk9NDA5Ng==")) + +((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJzZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3BwWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ==") + (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJKdFVNPQ==")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles jilles!jilles@localhost.stack.nl jilles :You are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10.2 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~jilles@127.0.0.1") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version InspIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHIJLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=rfc1459 CHANLIMIT=#:120 CHANMODES=IXbeg,k,BEFHJLfjl,AMNOQRSTcimnprstuz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=,ANOQRSTUacmnprz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=jaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=31 PREFIX=(Yqaohv)!~&@%+ REMOVE SAFELIST SECURELIST=60 SILENCE=32 STATUSMSG=!~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=11 USERMODES=,,s,BILRSWcghiorwz WATCH=30 :are supported by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 1.2 "MODE jilles +i") + (0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) -- 2.37.3 --=-=-=--