Re: bug#49860: 28.0.50; add IRCv3 building blocks to ERC
"J.P." <[email protected]> Sat, 01 Nov 2025 10:25:58 -0700
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
--=-=-= Content-Type: text/plain v4. [WIP] Add IRCv3 building blocks to ERC - Use advice instead of generics for alt response and subcmd handlers - Reverse dependency btwn erc-v3 and erc-sasl, move defs to latter [WIP] Make erc-insert-line overridable - Convert `erc--register-connection' to normal function + advice var [WIP] Add account slot to erc-server-user - Update account slot on 330 RPL_WHOISACCOUNT --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v3-v4.diff From f5bb315b02dc02e45d01b86c7aa75938d6ca17a5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 1 Nov 2025 00:56:06 -0700 Subject: [PATCH 00/14] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (14): [5.7] ; Remove some forward declarations from ERC tests [5.7] Preserve order of local ERC modules for activation [5.7] Set major-mode before updating modules in erc-open [5.7] Run mode hooks in ERC query buffers on reconnect [5.x] Add predicate to detect ERC module activation [WIP] Add erc--echo msg property for self messages [WIP] Make ERC response handling more flexible [WIP] Break up early ERC response processing [WIP] Clearly define erc-server-user info field as an alist [WIP] Add account slot to erc-server-user [WIP] Make updating last-message-time more flexible in ERC [WIP] Make erc-insert-line overridable [WIP] Fix some message display bugs in erc-backend [WIP] Add IRCv3 building blocks to ERC etc/ERC-NEWS | 31 + lisp/erc/erc-backend.el | 256 +- lisp/erc/erc-button.el | 28 +- lisp/erc/erc-common.el | 75 +- lisp/erc/erc-compat.el | 128 + lisp/erc/erc-goodies.el | 16 +- lisp/erc/erc-imenu.el | 8 +- lisp/erc/erc-sasl.el | 173 +- lisp/erc/erc-speedbar.el | 36 +- lisp/erc/erc-stamp.el | 15 +- lisp/erc/erc-track.el | 4 +- lisp/erc/erc-truncate.el | 4 +- lisp/erc/erc-v3.el | 2365 +++++++++++++++++ lisp/erc/erc.el | 240 +- test/lisp/erc/erc-fill-tests.el | 11 +- .../erc/erc-scenarios-join-display-context.el | 2 + test/lisp/erc/erc-scenarios-log.el | 6 +- test/lisp/erc/erc-scenarios-services-misc.el | 3 +- .../erc/erc-scenarios-v3-account-notify.el | 133 + test/lisp/erc/erc-scenarios-v3-sasl.el | 200 ++ test/lisp/erc/erc-scenarios-v3.el | 587 ++++ test/lisp/erc/erc-tests.el | 147 +- test/lisp/erc/erc-v3-tests.el | 1459 ++++++++++ test/lisp/erc/resources/erc-d/erc-d-tests.el | 5 +- .../erc/resources/erc-scenarios-common.el | 131 +- test/lisp/erc/resources/erc-tests-common.el | 2 +- .../account-notify/chghost-no-account-tag.eld | 77 + .../v3/account-notify/no-extended-join.eld | 50 + .../erc/resources/v3/away-notify/basic.eld | 63 + .../erc/resources/v3/cap-notify/basic.eld | 67 + .../erc/resources/v3/echo-message/basic.eld | 74 + .../erc/resources/v3/extended-join/basic.eld | 56 + .../erc/resources/v3/multi-prefix/basic.eld | 51 + .../erc/resources/v3/sasl/plain-failed.eld | 18 + .../resources/v3/sasl/plain-unsupported.eld | 7 + test/lisp/erc/resources/v3/sasl/plain.eld | 39 + .../erc/resources/v3/sasl/scram-sha-1.eld | 51 + .../erc/resources/v3/sasl/scram-sha-256.eld | 51 + .../erc/resources/v3/server-time/basic.eld | 57 + .../resources/v3/userhost-in-names/basic.eld | 59 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 42 files changed, 6752 insertions(+), 254 deletions(-) create mode 100644 lisp/erc/erc-v3.el create mode 100644 test/lisp/erc/erc-scenarios-v3-account-notify.el create mode 100644 test/lisp/erc/erc-scenarios-v3-sasl.el create mode 100644 test/lisp/erc/erc-scenarios-v3.el create mode 100644 test/lisp/erc/erc-v3-tests.el create mode 100644 test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld create mode 100644 test/lisp/erc/resources/v3/account-notify/no-extended-join.eld create mode 100644 test/lisp/erc/resources/v3/away-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/cap-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/echo-message/basic.eld create mode 100644 test/lisp/erc/resources/v3/extended-join/basic.eld create mode 100644 test/lisp/erc/resources/v3/multi-prefix/basic.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-unsupported.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-256.eld create mode 100644 test/lisp/erc/resources/v3/server-time/basic.eld create mode 100644 test/lisp/erc/resources/v3/userhost-in-names/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/rate-limited.eld Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index fb9768db803..9c70665b329 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -714,10 +714,12 @@ 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 () +(defvar erc--register-connection-function #'erc-login) + +(defun erc--register-connection () "Perform opening IRC protocol exchange with server." (run-hooks 'erc--server-post-connect-hook) - (erc-login)) + (funcall erc--register-connection-function)) (defvar erc--server-post-dial-function #'erc--server-propagate-failed-connection @@ -1671,9 +1673,63 @@ erc-handle-unknown-server-response " ")))) (erc-display-message parsed 'notice proc line))) -(eval-and-compile - (defconst erc--generic-response-handlers - '(JOIN 005 263 352 353 354 366 900 903 904 CAP))) +(defvar erc--response-function nil + "Alternate response handler currently running, if any.") + +(defun erc--ensure-response-function (handler-symbol) + "Add internal variable to CMD's response handler symbol via symbol property." + (unless (get handler-symbol 'erc--response-function) + (set (put handler-symbol 'erc--response-function + (make-symbol (concat "erc--" ; prefer double-hyphenated prefix + (substring (symbol-name handler-symbol) 4) + "-function"))) + handler-symbol))) + +(defun erc--tidy-response-function (handler-symbol) + "Remove symbol property from HANDLER-SYMBOL if no advice remains." + (let ((sym (get handler-symbol 'erc--response-function))) + (unless (or (null sym) (catch 'found + (erc-buffer-filter + (lambda () + (unless (eq (symbol-value sym) handler-symbol) + (throw 'found t)))))) + (cl-callf (lambda (tail) + (let ((out ())) + (while-let ((key (pop tail)) + (val (pop tail))) + (unless (eq key 'erc--response-function) + (setq out `(,val ,key ,@out)))) + (nreverse out))) + (symbol-plist handler-symbol))))) + +(defmacro erc--set-up-response-function (cmd test how function &optional depth) + "If TEST evaluates non-nil at runtime, add advice to CMD's response handler. +If TEST evaluates to nil, remove it. However, if TEST is the literal +symbol nil, only do one or the other, removing it if HOW is also nil. +Use a depth of 50 for adding if DEPTH is unspecified." + (declare (indent 2)) + (let* ((handler-symbol (intern (concat "erc-server-" (erc--cmd-to-str cmd)))) + (place `(local (get ',handler-symbol + 'erc--response-function)))) + (macroexp-let2 nil function-symbol function + (let ((add-form `(progn + (erc--ensure-response-function #',handler-symbol) + (add-function ,how ,place ,function-symbol + '((depth . ,(or depth 50)))))) + (remove-form `((remove-function ,place ,function-symbol) + (erc--tidy-response-function #',handler-symbol)))) + `(unless erc--target + ,@(cond (test `((if ,test ,add-form ,@remove-form))) + (how (macroexp-unprogn add-form)) + (t remove-form))))))) + +(defmacro erc--add-response-function (cmd how function &optional depth) + "Call `erc--set-up-response-function' with CMD, HOW, FUNCTION, and DEPTH." + `(erc--set-up-response-function ,cmd nil ,how ,function ,depth)) + +(defmacro erc--remove-response-function (cmd function) + "Call `erc--set-up-response-function' with CMD and FUNCTION." + `(erc--set-up-response-function ,cmd nil nil ,function)) (cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc @@ -1807,9 +1863,6 @@ define-erc-response-handler (concat extra-fn-doc "\n\n") "") name hook-name)) - (fn-internal (and (memq (read (symbol-name name)) - erc--generic-response-handlers) - (intern (format "erc--server-%s" name)))) (fn-alternates (cl-loop for alias in aliases collect (intern (format "erc-server-%s" alias)))) @@ -1823,17 +1876,16 @@ define-erc-response-handler (defvar ,hook-name nil ,(format hook-doc name)) (add-hook ',hook-name #',fn-name) - ,@(when fn-internal - `((cl-defgeneric ,fn-internal (proc parsed) - ,(or extra-fn-doc (format "Handle incoming %s response." name)) - (ignore proc parsed) - ,@fn-body))) ; FIXME indentation in form just below - - ;; Handler function - (defun ,fn-name (proc parsed) - ,fn-doc - (ignore proc parsed) - ,@(if fn-internal `((,fn-internal proc parsed)) fn-body)) + ;; Handler function + (defun ,fn-name (proc parsed) + ,fn-doc + ,@(let ((variable (make-symbol "variable"))) + `((let ((,variable (and (null erc--response-function) + (get ',fn-name 'erc--response-function)))) + (if ,variable + (let ((erc--response-function (symbol-value ,variable))) + (funcall erc--response-function proc parsed)) + ,@fn-body))))) ;; Make find-function and find-variable find them (put ',fn-name 'definition-name ',name) @@ -2671,6 +2723,11 @@ erc-server-322-message (let ((nick (cadr (erc-response.command-args parsed))) (authaccount (nth 2 (erc-response.command-args parsed))) (authmsg (erc-response.contents parsed))) + ;; The 2025 modern docs say: "This does not necessarily mean the + ;; user owns their current nickname, which is covered + ;; byRPL_WHOISREGNICK." The `erc-server-user' slot carries no such + ;; ownership implications either. + (erc-update-user-nick nick nil nil nil nil nil authaccount) (erc-display-message parsed 'notice 'active 's330 ?n nick ?a authmsg ?i authaccount))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 3d0c541d659..5759330dc94 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -100,9 +100,13 @@ erc-input ( info nil :type (list-of cons) :documentation "Alist of `eq'-testable keys with arbitrary values.") + ;; This slot could potentially be used for draft/account-id as well, + ;; which would either supersede a normal account name or coexist + ;; alongside one, via some encoding scheme. + ;; https://github.com/ircv3/ircv3-specifications/issues/402 ( account nil :type (or null string) - :documentation "A non-empty string other than \"*\" or nil.") + :documentation "Account logged into, which may not own nickname.") ( buffers nil :type (list-of buffer) :documentation "Channel buffers user is joined to.")) @@ -474,6 +478,10 @@ erc-with-initialized-session (push ,hook-var delayed-mode-hooks)) (erc-buffer-do ,fn))))) +(defmacro erc--cmd-to-str (cmd) + "Return server CMD as a string, ensuring leading zeros." + `(format (if (natnump ,cmd) "%03i" "%s") ,cmd)) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 5228fc5e5aa..5f0d6062663 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -36,7 +36,7 @@ ;; mechanism for you. Requires CAP 3.2 (see bug#49860). ;;; Code: -(require 'erc) +(require 'erc-v3) (require 'rx) (require 'sasl) (require 'sasl-scram-rfc) @@ -312,6 +312,7 @@ sasl doesn't currently solicit or validate supported mechanisms." ((if erc--target (erc-sasl-mode -1) + (erc-sasl--set-up-register-connection-function t) (setq erc-sasl--state (make-erc-sasl--state)) ;; If the previous attempt failed during registration, this may be ;; non-nil and contain erroneous values, but how can we detect that? @@ -330,9 +331,17 @@ sasl (error "Unknown or unsupported SASL mechanism: `%s'" mech)) (setf (erc-sasl--state-client erc-sasl--state) client)))) ((kill-local-variable 'erc-sasl--state) - (kill-local-variable 'erc-sasl--options)) + (kill-local-variable 'erc-sasl--options) + (erc-sasl--set-up-register-connection-function nil)) localp) +(defun erc-sasl--set-up-register-connection-function (wantp) + (if wantp + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--register-connection '((depth . 60))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--register-connection))) + (define-erc-response-handler (AUTHENTICATE) "Begin or resume an SASL session." nil (if-let* ((response (car (erc-response.command-args parsed))) @@ -410,7 +419,7 @@ erc-sasl--send-cap-ls into a user option, please let ERC know via \\[erc-bug]. Otherwise, expect it to disappear in subsequent versions.") -(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t))) +(defun erc-sasl--register-connection (inner) "Send speculative CAP and pipelined AUTHENTICATE and hope for the best." (if-let* ((c (erc-sasl--state-client erc-sasl--state)) (m (sasl-mechanism-name (sasl-client-mechanism c)))) @@ -426,12 +435,168 @@ erc--register-connection (if (eq :user (alist-get 'user erc-sasl--options)) (erc-current-nick) erc-session-username))) - (cl-call-next-method)) + (funcall inner)) (when erc-sasl--send-cap-ls (erc-server-send "CAP REQ :sasl")) (erc-server-send (format "AUTHENTICATE %s" m))) (erc-sasl--destroy erc-server-process))) + +;;;; Extension: sasl + +;; The following is glue to adapt the `sasl' module to the IRCv3 +;; capability negotiation process. There's no need to add `sasl' to +;; `erc-modules' so long as `sasl' appears in `erc-v3-extensions'. + +;; When this module loads, `cl-struct-define' associates this struct's +;; type with that of its parent, `erc-v3--extension'. The `v3' module +;; then leverages this association as a discovery mechanism to run the +;; `initp' slot of every constructor. This slot's code in particular +;; adds `sasl' to the session's copy of `erc-v3-extensions', which tells +;; ERC to mark it as wanted during capability negotiation. +(erc-v3--define-capability sasl + :initp (erc-sasl--v3-on-wantedp-init) + :slots ((done-cmd nil :type (or null string))) ; e.g., "903" + (unless erc-v3--sasl + (remove-hook 'erc-sasl-mode-hook #'erc-sasl--v3-on-minor-mode t) + (erc-sasl-mode -1))) + +(defun erc-sasl--v3-on-minor-mode () + "Inhibit CL methods specializing on `erc-sasl-mode' `eql'ing t." + (unless erc--target + (if erc-sasl-mode + (progn + (erc-sasl--set-up-register-connection-function nil) + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK '((depth . 40)))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection) + (remove-function (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS) + (remove-function (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK))) + (erc--set-up-response-function 903 erc-sasl-mode ; success + :override #'erc-sasl--v3-server-903) + (erc--set-up-response-function 902 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 904 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 908 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed)) + +(defun erc-sasl--v3-on-wantedp-init () + "Manage module `sasl'." + (when (erc--module-active-p 'sasl) + ;; Tell ERC to request this extension when advertised. + (cl-pushnew 'sasl erc-v3-extensions)) + (when (memq 'sasl erc-v3-extensions) + (cl-assert (erc--server-buffer-p)) + ;; This function is called on `erc-v3-mode' in the server buffer. + ;; It may run before or after `erc-sasl-enable' because the ordering + ;; of modules isn't well defined or controlled. + (add-hook 'erc-sasl-mode-hook #'erc-sasl--v3-on-minor-mode nil t) + (cond (erc-sasl-mode (erc-sasl--v3-on-minor-mode)) ; already up, do setup + ((memq 'sasl erc-modules)) ; will run soon, hook will mark + (t (erc-sasl-mode +1))) ; fully managed by this module + t)) + +(defun erc-sasl--v3-subcmd-LS (inner cap) + "Validate mechanism for `erc-v3--sasl' object CAP. +Call INNER if everything checks out. Otherwise, display an error and +destroy the session." + (if (not (erc-v3--sasl-p cap)) + (funcall inner cap) + (cl-assert (null erc--target)) + (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) + (unless erc-sasl-mode + (error "erc-v3--subcmd-LS: %s" cap)) + (let ((val (erc-v3--capability-val cap))) + (if (or (null val) (erc-sasl--mechanism-offered-p val)) + (funcall inner cap) + (erc-v3--transition cap erc-v3--event-wERR) + (erc-button--display-error-notice-with-keys + "Chosen SASL mechanism " + (upcase (symbol-name (alist-get 'mechanism erc-sasl--options))) + " not among those offered: " val ". Aborting.") + (erc-sasl--destroy erc-server-process)))))) + +;; This suspends negotiation by ignoring the queued ACK message, which +;; is ready for handling. It then resumes execution when a 9xx response +;; arrives by simulating the arrival of the same "ACK", except limiting +;; processing only to only the cap `sasl'. +;; +;; The `extended-isupport' capability, when implemented, would do much +;; the same: specify an overriding "ACK" method and spoof continued +;; execution on BATCH end instead of on 9xx. +(defun erc-sasl--v3-subcmd-ACK (inner cap) + "Suspend negotiation for `erc-v3--capability' CAP and initiate sub-protocol. +Call INNER if CAP is not `erc-v3--sasl' or authentication is already done." + (if (or (not (erc-v3--sasl-p cap)) (erc-v3--sasl-done-cmd cap)) + (funcall inner cap) + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + ;; Extend request timer by 10 seconds. + (timer-inc-time (erc-v3--caps-timer erc-v3--caps) + erc-v3--sync-timeout-seconds) + ;; Not advancing past `qin' inhibits further processing. + (let ((client (erc-sasl--state-client erc-sasl--state))) + ;; When mechanism is unknown this fails with a wrong-type error. + (let ((m (sasl-mechanism-name (sasl-client-mechanism client)))) + (erc-server-send (format "AUTHENTICATE %s" m)))))) + +(defun erc-sasl--v3-register-connection (inner) + "Call INNER with `erc-session-password' and `erc-session-username' bound." + ;; FIXME during a normal Makefile test run, a failing `cl-assert' on + ;; the following line prints a backtrace and stops execution, but the + ;; test is marked as passed! Witnessed on arbitrary commit + ;; 5be32aa047d18b578412e8b249bb4f128a0dc207 + (unless (memq 'sasl (erc-v3--caps-extensions erc-v3--caps)) + (error "Missing `sasl' from session extensions")) + (let ((erc-session-password + (and erc-session-password + (not (eq :password (alist-get 'password erc-sasl--options))) + erc-session-password)) + (erc-session-username + ;; The SASL username may contain a colon or a space. + (if (eq :user (alist-get 'user erc-sasl--options)) + (erc-current-nick) + erc-session-username))) + (funcall inner))) + +;; An alternative approach to manually calling the lower-level ACK +;; handlers a la carte like this would be to "roll back" (revert) to the +;; prior state by copying over the current set of relevant slots (with a +;; special fake event, like `w-rev'), but only after pushing the current +;; set atop the history stack. +(defun erc-sasl--v3-server-903 (&rest _) + "Run \"CAP\" finalizer to conclude capability negotiation. +When `erc-sasl-mode' is the symbol `v3', call DEFAULT 903 handler with +PROC and PARSED." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + ;; FIXME remove assertions once convinced in case some rogue server + ;; sends a 903 for some reason other than to end an SASL subprotocol + ;; dialog. + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + (cl-assert (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (when (and (eq erc-v3--phase-QIN (erc-v3--extension-phase cap)) + (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (setf (erc-v3--sasl-done-cmd cap) "903") + (erc-v3--consider-answered) + (erc-v3--finish-negotiating))) + nil) + +(defun erc-sasl--v3-finalize-failed (_ parsed) + "Record activation as failed and disable mode if enabled." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + (cl-assert cap) + (setf (erc-v3--sasl-done-cmd cap) (erc-response.command parsed)) + (erc-v3--ensure-disabled (list cap)) + (erc-v3--transition cap erc-v3--event-wERR))) + + (provide 'erc-sasl) ;;; erc-sasl.el ends here ;; diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el index 596eb695df9..2ec7bbcc849 100644 --- a/lisp/erc/erc-v3.el +++ b/lisp/erc/erc-v3.el @@ -33,7 +33,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'erc-sasl)) (defgroup erc-v3 nil "IRCv3 extensions for ERC." @@ -89,7 +88,7 @@ erc-v3--caps :documentation "Subset of OBJECTS slot used for outgoing requests." :type list) ( queue-in nil - :documentation "List of (HANDLER . CAP) for current round of ACK/NAKs." + :documentation "List of (SUBCMD-SYM . CAP) for current round of ACK/NAKs." :type (list-of cons)) ( timer nil :documentation "Registration request timer." @@ -237,6 +236,14 @@ erc-v3--make-edges ;; 4. Unlikely, though possible and covered by tests; could be removed ;; 5. Possibly unreachable unless pathological +;; This module revolves around the `erc-v3--extension' "object," which +;; serves as the value of an extension's active minor-mode variable in +;; all buffers of a session. Even though ERC only enables a minor mode +;; after the server confirms support, the extension's object's begins +;; life long before that, on initial `erc-v3-mode' activation in the +;; server buffer. ERC looks to each object's `initp' slot to decide +;; whether to attempt to enable it, which, for a capability, means +;; requesting it. (cl-defstruct erc-v3--extension "\"Abstract class\" for basic info relevant to an IRCv3 extension. If the `initp' slot's \"init form\" evaluates non-nil when activating @@ -331,8 +338,8 @@ erc-v3--enqueue-in "Add EXTENSION to `erc-v3--caps-queue-in' slot if phase dictates." (if (eq erc-v3--phase-QIN (erc-v3--extension-phase extension)) (push (cons (let ((e (erc-v3--extension-event extension))) - (cond ((eq e erc-v3--event-sACK) #'erc-v3--subcmd-ACK) - ((eq e erc-v3--event-sNAK) #'erc-v3--subcmd-NAK) + (cond ((eq e erc-v3--event-sACK) 'ACK) + ((eq e erc-v3--event-sNAK) 'NAK) (t (error "Wrong event: %S" e)))) extension) (erc-v3--caps-queue-in erc-v3--caps)))) @@ -394,7 +401,7 @@ erc-v3--error-p (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 10)))) (defmacro erc-v3--caps-by-phase (phase) - "Return all extensions whose phase stage matches symbol PHASE." + "Return all extensions whose phase matches symbol PHASE." `(seq-filter (lambda (o) (eq ,(intern (format "erc-v3--phase-%s" phase)) (erc-v3--extension-phase o))) @@ -481,12 +488,6 @@ erc-v3-extension [&optional stringp] ; minor-mode doc when present def-body)) -;; Each extension EXT is a minor mode whose mode variable erc-v3--EXT is -;; normally set to the session's instance of the extension's own -;; `erc-v3--extension'-derived struct of the same name. During module -;; setup, the `erc-v3-mode' "enable body" copies this mode variable's -;; value from the server buffer to the newly created target buffer via -;; the extension's minor-mode command, erc-v3--EXT-mode. (defmacro erc-v3--define-extension (&rest body) "Define an `erc-v3--extension'-derived struct and supporting items. From BODY, create a struct type named erc-v3--NAME with an identically @@ -498,31 +499,30 @@ erc-v3--define-extension suitable for opaque application state. Expect users to favor `:slots' over local variables for state shared among all buffers of a connection. If OPTS contains an `:aliases' keyword, interpret its value, a form that -evaluates to a list of symbols, as an overriding default (i.e., -\"initform\", \"sdefault\", etc.) for the resulting class's `aliases' -slot. Moreover, ensure that each member of the list has an -`erc-v3--extension-class' symbol property set to the struct +evaluates to a list of symbols, as an overriding \"initform\" for the +resulting class's `aliases' slot. And in doing so, ensure each alias +has an `erc-v3--extension-class' symbol property set to the struct constructor's symbol, normally erc-v3--NAME, so that ERC can create -equivalent objects from effectively equivalent caps, like `draft/my-cap' -and `my-cap'. Add any other keyword pairs in OPTS matching existing -slots to the superclass' `:include' form in a similar manner. - -Additionally, define a variable sharing the constructor's name, but set -its value to nil, and make it local when set. From this, create an -\"internal\" minor mode with this as its mode variable, and activate it -in all buffers of the connection. Make this mode non-interactive, but -allow a `:keymap' argument in OPTS to specify the minor mode's keymap. -Interpret all forms following the last keyword/value pair or second doc -string as comprising the MODE-BODY. In target buffers, arrange for this -body to run alongside normal local-module activation, where -`erc--target-priors' is populated. In server buffers, have it run -during connection registration, where `erc--server-reconnecting' is -empty and calls to `erc--restore-initialize-priors' ineffective, -although it can also run later if triggered by a \"CAP NEW\". Expect -users to know that modules depended on and activated by a v3 extension -should have no issue sustaining persistent data across reconnects -because ERC adds global modules to `erc-modules' and automatically -reactivates local modules. +equivalent objects from effectively equivalent extensions, like +`draft/my-cap' and `my-cap'. Finally, in a similar manner, add any +other keyword pairs in OPTS matching existing slots to the superclass' +`:include' form as well. + +Other than the struct type, define a variable sharing the constructor's +name, but set its value to nil, and make it local when set. From this, +create an \"internal\" minor mode with this as its mode variable, and +have it activate in all buffers of the connection. Make this mode +non-interactive, but allow a `:keymap' argument in OPTS to specify the +minor mode's keymap. Beyond that, interpret all forms following the +last keyword/value pair or second doc string as comprising the +MODE-BODY. In target buffers, arrange for this body to run alongside +normal local-module activation, where `erc--target-priors' is populated. +In server buffers, have it run during connection registration, where +`erc--server-reconnecting' is empty and `erc--restore-initialize-priors' +ineffective -- though it can also run later if triggered by a \"CAP +NEW\". Expect contributors to know that since modules depended on by an +extension are reactivated upon reconnect, their hooks can serve as a +convenient place to wrangle persistent data. \(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) @@ -537,6 +537,11 @@ erc-v3--define-capability (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) `(erc-v3--define-extension-subclass erc-v3--capability ,body)) +;; As mentioned, each extension is a minor mode whose mode variable is +;; the session's instance of the `erc-v3--extension'-derived struct of +;; the same name, such as `erc-v3--cap-notify'. During target-buffer +;; setup, this module copies over each extension's minor mode variable +;; from the server buffer. The values themselves are shared (`eq'). (defun erc-v3--activate-module-for-target () "Initialize `erc-v3-mode' in a target buffer. Replicate the server buffer's set of enabled extensions locally by @@ -555,8 +560,16 @@ erc-v3--activate-module-for-target (defun erc-v3--activate-module () "Perform steps to initialize buffer for `erc-v3-mode'. Create a local `erc-v3--caps' object in the server buffer and populate -its `extensions' slot with a copy of `erc-v3-extensions'." +its `extensions' slot with a copy of `erc-v3-extensions'. For each +member, attempt to load an associated \"erc-\" prefixed library. Next, +call the constructor of every non-parent type appearing in the list +`cl-struct-erc-v3--extension-tags'. If the `initp' slot of the +resulting instance is non-nil, mark the extension as \"wanted\", meaning +ERC will request it if advertised by the server. Finally, save these +instances in the `objects' slot of the `erc-v3--caps' for this session." (cl-assert (null erc--target)) + ;; Bind `erc-v3-extensions' for constructors to modify in special + ;; cases via their `initp' slot. See SASL for an example. (let* ((erc-v3-extensions erc-v3-extensions) (exts (cl-union erc-v3-base-extensions erc-v3-extensions)) (wanted-constructors ()) @@ -599,12 +612,7 @@ v3 When activating this local module, take steps to ensure capability negotiation will commence and the necessary bookkeeping performed to carry the protocol dialog to completion. When deactivating, print an -error message and destroy the entire ERC session. - -Note that in server buffers, `erc-v3-mode-hook' runs before extension -mode variables, like `erc-v3--cap-notify', have been set. Another way -to run code at this juncture is to override an init form in the -extension's definition." +error message and destroy the entire ERC session." ((unless erc--target (pcase erc-tags-format ('legacy @@ -614,34 +622,45 @@ v3 ((or 'warn 'overridable) (erc--warn-once-before-connect 'erc-v3-mode "Module v3 has changed the format of the `erc-response' slot" - " for this session to an alist of (SYMBOL . STRING-OR-NIL).")))) + " for this session to an alist of (SYMBOL . STRING-OR-NIL)."))) + (add-function :before (local 'erc--register-connection-function) + #'erc-v3--register-connection '((depth . 45)))) + (erc--add-response-function 005 :after #'erc-v3--server-005) + (erc--add-response-function 353 :around #'erc-v3--server-353) + (erc--add-response-function 366 :before #'erc-v3--server-366) + (erc--add-response-function 900 :override #'erc-v3--server-900) + (erc--add-response-function CAP :override #'erc-v3--server-CAP) (if erc--target (erc-v3--activate-module-for-target) (erc-v3--activate-module))) - ;; XXX tearing this down properly is likely not worth implementing - ;; because it would require extensions to provide a cap-negation - ;; implementation. (It's much easier to just destroy the session - ;; and reconnect.) To make this work, you'd have to REQ -foo all - ;; extensions and wait until they're ACK'd before killing relevant - ;; local vars, all while ensuring operations can be run repeatedly. + ;; XXX tearing this down properly is likely not worth doing because it + ;; requires syncing with the server. It's much easier to destroy the + ;; session and reconnect. To make this work, you'd have to REQ -foo + ;; all extensions and wait until they're all ACK'd before finishing. ((unless erc--target (erc-button--display-error-notice-with-keys-and-warn (erc-server-buffer) "Disabling `erc-v3-mode' is not currently supported." (and (memq 'v3 erc-modules) " Please remove v3 from `erc-modules' if unwanted."))) - ;; Although this being a local module makes setting the mode var back - ;; to t technically possible, this practice remains somewhat risky - ;; and experimental until more thoroughly thought through. - (setq erc-v3-mode t)) + ;; Since this is a local module, set the mode var back to t. + (setq erc-v3-mode t) + ;; Things that would be torn down were that supported. + (unless 'inhibited + (remove-function (local 'erc--register-connection-function) + #'erc-v3--register-connection) + (erc--remove-response-function 005 #'erc-v3--server-005) + (erc--remove-response-function 353 #'erc-v3--server-353) + (erc--remove-response-function 366 #'erc-v3--server-366) + (erc--remove-response-function 900 #'erc-v3--server-900) + (erc--remove-response-function CAP #'erc-v3--server-CAP))) localp) ;; To profile the negotiation sequence, put a `profiler-start' here and ;; a `profiler-stop' in `erc-v3--finish-negotiating'. -(cl-defmethod erc--register-connection (&context (erc-v3-mode (eql t))) +(defun erc-v3--register-connection () "Start capability negotiation with server when ERC-V3-MODE is non-nil." - (erc-server-send "CAP LS 302") - (erc-login)) + (erc-server-send "CAP LS 302")) (defun erc-v3--handle-negotiation-timeout (buffer event) "Destroy session in server BUFFER and dump info about caps. @@ -677,33 +696,30 @@ erc-v3--send-requests Create and return a request timer." (cl-assert (erc-v3--caps-queue-out erc-v3--caps)) (let (todo) - (while-let ((o (pop (erc-v3--caps-queue-out erc-v3--caps)))) - (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase o))) - (when (eq erc-v3--phase-SEND (erc-v3--transition o erc-v3--event-pOUT)) - (push (concat (and (erc-v3--pending-negated-p o) "-") - (symbol-name (erc-v3--capability-key o))) + (while-let ((cap (pop (erc-v3--caps-queue-out erc-v3--caps)))) + (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase cap))) + (when (eq erc-v3--phase-SEND (erc-v3--transition cap erc-v3--event-pOUT)) + (push (concat (and (erc-v3--pending-negated-p cap) "-") + (symbol-name (erc-v3--capability-key cap))) todo))) - (while-let ((todo) - (this (take 10 todo))) - (erc-server-send (format "CAP REQ :%s" (string-join this " "))) + (while todo + (erc-server-send (format "CAP REQ :%s" (string-join (take 10 todo) " "))) (setq todo (nthcdr 10 todo)))) (erc-v3--run-timer erc-v3--event-pERR erc-v3--request-timeout-seconds)) -(defun erc-v3--run-subcmd (key handler) - "Run all \"CAP\" subcmd HANDLERs for capability KEY." +(defun erc-v3--run-subcmd (key subcmd) + "Run \"CAP\" SUBCMD handler for capability's KEY." (when-let* ((canon (erc-v3--canon-from-key key)) (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) :key #'erc-v3--extension-canon))) - (funcall handler cap))) + (funcall (erc-v3--subcmd2handler subcmd) cap))) (defun erc-v3--run-subcmds-piecemeal (subcmd alist) "Run all SUBCMD handlers for a \"CAP LS\" or a \"CAP NEW\". Expect ALIST to have members with symbols at the head representing capabilities." (pcase-dolist (`(,key . ,_) alist) - (erc-v3--run-subcmd key (pcase-exhaustive subcmd - ('LS #'erc-v3--subcmd-LS) - ('NEW #'erc-v3--subcmd-NEW))))) + (erc-v3--run-subcmd key subcmd))) (defun erc-v3--finish-negotiating () "Finalize \"CAP\" dialog." @@ -716,14 +732,10 @@ erc-v3--finish-negotiating ;; FIXME ensure a "CAP NEW" arriving unexpectedly during registration ;; won't cause problems. -(cl-defmethod erc--server-CAP (_proc parsed &context (erc-v3-mode (eql t))) - "Manage a \"CAP\" dialog when ERC-V3-MODE is non-nil. -Handle \"CAP\" subcommands in `erc-response' PARSED, possibly deferring -some for later processing. Do this throughout an IRC session, not only -during connection registration. Skip handlers if PARSED lacks trailing -args but do send queued requests. Always send a \"CAP END\" during -registration if no requests are pending, which may be undesirable in -some cases. Always return nil." +(defun erc-v3--server-CAP (_proc parsed) + "Handle a subcommand for \"CAP\" response PARSED and return nil. +Always send queued requests or, if all have been answered, a \"CAP +END\", but only during connection registration." (let* ((subcmd (intern (nth 1 (erc-response.command-args parsed)))) (contents (if (memq subcmd '(LS LIST)) (erc-v3--check-continued parsed) ; may be null @@ -750,7 +762,7 @@ erc--server-CAP (pcase subcmd ((or 'LS 'NEW) (erc-v3--mark-offered subcmd key val)) ((or 'ACK 'NAK) (erc-v3--check-answered subcmd key)) - ('DEL (erc-v3--run-subcmd key #'erc-v3--subcmd-DEL)))) + ('DEL (erc-v3--run-subcmd key subcmd)))) (push (cons key val) pairs)) (skip-syntax-forward "-")))) ;; Perform deferred processing. @@ -837,8 +849,50 @@ erc-v3--deps-gather-dependents out)) +;;;; Subcommand handlers + +;; There's currently no "fallback" LS/NEW handler for unknown caps +;; because the current design views membership in the objects list as +;; immutable. + +;; If ever switching to blind-REQ style without initial CAP LS, move +;; `erc-v3--ensure-deps' call from this handler to the default ACK +;; method and adjust expected negotiation states accordingly. +(defvar erc-v3--subcmd-LS-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP LS\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NEW-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP NEW\" arg as an`erc-v3--capability'.") + +(defvar erc-v3--subcmd-DEL-function #'erc-v3--subcmd-DEL + "Function to visit a single \"CAP DEL\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-ACK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP ACK\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NAK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP NAK\" arg as an `erc-v3--capability'.") + +(defun erc-v3--subcmd-DEL (capability) + "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-sDEL)) + +(defun erc-v3--trigger-event-pIN (capability) + "Apply `erc-v3--event-pIN' event to `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-pIN)) + + ;;;; Subcommand helpers +(defun erc-v3--subcmd2handler (subcmd) + "Return handler function associated with \"CAP\" SUBCMD symbol." + (pcase-exhaustive subcmd + ('LS erc-v3--subcmd-LS-function) + ('NEW erc-v3--subcmd-NEW-function) + ('DEL erc-v3--subcmd-DEL-function) + ('ACK erc-v3--subcmd-ACK-function) + ('NAK erc-v3--subcmd-NAK-function))) + (define-inline erc-v3--cap-negated-p (cap-sym) "Indicate whether CAP-SYM is negated (has a leading hyphen)." (inline-quote (eq ?- (aref (symbol-name ,cap-sym) 0)))) @@ -856,6 +910,7 @@ erc-v3--check-continued (defvar erc-message-english-CAP-LIST "Enabled CAPs: %m" "English `erc-message-template' template for key `CAP-LIST'.") +;; TODO also print enabled non-caps, like WHOX and MONITOR. (defun erc-v3--handle-subcmd-list (parsed pairs) "Display PAIRS named for \"LIST\" subcommand in PARSED response." (when-let* ((m (mapcar (lambda (i) (symbol-name (car i))) pairs))) @@ -1022,8 +1077,8 @@ erc-v3--ensure-disabled ;; What this means is that a server may not send all ACKs for one or ;; more REQs in a single message. (Not to be confused with multi-line ;; LS and LIST responses.) As a consequence of this requirement, the -;; state table gains the "qin" rendezvous, which extensions with special -;; needs, like SASL, can use for suspending the main protocol. +;; state table gains the "QIN" rendezvous, which extensions, like SASL, +;; can use for suspending the main protocol. (defun erc-v3--consider-answered () "Run subcommand handlers and perform mode (de)activation. @@ -1036,7 +1091,7 @@ erc-v3--consider-answered (erc-v3--run-timer erc-v3--event-wERR erc-v3--sync-timeout-seconds) (let ((inhibited ())) (dolist (item (erc-v3--caps-queue-in erc-v3--caps)) - (funcall (car item) (cdr item)) + (funcall (erc-v3--subcmd2handler (car item)) (cdr item)) ;; Push back if still queued to maintain invariant. (when (eq erc-v3--phase-QIN (erc-v3--extension-phase (cdr item))) (push item inhibited))) @@ -1057,68 +1112,36 @@ erc-v3--check-answered (let ((cap (erc-v3--find-capability-by-key key))) (cl-assert (or (eq (erc-v3--cap-negated-p key) (erc-v3--unwanted-p cap)) (erc-v3--error-p cap))) - (cl-assert (eq erc-v3--phase-QIN (erc-v3--transition cap (erc-v3--subcmd2event subcmd)))))) -;;;; Subcommand handlers - -;; There's currently no "fallback" LS/NEW handler for unknown caps -;; because the current design views membership in the objects list as -;; immutable. - -;; If ever switching to blind-REQ style without initial CAP LS, move -;; `erc-v3--ensure-deps' call from this handler to the default ACK -;; method and adjust expected negotiation states accordingly. -(cl-defmethod erc-v3--subcmd-LS (capability) - "Handle a \"CAP LS\" response for `erc-v3--capability' CAPABILITY." - (erc-v3--ensure-deps capability)) - -(cl-defmethod erc-v3--subcmd-NEW (capability) - "Handle a \"CAP NEW\" response for `erc-v3--capability' CAPABILITY." - (erc-v3--ensure-deps capability)) - -(cl-defmethod erc-v3--subcmd-DEL (capability) - "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability erc-v3--event-sDEL)) - -(cl-defmethod erc-v3--subcmd-ACK (capability) - "Handle a \"CAP ACK\" subcommand for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability erc-v3--event-pIN)) - -(cl-defmethod erc-v3--subcmd-NAK (capability) - "Handle a \"CAP NAK\" subcommand for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability erc-v3--event-pIN)) - - ;;;; ISUPPORT-based extensions ;; This is only for simple, old-school extensions associated with a -;; single parameter whose presence advertises support. Not for use with -;; capabilities, like `chathistory', that use ISUPPORT parameters for -;; other purposes. - -(defvar erc-v3--isupport-params '((whox . WHOX) (monitor . MONITOR))) +;; single parameter whose presence advertises support. Likely useless +;; for capabilities, like `chathistory', that use ISUPPORT parameters +;; for other purposes. -(defun erc-v3--check-offered-on-005 (canon param) - "Call handler for extension named CANON with \"ISUPPORT\" PARAM." - (when-let* ((item (erc--get-isupport-entry param)) - (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) - :key #'erc-v3--extension-canon))) - (funcall #'erc-v3--on-isupport-param cap (car item) (cdr item)))) +(defvar erc-v3--isupport-params + `((WHOX whox ,#'erc-v3--on-isupport-param) + (MONITOR monitor ,#'erc-v3--monitor-on-isupport-param))) -(cl-defmethod erc-v3--on-isupport-param (extension _key _value) +(defun erc-v3--on-isupport-param (extension _key _value) "Call EXTENSION with \"ISUPPORT\" parameter KEY and VALUE." - (when (eq erc-v3--phase-CHECK (erc-v3--transition extension erc-v3--event-s005)) + (when (eq erc-v3--phase-CHECK + (erc-v3--transition extension erc-v3--event-s005)) (unless (eq erc-v3--phase-LOG (erc-v3--ensure-deps extension)) (erc-v3--ensure-enabled (list extension))))) -(cl-defmethod erc--server-005 (_proc _parsed &context (erc-v3-mode (eql t))) +(defun erc-v3--server-005 (&rest _) "Run code for params in `erc-v3--isupport-params' in server buffer." - (cl-call-next-method) - (pcase-dolist (`(,canon . ,param) erc-v3--isupport-params) - (erc-v3--check-offered-on-005 canon param))) + (pcase-dolist (`(,param ,canon ,handler) erc-v3--isupport-params) + (when-let* ((item (erc--get-isupport-entry param)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall handler cap (car item) (cdr item)))) + nil) ;;;; Extension: cap-notify @@ -1132,7 +1155,9 @@ cap-notify ;; servers only send 319, which includes status prefixes, for users in ;; shared channels. And such status info should already be current. -(erc-v3--define-capability multi-prefix) +(erc-v3--define-capability multi-prefix + (erc--set-up-response-function 352 erc-v3--multi-prefix + :override #'erc-v3--server-352)) (defvar erc-message-english-s352-v3 "%-11c %-10n %-3s %-2a %u@%h (%f)" "English `erc-message-template' template for key `s352-v3'.") @@ -1147,7 +1172,7 @@ erc-v3--multi-prefix--partition (let ((status 0) (count 0)) (catch 'done - (erc--doarray (c name) + (seq-doseq (c name) (if-let* ((p (erc--strpos c statuses))) (setq status (logior status (ash 1 p)) count (1+ count)) @@ -1190,8 +1215,7 @@ erc-v3--update-server-user ;; This applies to basic /WHO #chan, etc. Automated WHOs sent by this ;; module are of the WHOX variety. -(cl-defmethod erc--server-352 - (_ parsed &context (erc-v3--multi-prefix erc-v3--multi-prefix)) +(defun erc-v3--server-352 (_ parsed) "Act like `erc-server-352' and handle PARSED \"RPL_WHOREPLY\". Attempt to parse multi-prefixes. Update existing user records in server and query/channel tables." @@ -1479,7 +1503,7 @@ erc-v3--echo-message-allow-noncommands-p nested calls to `erc--send-input-lines'.") (defun erc-v3--echo-message-inhibit-insert-on-send-message (orig &rest args) - "With `erc-v3--echo-message-allow-noncommands-p', call ORIG function with ARGS. + "With `erc-v3--echo-message-allow-noncommands-p', call ORIG with ARGS. Otherwise, arrange to do so while suppressing input insertion." (cl-assert erc-v3--echo-message) (if erc-v3--echo-message-allow-noncommands-p @@ -1523,6 +1547,8 @@ whox :documentation "Back-off duration in seconds for delay timer.") ( timer nil :type (or null vector) :documentation "Delay timer.")) + (erc--set-up-response-function 263 erc-v3--whox + :override #'erc-v3--server-263) (unless erc--target ;; When `erc-server-flood-queue' is empty, requesting WHO info on ;; JOIN is too early. @@ -1609,10 +1635,7 @@ erc-v3--whox-on-join (erc-v3--whox-enqueue (erc-target) "cuhnflar" #'erc-v3--whox-handle-channel-user)) -(define-erc-response-handler (354) "WHOX RPL_WHOSPCRPL." nil) - -(cl-defmethod erc--server-354 - (_proc parsed &context (erc-v3--whox erc-v3--whox)) +(define-erc-response-handler (354) "WHOX RPL_WHOSPCRPL." nil (pcase-let* ;; The CAR is normally our current nick. ((`(,_ ,token . ,parts) (erc-response.command-args parsed)) @@ -1672,8 +1695,13 @@ erc-message-english-s263-rate-limit "Rate limit exceeded retrieving user data for %t. Next attempt in %us." "English `erc-format-message' template for key `s263-rate-limit'.") -(cl-defmethod erc--server-263 (_proc parsed - &context (erc-v3--whox erc-v3--whox)) +;; Without labeled-response, there's no way to tell which request was +;; the offending one. Hopefully, restricting their issuance to serial +;; round trips reduces the likelihood of mistaken identity. +(defun erc-v3--server-263 (_proc parsed) + "Handle a PARSED 263 response for a query made by `erc-v3--whox'. +Schedule another attempt `erc-v3--whox-penalty' seconds in the future. +Then double `erc-v3--whox-penalty'." (pcase (erc-response.command-args parsed) ((and `(,_ "WHO" ,_) (let `(,oldest . ,_) (last (erc-v3--whox-requests erc-v3--whox)))) @@ -1694,6 +1722,8 @@ erc--server-263 ;;;; Extension: Monitor +;; TODO add tests for this extension! + (erc-v3--define-extension monitor :slots (( targets nil :type (list-of string) :documentation "Targets with active monitor jobs.") @@ -1734,11 +1764,13 @@ monitor ;; upon seeing a matching 005 before BATCH end. (erc-v3--define-capability extended-monitor) -(cl-defmethod erc-v3--on-isupport-param ((o erc-v3--monitor) key value) +(defun erc-v3--monitor-on-isupport-param (ext key value) + "Remember KEY and VALUE for \"MONITOR\" EXT and enable." (cl-assert (eq key 'MONITOR)) - (setf (erc-v3--monitor-max o) + (cl-assert (erc-v3--monitor-p ext)) + (setf (erc-v3--monitor-max ext) (or (and value (string-to-number (car value))) most-positive-fixnum)) - (cl-call-next-method)) + (erc-v3--on-isupport-param ext key value)) (defun erc-v3--monitor-active-p () "Return non-nil when the monitor extension is enabled." @@ -1784,13 +1816,6 @@ erc-message-english-s730 (defvar erc-message-english-s731 "%n is offline" "English `erc-format-message' template for key `s731'.") -;; FIXME ensure this is unused and delete. -(defun erc-v3--monitor-display-online () - (cl-assert (erc-query-buffer-p)) - (unless (eq 's730 (erc--get-inserted-msg-prop 'erc--msg)) - (erc-display-message nil 'notice (current-buffer) - 's730 ?n (erc-target)))) - (define-erc-response-handler (730) "RPL_MONONLINE." nil (dolist (added (split-string (erc-response.contents parsed) ",")) (when-let* ((nuh (erc-parse-user added)) @@ -1843,9 +1868,11 @@ erc-v3--monitor-display-online ;;;; Extension: extended-join (erc-v3--define-capability extended-join + (erc--set-up-response-function JOIN erc-v3--extended-join + :override #'erc-v3--server-JOIN) (if erc-v3--extended-join - (when erc--target - (add-hook 'erc-join-hook #'erc-v3--send-mode-on-join 30 t)) + (if erc--target + (add-hook 'erc-join-hook #'erc-v3--send-mode-on-join 30 t)) (remove-hook 'erc-join-hook #'erc-v3--send-mode-on-join t))) (defvar erc-message-english-JOIN-X "%n (%a: %u@%h) has joined channel %c" @@ -1868,9 +1895,8 @@ erc-v3--join-with-display-context channel erc--display-context))) (save-excursion (erc--open-target channel)))) -(cl-defmethod erc--server-JOIN - (_ parsed &context (erc-v3--extended-join erc-v3--extended-join)) - "Handle a JOIN command with extra arguments. +(defun erc-v3--server-JOIN (_ parsed) + "Handle a PARSED \"JOIN\" response containing extended syntax. Unlike `erc-server-JOIN', do nothing when the buffer has already been joined. Also, don't bother with `erc-channel-begin-receiving-names' because the default handler for \"353\" calls it when needed, and @@ -1988,6 +2014,9 @@ account-tag (dolist (fn erc-v3--account-tag-fallback-handler-hooks) ;; Place *before* main handler so commands, like NICK, that ;; refile the existing record under another name still work. + ;; Stick with the less reliable traditional response hooks + ;; here rather than the `erc--response-function' interface + ;; because this fallback scenario is likely rare. (add-hook fn #'erc-v3--ensure-account -20 t))) (dolist (fn erc-v3--account-tag-fallback-handler-hooks) (remove-hook fn #'erc-v3--ensure-account t))))) @@ -2054,7 +2083,8 @@ erc-v3--standard-replies-handle remaining args and PARSED to be an `erc-repsonse' object.") (cl-defmethod erc-v3--standard-replies-handle (type command code rest parsed) - "Emit a `standard-replies' catch-all message to server buffer." + "Emit a `standard-replies' catch-all message to server buffer. +Determine how to display message from TYPE, COMMAND, CODE, REST, PARSED." (let ((msg-type (pcase type ('NOTE 'notice) ('WARN '(notice error)) @@ -2112,214 +2142,57 @@ erc-cmd-SETNAME nil) -;;;; Extension: sasl - -;; This implementation is merely glue to adapt the `sasl' module to this -;; 302 negotiation business. There's no need to add `sasl' to -;; `erc-modules' because this manages it for you. - -(declare-function erc-sasl--destroy "erc-sasl" (proc)) -(declare-function erc-sasl--mechanism-offered-p "erc-sasl" (offered)) -(declare-function erc-sasl--state-client "erc-sasl" (cl-x)) -(declare-function erc-sasl-mode "erc-sasl" (&optional arg)) -(declare-function sasl-client-mechanism "sasl" (client)) -(declare-function sasl-mechanism-name "sasl" (mechanism)) -(defvar erc-sasl--options) -(defvar erc-sasl-mode) - -;; This works by temporarily treating the mode variable `erc-sasl-mode' -;; as having a "tri-state" value for the current session. If the value -;; is the symbol `v3', then this file's version runs. - -(erc-v3--define-capability sasl - :initp (erc-v3--sasl-on-wantedp-init) - (cl-assert (featurep 'erc-sasl)) - (unless erc-v3--sasl - (remove-hook 'erc-sasl-mode-hook #'erc-v3--sasl-on-minor-mode t) - (erc-sasl-mode -1))) - -(defun erc-v3--sasl-on-minor-mode () - "Inhibit CL methods specializing on `erc-sasl-mode' `eql'ing t." - (when erc-sasl-mode - (setq erc-sasl-mode 'v3))) - -(defun erc-v3--sasl-on-wantedp-init () - "Manage module `sasl'." - (when (erc--module-active-p 'sasl) - (cl-pushnew 'sasl erc-v3-extensions)) - (when (memq 'sasl erc-v3-extensions) - (cl-assert (erc--server-buffer-p)) - ;; This function is ultimately called by `erc-v3-enable', which may - ;; run before or after `erc-sasl-enable' because the ordering of - ;; modules isn't well defined or controlled. - (add-hook 'erc-sasl-mode-hook #'erc-v3--sasl-on-minor-mode nil t) - (require 'erc-sasl) - (cond ((erc-v3--sasl-on-minor-mode)) ; already up, so mark it - ((memq 'sasl erc-modules)) ; will run soon, hook will mark - (t (erc-sasl-mode +1))) ; fully managed by this module - t)) - -(cl-defmethod erc-v3--subcmd-LS ((cap erc-v3--sasl)) - (cl-assert (null erc--target)) - (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) - (cl-assert erc-sasl-mode) - (let ((val (erc-v3--capability-val cap))) - (if (or (null val) (erc-sasl--mechanism-offered-p val)) - (cl-call-next-method) - (erc-v3--transition cap erc-v3--event-wERR) - (erc-button--display-error-notice-with-keys - "Chosen SASL mechanism " - (upcase (symbol-name (alist-get 'mechanism erc-sasl--options))) - " not among those offered: " val ". Aborting.") - (erc-sasl--destroy erc-server-process))))) - -;; This suspends negotiation by ignoring the queued ACK message, which -;; is ready for handling. It then resumes execution when a 9xx response -;; arrives by simulating the arrival of the same "ACK", except limiting -;; processing only to only the cap `sasl'. -;; -;; The `extended-isupport' capability, when implemented, would do much -;; the same: specify an overriding "ACK" method and spoof continued -;; execution on BATCH end instead of on 9xx. -(cl-defmethod erc-v3--subcmd-ACK - ((cap erc-v3--sasl) &context ((bound-and-true-p erc-sasl-mode) (eql v3))) - "Suspend negotiation path for CAP and initiate sub-protocol." - (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) - ;; Extend request timer by 10 seconds. - (timer-inc-time (erc-v3--caps-timer erc-v3--caps) - erc-v3--sync-timeout-seconds) - (defvar erc-sasl--state) - ;; Not advancing past `qin' inhibits further processing. - (let ((client (erc-sasl--state-client erc-sasl--state))) - ;; When mechanism is unknown this fails with a wrong-type error. - (let ((m (sasl-mechanism-name (sasl-client-mechanism client)))) - (erc-server-send (format "AUTHENTICATE %s" m))))) - -(cl-defmethod erc--register-connection - :around (&context ((bound-and-true-p erc-sasl-mode) (eql v3))) - ;; FIXME during a normal Makefile test run, a failing `cl-assert' on - ;; the following line prints a backtrace and stops execution, but the - ;; test is marked as passed! Witnessed on arbitrary commit - ;; 5be32aa047d18b578412e8b249bb4f128a0dc207 - (unless (memq 'sasl (erc-v3--caps-extensions erc-v3--caps)) - (error "Missing `sasl' from session extensions.")) - (let ((erc-session-password - (and erc-session-password - (not (eq :password (alist-get 'password erc-sasl--options))) - erc-session-password)) - (erc-session-username - ;; The SASL username may contain a colon or a space. - (if (eq :user (alist-get 'user erc-sasl--options)) - (erc-current-nick) - erc-session-username))) - (cl-call-next-method))) - -;; An alternative approach to manually calling the lower-level ACK -;; handlers a la carte like this would be to "roll back" (revert) to the -;; prior state by copying over the current set of relevant slots (with a -;; special fake event, like `w-rev'), but only after pushing the current -;; set atop the history stack. -(cl-defmethod erc--server-903 - (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) - "Call default finalizer to conclude capability negotiation." - (let ((cap (erc-v3--find-capability-by-key 'sasl))) - ;; FIXME remove assertions once convinced in case some rogue server - ;; sends a 903 for some reason other than to end an SASL subprotocol - ;; dialog. - (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) - (cl-assert (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) - (when (and (eq erc-v3--phase-QIN (erc-v3--extension-phase cap)) - (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) - (let ((erc-sasl-mode nil)) ; ensure the default handler runs - (erc-v3--consider-answered)) - (erc-v3--finish-negotiating))) - nil) - -(defun erc-v3--sasl-finalize-failed () - "Record activation as failed and disable mode if enabled." - (let ((o (erc-v3--find-capability-by-key 'sasl))) - (cl-assert o) - (erc-v3--ensure-disabled (list o)) - (erc-v3--transition o erc-v3--event-wERR))) - -(cl-defmethod erc--server-902 - (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) - (erc-v3--sasl-finalize-failed) - (cl-call-next-method)) - -(cl-defmethod erc--server-904 - (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) - (erc-v3--sasl-finalize-failed) - (cl-call-next-method)) - -(cl-defmethod erc--server-908 - (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) - (erc-v3--sasl-finalize-failed) - (cl-call-next-method)) - - ;;;; Common extension utilities ;; This first set of handlers and utilities provides smart(er) ;; collecting of nicknames, using `multi-prefix' and ;; `userhost-in-names', when applicable. -;; TODO make this a user option or public variable. -(defvar erc-v3--353-names-message-size 512 - "Number of names per simulated NAMES reply (353) message.") +;; FIXME relocate this at the top of the file. +(defcustom erc-v3-simulated-names-message-size 200 + "Number of nicks displayed per simulated \"NAMES\" reply (353) message. +When the userhost-in-names extension is active, displaying a 353 line as +originally received tends to be distracting because many nick!user@host +tokens are wide enough that only a couple end up occupying each line, +depending on the frame's dimensions. In large rooms, this can feel like +multiple pages of names scrolling by on end. + +This option attempts to replicate the feel of how ERC has traditionally +displayed 353 messages without the extension, that is, by only printing +the nick portion of each token and waiting until more than a few arrive +before displaying them, so more fit on a single line and in a single +formatted message. However, if the value is nil, ERC won't perform any +of this and will instead faithfully print the contents of each message +as received." + :package-version '(ERC . "5.7") + :type '(choice (const nil) + natnum)) (defvar erc-message-english-s353-v3 "Users on %c (%d): %u" "English `erc-format-message' template for key `s353-v3'.") -(defvar-local erc-v3--353-work nil - "Target-local state for processing large name dumps in chunks.") - -(cl-defstruct erc-v3--353-work - "Pending state while receiving names." - disp count names self) +(defvar-local erc-v3--channel-new-member-names nil + "Temporary hash table containing a subset of `erc-channel-members'.") (cl-defmethod erc--partition-prefixed-names (name &context (erc-v3-mode (eql t))) "Return a list of (STATUS NICK LOGIN HOST). -Act like the base method, except handle multiple prefix chars -before NAME, and perform the side effect of populating the -`names' slot of `erc-v3--353-work'." +Act like the base method, except handle multiple prefix chars before +NAME. Only run when ERC-V3-MODE is t." (pcase-let* ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) - (`(,status ,pfx ,nuh) (erc-v3--multi-prefix--partition name - statuses)) + (`(,status ,_ ,nuh) (erc-v3--multi-prefix--partition name statuses)) (`(,nick ,login ,host) (erc--parse-nuh nuh))) (when (and (or nick ; this macro returns nick (cl-multiple-value-setq (nick login host) (erc--shuffle-nuh-nickward nick login host)))) - ;; Add to list. - (push (concat pfx nick) (erc-v3--353-work-names erc-v3--353-work)) `(,status ,nick ,login ,host)))) (declare-function erc-button--deemphasize-plebs "erc-button" (nick-object)) -(defun erc-v3--name-less-p (a b) - "Return the higher priority of status-prefixed nicks A and B." - ;; Don't bother with case tables since this is only for show. - (setq a (downcase a) - b (downcase b)) - (let ((a-statused-p (not (<= ?a (aref a 0) ?z))) - (b-statused-p (not (<= ?a (aref b 0) ?z)))) - (cond ((xor a-statused-p b-statused-p) ; only one has status - a-statused-p) - (a-statused-p ; both have status - (cl-assert b-statused-p) - (let* ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) - (split-a (erc-v3--multi-prefix--partition a statuses)) - (split-b (erc-v3--multi-prefix--partition b statuses))) - (if (= (car split-a) (car split-b)) - (string< (nth 2 split-a) (nth 2 split-b)) - (> (car split-a) (car split-b))))) ; bigger status first - (t (string< a b))))) - -(defun erc-v3--print-names (parsed channel names disp) +(defun erc-v3--print-names (parsed) "Insert aggregated PARSED implicit \"NAMES\" response into current CHANNEL. -Expect NAMES to be a list of statusted nicks and DISP to be the tally." +Expect NAMES to be a list of statusted nicks." (add-function :filter-return (local 'erc-button--modify-nick-function) #'erc-button--deemphasize-plebs '((depth . 95))) ;; Since we wait to print 353s in one go (on 366), spoof the former @@ -2327,84 +2200,88 @@ erc-v3--print-names (unless (equal (erc-response.command parsed) "353") (setf parsed (copy-erc-response parsed) (erc-response.command parsed) "353")) - (erc-display-message parsed 'notice (current-buffer) - 's353-v3 - ?c channel - ?d (propertize " " 'display disp) - ?u (string-join (sort names #'erc-v3--name-less-p) " ")) + (let* ((sorted (sort (hash-table-values erc-v3--channel-new-member-names) + (lambda (a b) + (let ((status-a (erc-channel-user-status (cdr a))) + (status-b (erc-channel-user-status (cdr b)))) + (if (= status-a status-b) + (string< (erc-downcase + (erc-server-user-nickname (car a))) + (erc-downcase + (erc-server-user-nickname (car b)))) + (> status-a status-b)))))) ; bigger status first + (names (mapcar (pcase-lambda (`(,user . ,cusr)) + (concat + (and (not (zerop (erc-channel-user-status cusr))) + (erc-v3--format-prefix cusr)) + (erc-server-user-nickname user))) + sorted))) + (erc-display-message parsed 'notice (current-buffer) + 's353-v3 + ?c (erc-target) + ?d (hash-table-count erc-channel-users) + ?u (string-join names " "))) (remove-function (local 'erc-button--modify-nick-function) #'erc-button--deemphasize-plebs)) -(cl-defmethod erc--server-353 (proc parsed &context (erc-v3-mode (eql t))) - "Override 353 default handler for RPL_NAMREPLY, processing PARSED for PROC. -Insert entries in buffer, ensuring correct buttonizing." - ;; The first arg may be an asterisk instead of the current nick. - (let ((channel (nth 2 (erc-response.command-args parsed))) - (users (erc-response.contents parsed))) - (erc-with-buffer (channel proc) - (unless erc-v3--353-work - (setq erc-v3--353-work - (make-erc-v3--353-work :count 0 :disp (list "0"))) - (setf (erc-v3--353-work-self erc-v3--353-work) - (erc-get-channel-user (erc-current-nick)))) - (erc-channel-receive-names users) - (when (> (- (hash-table-count erc-channel-users) - (erc-v3--353-work-count erc-v3--353-work)) - erc-v3--353-names-message-size) - (erc-v3--print-names parsed channel - (erc-v3--353-work-names erc-v3--353-work) - (erc-v3--353-work-disp erc-v3--353-work)) - (setf (erc-v3--353-work-names erc-v3--353-work) nil - ;; - (erc-v3--353-work-count erc-v3--353-work) - (hash-table-count erc-channel-users))) - ;; Mutate value in place. - (setf (car (erc-v3--353-work-disp erc-v3--353-work)) - (format "%d" (hash-table-count erc-channel-users))))) - nil) - ;; TODO find out why `erc-channel-end-receiving-names' treats ;; `erc-channel-new-member-names' like a subset of ;; `erc-channel-users'. Aren't they equal (for initial NAMES)? - -(defun erc-v3--bake-display-count (beg end val) - "Find regions with a `display' property `eq' to VAL from BEG to END. -Replace each with the car of VAL. Expect VAL to be a list containing a -single string." - (let ((pos beg) - (inhibit-read-only t) - (inhibit-field-text-motion t)) - (save-excursion - (while (setq pos (text-property-any pos end 'display val)) - (goto-char pos) - (delete-region (point) (+ 3 (point))) - (insert-and-inherit (car val)) - (setq pos (point)))))) - -(cl-defmethod erc--server-366 (proc parsed &context (erc-v3-mode (eql t))) - "Perform same procedure as `erc-channel-begin-receiving-names'." +(defun erc-v3--process-new-member-names (parsed forcep) + "Call `erc-channel-receive-names' with users temporary table. +Afterwards, update actual table with any new members. Ensure +`erc-v3--channel-new-member-names' is non-nil, and add new members here +as well. With FORCEP or if `erc-v3--channel-new-member-names' is larger +than `erc-v3-simulated-names-message-size', call `erc-v3--print-names' +with PARSED." + (unless erc-v3--channel-new-member-names + (setq erc-v3--channel-new-member-names (make-hash-table :test #'equal))) + (let ((actual (or erc-channel-new-member-names + (erc-channel-begin-receiving-names))) + (erc-channel-new-member-names (make-hash-table :test #'equal))) + (unless forcep ; 366 + (erc-channel-receive-names (erc-response.contents parsed))) + (maphash (lambda (key value) + (cl-assert (eq value t)) + (puthash key value actual) + (puthash key (gethash key erc-channel-members) + erc-v3--channel-new-member-names)) + erc-channel-new-member-names)) + (when (or forcep (> (hash-table-count erc-v3--channel-new-member-names) + erc-v3-simulated-names-message-size)) + (erc-v3--print-names parsed) + (clrhash erc-v3--channel-new-member-names))) + +;; The reason names aren't merely collected here and only later printed +;; in the 366 handler is because giant rooms with many thousands of +;; names (typically encountered when dealing with a bridge to a non-IRC +;; protocol) would otherwise sit for minutes without any feedback. +(defun erc-v3--server-353 (default proc parsed) + "Maybe override DEFAULT \"RPL_NAMREPLY\" handler. +If `erc-v3-simulated-names-message-size' is non-nil, display a simulated +message containing truncated names. Otherwise, call DEFAULT with PROC +and PARSED." + (if (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((nth 2 (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed nil) + nil) + (funcall default proc parsed))) + +(defun erc-v3--server-366 (proc parsed) + "Maybe run `erc-v3--process-new-member-names'. +If necessary, display a simulated 353 message in PROC's target buffer +for the PARSED 366 response." ;; :test.libera.chat 366 someNick #emacs :End of /NAMES list - ;; FIXME use `erc--skip' for this instead. - (defvar erc-track-exclude) - (let* ((channel (cadr (erc-response.command-args parsed))) - (erc-track-exclude (list channel))) - (erc-with-buffer (channel proc) ; this downcases - (setf (erc-v3--353-work-count erc-v3--353-work) - (hash-table-count erc-channel-users)) - (erc-v3--print-names parsed channel - (erc-v3--353-work-names erc-v3--353-work) - (erc-v3--353-work-disp erc-v3--353-work)) - ;; FIXME leave a marker instead of scanning the entire buffer. - (erc-v3--bake-display-count (point-min) erc-insert-marker - (erc-v3--353-work-disp erc-v3--353-work)) - (setq erc-v3--353-work nil))) - (cl-call-next-method)) + (when (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed 'forcep)))) ;; These last two handlers are account aware. -(cl-defmethod erc--server-900 (_proc parsed &context (erc-v3-mode (eql t))) - "Given `erc-response' PARSED, mark this session's user as being logged in. -Only do so when ERC-V3-MODE is non-nil." +(defun erc-v3--server-900 (_proc parsed) + "Given `erc-response' PARSED, mark this session's user as being logged in." (pcase-let* ((`(,nick ,userhost ,account) (erc-response.command-args parsed)) (`(,uh-nick ,login ,host) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 606cd81b538..d92c57f835d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7300,8 +7300,7 @@ erc-channel-receive-names (defun erc-update-user-nick (nick &optional new-nick host login full-name info account) "Update the stored user information for the user with nickname NICK. - -See also: `erc-update-user'." +Do nothing if the user doesn't exist." (when-let* ((user (erc-get-server-user nick))) (erc-update-user user new-nick host login full-name info account))) diff --git a/test/lisp/erc/erc-scenarios-v3-sasl.el b/test/lisp/erc/erc-scenarios-v3-sasl.el index df8714c4d10..de388590571 100644 --- a/test/lisp/erc/erc-scenarios-v3-sasl.el +++ b/test/lisp/erc/erc-scenarios-v3-sasl.el @@ -156,6 +156,7 @@ erc-scenarios-v3-sasl--authentication-failure (funcall expect 20 "SASL authentication failed") (funcall expect 20 "Connection failed!") (should-not (erc-server-process-alive)) + (defvar erc-v3--sasl) (should-not erc-v3--sasl)) ; mode disabled (with-current-buffer warnings-buffer diff --git a/test/lisp/erc/erc-scenarios-v3.el b/test/lisp/erc/erc-scenarios-v3.el index e6af1a83e3b..158748583af 100644 --- a/test/lisp/erc/erc-scenarios-v3.el +++ b/test/lisp/erc/erc-scenarios-v3.el @@ -169,9 +169,11 @@ erc-scenarios-v3-userhost-in-names ;; Check buttonizing of statused nicks in names list. (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 "*** Users on #spam (215): ~@Q @D") + (funcall expect 10 "*** Users on #spam (436): abErGAVeNny") ;; Mike appears before joe because @ is more important than +. - (funcall expect 10 "@mike") - (should (equal (get-text-property (1+ (match-beginning 0)) + (funcall expect 10 "*** Users on #spam (461): @mike") + (should (equal (get-text-property (- (match-end 0) (length "mike")) 'font-lock-face) '(erc-button-nick-default-face erc-notice-face))) (funcall expect 10 "+joe") @@ -450,7 +452,8 @@ erc-scenarios-v3-whox--rate-limited ((erc-scenarios-common-dialog "v3/whox") (erc-server-flood-penalty 0.1) erc-accidental-paste-threshold-seconds - erc-autojoin-channels-alist + (erc-autojoin-channels-alist + '((foonet "#chan" "#foo" "#bar" "#baz" "#spam"))) (erc-d-tmpl-vars `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) (dumb-server (erc-d-run "localhost" t 'rate-limited)) @@ -475,12 +478,7 @@ erc-scenarios-v3-whox--rate-limited (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) - (funcall expect 10 "User modes for tester") - (erc-cmd-JOIN "#chan") - (erc-cmd-JOIN "#foo") - (erc-cmd-JOIN "#bar") - (erc-cmd-JOIN "#baz") - (erc-cmd-JOIN "#spam")) + (funcall expect 10 "User modes for tester")) (ert-info ("Full names not yet known") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) @@ -503,6 +501,9 @@ erc-scenarios-v3-whox--rate-limited (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 5 "<joe> mike: Excellent"))) + (with-current-buffer "foonet" + (funcall expect 5 "Rate limit exceeded retrieving user data")) + ;; Full names are now known. (dolist (chan '("chan" "foo" "bar" "baz" "spam")) (with-current-buffer (concat "#" chan) @@ -515,7 +516,6 @@ erc-scenarios-v3-away-notify (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "v3/away-notify") (erc-server-flood-penalty 0.1) - erc-autojoin-channels-alist (erc-d-tmpl-vars `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) (dumb-server (erc-d-run "localhost" t 'basic)) diff --git a/test/lisp/erc/erc-v3-tests.el b/test/lisp/erc/erc-v3-tests.el index b0a21bd358d..fe11be5b072 100644 --- a/test/lisp/erc/erc-v3-tests.el +++ b/test/lisp/erc/erc-v3-tests.el @@ -523,6 +523,60 @@ erc-v3--define-extension-subclass--minor-mode (kill-buffer "#chan") (kill-buffer))))) + +(define-erc-response-handler (ERCTEST) + "ERCTEST" nil (erc-display-error-notice parsed + (erc-response.contents parsed))) + +;; FIXME move this and the tag stuff to erc-tests.el or a new +;; erc-backend-tests.el. +(ert-deftest erc--response-function () + (erc-tests-common-make-server-buf) + + (let* ((calls ()) + ;; Putting this lambda inline in the setup-fn instead of as its + ;; own binding breaks removal functionality on Emacs <29! + (fn (lambda (_ parsed) + (push (erc-response.command parsed) calls))) + (setup-fn (lambda (enablep) + (erc--set-up-response-function ERCTEST enablep + :override fn)))) + + ;; Simulate a minor-mode being enabled (the most obvious intended + ;; use case). Its body overrides the default handler locally. + (funcall setup-fn t) + + ;; Simulate another connection. + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + + ;; This other server buffer is unaffected, so the default handler + ;; runs and displays its message. + (erc-tests-common-simulate-line ":irc.barnet.org ERCTEST dummy :Found") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (should-not calls) + + ;; No-op because other connection still using modified handler. + (should-not (erc--tidy-response-function 'erc-server-ERCTEST))) + + ;; Back in the overridden buffer, the default handler is suppressed. + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found") + (should (equal calls '("ERCTEST"))) + (goto-char (point-min)) + (should-not (search-forward "Found" nil t)) + (setq calls nil) + + ;; Disabling the minor mode, restores the default handler and removes + ;; the symbol property if necessary. + (funcall setup-fn nil) + (should-not (get 'erc-server-ERCTEST 'erc--response-function)) + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (setq calls nil)) + + (erc-tests-common-kill-buffers)) + (ert-deftest erc-get-tag () ;; Legacy format. (let ((ab1c-legacy '(("c") ("b" "1") ("a"))) @@ -820,28 +874,6 @@ erc--server-CAP/pre-and-post-registration (erc-tests-common-kill-buffers)) -(cl-defmethod erc-v3--subcmd-LS :before - (o &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/subcmd-handlers))) - (push (intern (format "bef-%s" (erc-v3--extension-canon o))) - erc-v3-tests--calls)) - -(cl-defmethod erc-v3--subcmd-LS - ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/subcmd-handlers))) - (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) - (push 'a erc-v3-tests--calls) - (cl-call-next-method)) - -;; Methods can inhibit a request by altering the `initp' slot. -(cl-defmethod erc-v3--subcmd-LS - ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/subcmd-handlers))) - (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) - (erc-v3--transition o erc-v3--event-wOFF) - (push 'c erc-v3-tests--calls) - (cl-call-next-method)) - ;; This shows that methods for subcommand handlers can influence a ;; request decision during the "check" phase by modifying the table and ;; an LS handler. @@ -849,7 +881,7 @@ erc--server-CAP/subcmd-handlers (erc-tests-common-make-server-buf) (defvar cl-struct-erc-v3--extension-tags) - (cl-letf* ((erc-v3-tests--calls ()) + (cl-letf* ((calls ()) (erc-v3-extensions '(test/a test/c)) (erc-v3--edges (erc-v3-tests--modify-edges `((,erc-v3--state-Sa-Wi-Mo-Pa @@ -860,14 +892,37 @@ erc--server-CAP/subcmd-handlers '( erc-v3--test/a erc-v3--test/b erc-v3--test/c erc-v3--extension erc-v3--capability)) ((symbol-function #'erc-server-send) - (lambda (&rest r) (push r erc-v3-tests--calls)))) + (lambda (&rest r) (push r calls)))) (erc-v3-mode +1) + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (push (intern (format "bef-%s" + (erc-v3--extension-canon o))) + calls)) + '((name . ls-before) (depth . 10))) + + ;; Methods can inhibit a request by altering the `initp' slot. + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (pcase o + ((cl-struct erc-v3--test/a) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (push 'a calls)) + ;; Ignore test/b + ((cl-struct erc-v3--test/c) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (erc-v3--transition o erc-v3--event-wOFF) + (push 'c calls)))) + '((name . ls-ac) (depth . 20))) + (ert-info ("Handlers deferred on continuation line") (erc-tests-common-simulate-line ":irc.example.org CAP * LS * :test/a test/c") - (should-not erc-v3-tests--calls) + (should-not calls) (should (equal (erc-v3-tests--slots '(canon phase)) '((test/a INIT) (test/b nil) (test/c INIT))))) @@ -880,37 +935,11 @@ erc--server-CAP/subcmd-handlers (test/c Sa-Wo-Mo-Pa PASS)))) ; manually disabled ;; The LS handler for test/c effectively negates the configuration ;; expressed by `erc-v3-extensions'. - (should (equal erc-v3-tests--calls - '(("CAP REQ :test/a") - bef-test/b c bef-test/c a bef-test/a))))) + (should (equal calls '(("CAP REQ :test/a") + bef-test/b c bef-test/c a bef-test/a))))) (erc-tests-common-kill-buffers)) - -(cl-defmethod erc-v3--subcmd-ACK - ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/NAK-made-unwanted))) - (cl-call-next-method) - (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) - (should (erc-v3--wanted-p o)) - (push (erc-v3--extension-canon o) erc-v3-tests--calls)) - -(cl-defmethod erc-v3--subcmd-ACK - ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/NAK-made-unwanted))) - (cl-call-next-method) - (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) - (should (erc-v3--wanted-p o)) - (push (erc-v3--extension-canon o) erc-v3-tests--calls)) - -(cl-defmethod erc-v3--subcmd-NAK - ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/NAK-made-unwanted))) - (cl-call-next-method) - (should (eq erc-v3--phase-LOG (erc-v3--extension-phase o))) - (should-not (erc-v3--wanted-p o)) - (push (erc-v3--extension-canon o) erc-v3-tests--calls)) - ;; This shows that CAP END is sent after a NAK because no unmet ;; dependencies are found that require a further negated REQ. (ert-deftest erc--server-CAP/NAK-made-unwanted () @@ -920,7 +949,7 @@ erc--server-CAP/NAK-made-unwanted (cl-letf* ((calls ()) ((symbol-function #'erc-server-send) (lambda (&rest r) (push r calls))) - (erc-v3-tests--calls ()) + (subcmd-calls ()) (erc-v3-extensions '(test/a test/b test/c)) (cl-struct-erc-v3--extension-tags '( erc-v3--test/a erc-v3--test/b erc-v3--test/c @@ -928,6 +957,22 @@ erc--server-CAP/NAK-made-unwanted (erc-v3-mode +1) + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (or (erc-v3--test/a-p o) (erc-v3--test/c-p o)) + (should (eq erc-v3--phase-UP + (erc-v3--extension-phase o))) + (should (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + (add-function :after (local 'erc-v3--subcmd-NAK-function) + (lambda (o) + (when (erc-v3--test/b-p o) + (should (eq erc-v3--phase-LOG + (erc-v3--extension-phase o))) + (should-not (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) subcmd-calls)))) + (should (equal (erc-v3-tests--slots '(canon phase)) '((test/a INIT) (test/b INIT) (test/c INIT)))) @@ -945,17 +990,17 @@ erc--server-CAP/NAK-made-unwanted '((test/a SEND) (test/b SEND) (test/c QIN)))) ;; Extension not activated because outstanding REQs. (should-not erc-v3--test/c) - (should-not erc-v3-tests--calls) + (should-not subcmd-calls) (should-not calls)) (ert-info ("ACK 2 arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/a") (should (equal (erc-v3-tests--slots '(canon phase)) '((test/a QIN) (test/b SEND) (test/c QIN)))) - (should-not erc-v3-tests--calls) + (should-not subcmd-calls) (should-not calls) (should-not erc-v3--test/c) ; still missing reply for test/b - (should-not erc-v3-tests--calls)) + (should-not subcmd-calls)) (ert-info ("NAK arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * NAK :test/b") @@ -963,30 +1008,10 @@ erc--server-CAP/NAK-made-unwanted '((test/a RUN) (test/b LOG) (test/c RUN)))) (should erc-v3--test/c) (should (equal calls '(("CAP END")))) - (should (equal erc-v3-tests--calls '(test/c test/a test/b))))) + (should (equal subcmd-calls '(test/c test/a test/b))))) (erc-tests-common-kill-buffers)) -(cl-defmethod erc-v3--subcmd-ACK - ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/preempted-ACK))) - (cl-call-next-method) - (if (eq erc-v3--phase-UP (erc-v3--extension-phase o)) - (erc-v3--transition o erc-v3--event-wOFF) - (should-not (erc-v3--enabled-p o)) - (should-not (erc-v3--wanted-p o))) - (push (erc-v3--extension-canon o) erc-v3-tests--calls)) - -(cl-defmethod erc-v3--subcmd-LS - ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) - (eql erc--server-CAP/preempted-ACK))) - (cl-call-next-method) - (if (eq erc-v3--phase-TRACK (erc-v3--extension-phase o)) - (erc-v3--transition o erc-v3--event-wON) - (should-not (erc-v3--enabled-p o)) - (should-not (erc-v3--wanted-p o))) - (push (erc-v3--extension-canon o) erc-v3-tests--calls)) - ;; This shows that it's possible to "reconsider" an ACK and preempt or ;; overturn mode activation and finalization by forcing another REQ ;; round. For example, an extension could decide some non-IRC @@ -1002,7 +1027,7 @@ erc--server-CAP/preempted-ACK (lambda (&rest r) (push r calls))) (erc-v3--edges (erc-v3-tests--modify-edges erc-v3-tests--preempt-up-edges)) - (erc-v3-tests--calls ()) + (subcmd-calls ()) (erc-v3-extensions '(test/a)) (cl-struct-erc-v3--extension-tags '( erc-v3--test/a erc-v3--test/b @@ -1010,6 +1035,25 @@ erc--server-CAP/preempted-ACK (erc-v3-mode +1) + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (erc-v3--test/a-p o) + (if (eq erc-v3--phase-UP (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wOFF) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + + (add-function :after (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (when (erc-v3--test/b-p o) + (if (eq erc-v3--phase-TRACK (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wON) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) subcmd-calls)))) + (should (equal (erc-v3-tests--slots '(canon phase)) '((test/a INIT) (test/b nil)))) @@ -1018,7 +1062,7 @@ erc--server-CAP/preempted-ACK ":irc.example.org CAP * LS :test/a test/b") (should-not (erc-v3--caps-continued erc-v3--caps)) (should (equal (pop calls) '("CAP REQ :test/a test/b"))) - (should (equal erc-v3-tests--calls '(test/b))) + (should (equal subcmd-calls '(test/b))) (should (equal (erc-v3-tests--slots '(canon phase)) '((test/a SEND) (test/b SEND)))) (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) @@ -1036,7 +1080,7 @@ erc--server-CAP/preempted-ACK ;; Other ACKs for this round also deferred until no REQs remain. (should-not erc-v3--test/a) (should-not erc-v3--test/b) - (should (equal erc-v3-tests--calls '(test/a test/b))) + (should (equal subcmd-calls '(test/a test/b))) (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) (ert-info ("Reconsidered round answered") @@ -1049,7 +1093,7 @@ erc--server-CAP/preempted-ACK (should-not erc-v3--test/a) ; remains disabled (should erc-v3--test/b) ; activated ;; Handler called a second time. - (should (equal erc-v3-tests--calls '(test/a test/a test/b))) + (should (equal subcmd-calls '(test/a test/a test/b))) (should (equal (pop calls) '("CAP END"))) (should-not calls)) @@ -1301,7 +1345,6 @@ erc-channel-receive-names--baseline (ert-deftest erc-channel-receive-names--enabled () (should-not erc-v3--userhost-in-names) (let ((erc-v3--userhost-in-names (erc-v3--userhost-in-names)) - (erc-v3--353-work (make-erc-v3--353-work)) ;; full-name info account buffers (rest `(nil nil nil (,(current-buffer))))) (lambda () diff --git a/test/lisp/erc/resources/v3/cap-notify/basic.eld b/test/lisp/erc/resources/v3/cap-notify/basic.eld index 3ed4cb94bef..447cb8d6311 100644 --- a/test/lisp/erc/resources/v3/cap-notify/basic.eld +++ b/test/lisp/erc/resources/v3/cap-notify/basic.eld @@ -14,7 +14,8 @@ (0.02 "@time=" now " :irc.znc.in CAP tester ACK :account-notify")) ((cap-end 3.2 "CAP END") - ;; ZNC dangles some treats + ;; Note that this was captured from an older ZNC. + ;; Version 1.10.1 sends each NEW on a separate line. (0.04 "@time=" now " :irc.znc.in CAP tester NEW :account-notify away-notify extended-join") (0.0 "@time=" now " :calcium.libera.chat 001 pretester :Welcome to the Libera.Chat Internet Relay Chat Network tester") @@ -59,7 +60,7 @@ ((who 1.36 "WHO #chan %tcuhnflar,1") (0.0 "@time=" now " :calcium.libera.chat 354 tester 1 #chan ~ERC user/crierc crierc H 0 crierc :0.0.0.0") - (0.1 "@time=" now " :calcium.libera.chat 354 tester 1 #chan ~onaqnyv tah/onaqnyv onaqnyv G 0 onaqnyv :Nzva Onaqnyv") + (0.1 "@time=" now " :calcium.libera.chat 354 tester 1 #chan ~onaqnyv tah/onaqnyv onaqnyv G@ 0 onaqnyv :Nzva Onaqnyv") (0.8 "@time=" now " :calcium.libera.chat 354 tester 1 #chan pretester localhost tester H 376784 pretester :Pre Tester") (0.0 "@time=" now " :calcium.libera.chat 354 tester 1 #chan fbzrbar sbffubfg/qverpgbe/pbejva pbejva G 0 pbejva :fbzrbar") (0.0 "@time=" now " :calcium.libera.chat 315 tester #chan :End of /WHO list.") diff --git a/test/lisp/erc/resources/v3/userhost-in-names/basic.eld b/test/lisp/erc/resources/v3/userhost-in-names/basic.eld index 3360729b56f..9f7b97d9cdc 100644 --- a/test/lisp/erc/resources/v3/userhost-in-names/basic.eld +++ b/test/lisp/erc/resources/v3/userhost-in-names/basic.eld @@ -39,6 +39,16 @@ ((join-spam 10 "JOIN #spam") (0.1 ":tester!~tester@localhost JOIN #spam") + (0.0 ":irc.example.org 353 tester = #spam :NCmRkf0fr Fureol UnbF tnpxf Pvrpubz EbuvgF5612 Gboov s0erfg qrcrpur @Pehvpxl +SnypbaFcl CbjnOnatn @Fbeprere ~@Q qvfp @F @T svmv Xunvqn GungYhexre bf|julm Tnabax Natrym qraavf| Fvpnevhf sernxll85 XreilA538 +Ibebabv sbnzl pngryvln- @Fnghea +zrro @iyvrqry [Q-Pbl]Nqnz tnmol MG +Uvqqra Qravn Fhpul ^_^ Qravn- fzbxr___ nagbvar Cvg AvXnA fBqNtvEY_ PurrfrFbqnChapu Fgej Ybeq255 @XvyynU YnqlCrneynpr QnfOenva Fhagbc Lbevpx_ Avxlevn JneCvtf PbzchgreGrpu") + (0.0 ":irc.example.org 353 tester = #spam :znm nrovna zntznhf3 ubsszna- @D @fuebhq +fyht Sryrabi rivgn Cnenobyvn pp ZvYYvLrgPUv Qvqqy _pp Oynpx6Pebj xvenan Gvzbgrhf ryrzragny_ fglyr pbbyqhqr Lbevpx Xbentt _XnfmcvE_ fnoh fgribb [OmF]5cUvAkK +Qrzc Cbeeb mollitia repellendus iusto Nihil asperiores aliquid dolorum blanditiis excepturi magni praesentium quibusdam officiis veritatis facilis eaque temporibus numquam Sequi ipsum quidem pariatur libero architecto perferendis occaecati minus") + (0.0 ":irc.example.org 353 tester = #spam :harum deserunt corporis aspernatur deleniti Delectus maiores omnis alias voluptate laudantium magnam dolorem itaque dolor veniam Voluptas Neque consequatur accusantium tempora velit Natus laborum ipsam necessitatibus nostrum recusandae molestiae suscipit dignissimos Quisquam incidunt quis dolores laboriosam Corrupti voluptatem molestias fugit voluptatibus tempore Consequuntur aNgELO FItZWALTER keEPer ANtENor FaNg bIOndeLlO HERmIa dUMAinE") + (0.0 ":irc.example.org 353 tester = #spam :FauLCONBRIDGe aPOtHeCary COBweb bOURBon BAsSiAnUs CONsTabLE hUBERT aUdREy DarDAnIuS aNtIpHOLus ESCANes ARtHUr sLEnDER CLAUdio GuIlDeNStERn dOnalbAIN cAssAndra GaLLus GArDiNEr anGelica BaSseT ePILOgue EroS CoRnWaLL DaVy HumpHrEy corNeliuS BrItain CapHIS ISABeLLA BOTTOM heCatE GriFFith flOrEnCE aRChIdAmUS derceTuS GuArD ArtEmIDORuS BoaTswAIn AemIlius heNRY joHn CiCero demetriUS FAstOLFE CHArMIan HosTeSs AntIGOnUS foRtInbraS GrEY bUllEN") + (0.0 ":irc.example.org 353 tester = #spam :HeRalD boy BAssanIO cAmilLo brAbaNTio GUArdsmaN gARdENeR DROMIO aEdiles CaPUTiUs hoRaTIo HOrneR Iden cLOwn ARAGON dOGBeRRy BaNQUo gaOLEr huntInGDon JuNO CORin cLaUdius CuRIo CostARD CoLEvILlE gErAlD bUTcHEr HERMioNe PoLYDOre dOLabellA JAILer hoRtensiuS bErTrAm CasSiO piers GOvErNOr graNDpRE caPtAIN EdWard GLEndOwEr CHAThaM epheSus FatheR AGUEchEeK hUGh hYmEN JUliUs GoWER AlbANY doCtOr aNNE AufiDiUs gonZaLO hErBert bARnarDINE ARcHbiSHop") + (0.0 ":irc.example.org 353 tester = #spam :BIGOt CAdE gaDshIll armADo FLEanCe BlANchE JulieT DiOMedeS cOnstancE caRDiNal cLeRK bORAchio DUchEsS cuRAN SiMOn FLUTE CATEsby agamEMnON HElEnA HarCoURT JOAN JAne QUEeN dIANa caTliNg AmieNs ChAtIllIon abErGAVeNny JamES gremiO crAb CAItHneSS bUTTs bRaNDoN GENtLEmaN dAUGHTer dEnny adaM FLAMIniUS CaMbRIDGe cUrTiS FreDERicK BErKelEY jULia JoSePh BRaCkeNBURY fRancIscA CoUrTeSAn CarlisLE FEnTOn AUVErgne weStMInsTer GaRgraVe Minola hEro OwEN") + (0.0 ":irc.example.org 353 tester = #spam :mEtELLUS aNGuS caSca HARrY kAtHeRIne glouCEsteR ADRiAN dionYZA coUNt BouLT AutOlyCUS cASsiUs grAvEdiGgeR BUSHy arRaGon ARVIRagus cLEoMIneS FALSTAfF GobBO emMaNUel iRAS CITIZeN cADwal ClituS bOUrCHIER alARbUs ChaNcELloR cAlPHuRniA eLbow franciS CAmpEIUS derBY Jamy aLICe DOrcaS FeEBLe DOugLAs BeneDIck SICIniuS GRuMIO aMbASSAdor EDMUND adRiAno aPeMAnTus AUMerLe grEgoRY chriSTopHER HeleNus ciMBer berOwne ANdrew GlANSDAlE fABian ANThoNy") + (0.0 ":irc.example.org 353 tester = #spam :cLeon FErDinaND jaqUES FLOrIzeL FrOTh eleanOr FlaViUs hume DOn clarEncE bagot haRRy HolOfERNes mAtthEw GENTlEwoMAN Iago adRIaNa ChIRoN egEON BUrguNdY BaPtIsTA jEssiCA CERES ChOrus TEArSheEt AleXAs cOrIOLanUS enobaRBUs HOSt Boyet dUKe nIck ANdRoMacHE dauPhIn fluELLeN BolinGbrOkE eScaLUs dECiUS DEBoys girl eARL FRanCIs DORSet VelUTuS stANLey bLUNT cANtERbURy EDGar DiCk CelIA AnTiOchus CoRdeliA anDronIcUS gArTer HAstinGS EGLAMOur DenniS") + (0.0 ":irc.example.org 353 tester = #spam :ELY DUkE hELEN GUIlDFOrd fRIaR IRiS gURNEY cHArLes GOUgh BeLcH fRaNce AaRON erPInGHaM eXTon CAPUleT helicAnuS aeMeLiA EXeteR") + ;; These have logins and hostnames (0.0 ":irc.example.org 353 tester = #spam :[email protected] TRUST!~trus@xsx/dvdovt/nzhjz ecstatic!~ecstatic@196-99-4-98 gallant!gallant@xsx/pvtson/qzomnjm") (0.0 ":irc.example.org 353 tester = #spam :tester!~tester@localhost RELAX!~relax@unmxxzqzmhvj/jvvno/ooh/xsooh focused-ne!~focuse@dykosh/qvmjvt/otgzndpqsY") (0.0 ":irc.example.org 353 tester = #spam :@[email protected] [email protected]") -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.7-Remove-some-forward-declarations-from-ERC-tests.patch From 8b257dccb49b23659aeb7f4ab9e27673a65c1fe0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 16 Sep 2025 18:43:58 -0700 Subject: [PATCH 01/14] [5.7] ; Remove some forward declarations from ERC tests * lisp/erc/erc.el (erc--insert-before-markers-transplanting-hidden): Fix what's almost certainly a typo since the return value is undefined. * test/lisp/erc/erc-scenarios-join-display-context.el: Require `erc-join'. * test/lisp/erc/erc-scenarios-log.el: Remove forward declares and require `erc-stamp'. * test/lisp/erc/erc-scenarios-services-misc.el: Require `erc-services'. * test/lisp/erc/erc-tests.el (erc-tests--modules): Reflow into single column for easier management of divergent WIP patch sets, which should help minimize manual surgery when later applying them atop each other. * test/lisp/erc/resources/erc-scenarios-common.el: Remove unused requires and declarations from top of file. (erc-scenarios-common-with-cleanup): Generate local defvars in test scope for likely unloaded user options. (erc-scenarios-common--assert-date-stamps): Don't run when erc-stamp isn't loaded. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Accept a buffer for the NAME arg. --- lisp/erc/erc.el | 3 +- .../erc/erc-scenarios-join-display-context.el | 2 + test/lisp/erc/erc-scenarios-log.el | 6 +- test/lisp/erc/erc-scenarios-services-misc.el | 3 +- test/lisp/erc/erc-tests.el | 45 +++++++- .../erc/resources/erc-scenarios-common.el | 103 +++++++++--------- test/lisp/erc/resources/erc-tests-common.el | 2 +- 7 files changed, 100 insertions(+), 64 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 271c5d5fcf8..25d3ac59af1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3741,7 +3741,8 @@ erc--insert-before-markers-transplanting-hidden (new (and before (erc--solo (cl-intersection b a))))) (when new (erc--remove-from-prop-value-list (1- (point)) (point) 'invisible a)) - (prog1 (insert-before-markers string) + (progn + (insert-before-markers string) (when new (erc--merge-prop (1- (point)) (point) 'invisible new))))) diff --git a/test/lisp/erc/erc-scenarios-join-display-context.el b/test/lisp/erc/erc-scenarios-join-display-context.el index 0e1bb2b081d..3e57cd16986 100644 --- a/test/lisp/erc/erc-scenarios-join-display-context.el +++ b/test/lisp/erc/erc-scenarios-join-display-context.el @@ -26,6 +26,8 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) +(require 'erc-join) + (ert-deftest erc-scenarios-join-display-context--errors () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c95018dd26..d06613b9066 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -28,8 +28,7 @@ (require 'erc-log) (require 'erc-truncate) - -(defvar erc-timestamp-format-left) +(require 'erc-stamp) (ert-deftest erc-scenarios-log--kill-hook () :tags '(:expensive-test) @@ -327,9 +326,6 @@ erc-scenarios-log--truncate/left-stamps (funcall expect 1 "loathed enemy") (funcall expect -0.001 "please your lordship"))))) -(defvar erc-insert-timestamp-function) -(declare-function erc-insert-timestamp-left "erc-stamp" (string)) - (ert-deftest erc-scenarios-log--save-buffer-in-logs/truncate-on-save () :tags '(:expensive-test) (with-suppressed-warnings ((obsolete erc-truncate-buffer-on-save)) diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index 6cb132b192e..9ad7e14b9d0 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -24,8 +24,7 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(eval-when-compile (require 'erc-join) - (require 'erc-services)) +(require 'erc-services) (ert-deftest erc-scenarios-services-password () :tags '(:expensive-test) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 7ad2d268fa3..06189f01a61 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3697,12 +3697,45 @@ erc-channel-user (should (= 0 (erc-channel-user-status u)))))) (defconst erc-tests--modules - '( autoaway autojoin bufbar button capab-identify - command-indicator completion dcc fill identd - imenu irccontrols keep-place list log match menu move-to-prompt netsplit - networks nickbar nicks noncommands notifications notify page readonly - replace ring sasl scrolltobottom services smiley sound - spelling stamp track truncate unmorse xdcc)) + '(autoaway + autojoin + bufbar + button + capab-identify + command-indicator + completion + dcc + fill + identd + imenu + irccontrols + keep-place + list log + match + menu + move-to-prompt + netsplit + networks + nickbar + nicks + noncommands + notifications + notify + page + readonly + replace + ring + sasl + scrolltobottom + services + smiley + sound + spelling + stamp + track + truncate + unmorse + xdcc)) ;; Ensure that `:initialize' doesn't change the ordering of the ;; members because otherwise the widget's state is "edited". diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index ce7595363c9..c2453e93616 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -93,13 +93,6 @@ (require 'erc) -(eval-when-compile (require 'erc-join) - (require 'erc-services) - (require 'erc-fill)) - -(declare-function erc-network "erc-networks") -(defvar erc-network) - (defvar erc-scenarios-common--resources-dir (expand-file-name "../" (ert-resource-directory))) @@ -149,7 +142,8 @@ erc-scenarios-common--print-trace (auth-source-do-cache nil) (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) - (erc-auth-source-parameters-join-function nil) + ;; This binding exists to protect the default value because ERC + ;; adds all joined channels automatically. (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) @@ -178,47 +172,56 @@ erc-scenarios-common-with-cleanup (let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode")) (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode)) - ,@(erc-scenarios-common--make-bindings bindings)))) - - `(erc-d-t-with-cleanup (,@combined) - - (ert-info ("Restore autojoin, etc., kill ERC buffers") + ,@(erc-scenarios-common--make-bindings bindings))) + (dynvars ())) + + ;; Declare "erc-" variables dynamic in test scope. + (dolist (binder combined) + (setq binder (ensure-list binder)) + (when (and (string-prefix-p "erc-" (symbol-name (car binder))) + (not (special-variable-p (car binder)))) + (push `(defvar ,(car binder)) dynvars))) + `(progn + ,@dynvars + (erc-d-t-with-cleanup (,@combined) + + (ert-info ("Restore autojoin, etc., kill ERC buffers") + (dolist (buf (buffer-list)) + (when-let* ((erc-d-u--process-buffer) + (proc (get-buffer-process buf))) + (delete-process proc))) + + (erc-scenarios-common--remove-silence) + + (when erc-scenarios-common-extra-teardown + (ert-info ("Running extra teardown") + (funcall erc-scenarios-common-extra-teardown))) + + (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) + (when (and (boundp 'erc-autojoin-mode) + (not (eq erc-autojoin-mode ,orig-autojoin-mode))) + (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) + + (when (or noninteractive erc-scenarios-common--graphical-p) + (when noninteractive + (erc-scenarios-common--print-trace)) + (erc-d-t-kill-related-buffers) + (delete-other-windows))) + + (erc-scenarios-common--add-silence) + + (ert-info ("Wait for dumb server") (dolist (buf (buffer-list)) - (when-let* ((erc-d-u--process-buffer) - (proc (get-buffer-process buf))) - (delete-process proc))) - - (erc-scenarios-common--remove-silence) - - (when erc-scenarios-common-extra-teardown - (ert-info ("Running extra teardown") - (funcall erc-scenarios-common-extra-teardown))) - - (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) - (when (and (boundp 'erc-autojoin-mode) - (not (eq erc-autojoin-mode ,orig-autojoin-mode))) - (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) - - (when (or noninteractive erc-scenarios-common--graphical-p) - (when noninteractive - (erc-scenarios-common--print-trace)) - (erc-d-t-kill-related-buffers) - (delete-other-windows))) - - (erc-scenarios-common--add-silence) - - (ert-info ("Wait for dumb server") - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when erc-d-u--process-buffer - (erc-d-t-search-for 3 "Starting"))))) + (with-current-buffer buf + (when erc-d-u--process-buffer + (erc-d-t-search-for 3 "Starting"))))) - (ert-info ("Activate erc-debug-irc-protocol") - (unless (and (or noninteractive erc-scenarios-common--graphical-p) - (not erc-debug-irc-protocol)) - (erc-toggle-debug-irc-protocol))) + (ert-info ("Activate erc-debug-irc-protocol") + (unless (and (or noninteractive erc-scenarios-common--graphical-p) + (not erc-debug-irc-protocol)) + (erc-toggle-debug-irc-protocol))) - ,@body))) + ,@body)))) (defvar erc-scenarios-common--term-size '(34 . 80)) (declare-function term-char-mode "term" nil) @@ -329,9 +332,11 @@ erc-scenarios-common-with-noninteractive-in-term (defun erc-scenarios-common--assert-date-stamps () "Ensure all date stamps are accounted for." - (dolist (stamp erc-stamp--date-stamps) - (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) - 'erc--msg))))) + (defvar erc-stamp--date-stamps) + (when (fboundp 'erc-stamp--date-marker) + (dolist (stamp erc-stamp--date-stamps) + (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) + 'erc--msg)))))) (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 6eddd576bf5..7b1bdb86580 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -119,7 +119,7 @@ erc-tests-common-make-server-buf "Return a server buffer named NAME, creating it if necessary. Use NAME for the network and the session server as well." (with-current-buffer (if name - (get-buffer-create name) + (setq name (buffer-name (get-buffer-create name))) (and (string-search "temp" (buffer-name)) (setq name "foonet") (buffer-name))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.7-Preserve-order-of-local-ERC-modules-for-activati.patch From cb5099149fef11a8995591fd74ec5eaaf78e5cb5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 21 Sep 2025 15:52:16 -0700 Subject: [PATCH 02/14] [5.7] Preserve order of local ERC modules for activation * etc/ERC-NEWS: Add new section for ERC 5.7. * lisp/erc/erc.el (erc--update-modules): Reverse returned list. * test/lisp/erc/erc-tests.el (erc--update-modules/local): Update. --- etc/ERC-NEWS | 14 ++++++++++++++ lisp/erc/erc.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 932b7a58aa7..29041017fd5 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,20 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.7 + +** Changes in the library API. + +*** Local modules activate in preferred order instead of in reverse. +In recent versions, ERC has enabled local modules in the reverse order +of that produced by the "set" function used by 'setopt' and the Custom +UI for the option 'erc-modules'. Specifically, Built-in locals were +activated in reverse lexicographic order after third-party ones, which +were simply reversed as given. Now, just like with global modules, ERC +preserves the preferred order when activating local modules for new +sessions. + * Changes in ERC 5.6.2 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 25d3ac59af1..bc3ccac55f9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2443,7 +2443,7 @@ erc--find-mode (defun erc--update-modules (modules) (let (local-modes) - (dolist (module modules local-modes) + (dolist (module modules (nreverse local-modes)) (if-let* ((mode (erc--find-mode module))) (if (custom-variable-p mode) (funcall mode 1) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 06189f01a61..5d295ecc995 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3957,7 +3957,7 @@ erc--update-modules/local ;; Returns local modules. (should (equal (mapcar #'symbol-name (erc--update-modules erc-modules)) - '("erc-lo2-mode" "erc-lo1-mode"))) + '("erc-lo1-mode" "erc-lo2-mode"))) ;; Requiring `erc-lo2' defines `erc-lo2-mode'. (should (equal (mapcar #'prin1-to-string (funcall get-calls)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.7-Set-major-mode-before-updating-modules-in-erc-op.patch From ceb81333f785e8dfd8ac68b782bd10a02635c508 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 1 Feb 2025 16:59:51 -0800 Subject: [PATCH 03/14] [5.7] Set major-mode before updating modules in erc-open * etc/ERC-NEWS: Mention change. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable) (erc-button-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-common.el (erc-with-initialized-session): New macro. * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable, erc-scrolltobottom-disable) (erc-move-to-prompt-mode, erc-move-to-prompt-enable) (erc-move-to-prompt-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-imenu.el (erc-imenu-mode, erc-imenu-enable) (erc-imenu-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable) (erc-stamp-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-track.el (erc-track-mode, erc-track-enable) (erc-track-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-truncate.el (erc-truncate-mode, erc-truncate-enable) (erc-truncate-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc.el (erc--set-modules-functions): New variable, an internal hook to modify erc-modules membership. (erc-open): Set major mode before updating modules. (Bug#76019) --- etc/ERC-NEWS | 10 ++++++++++ lisp/erc/erc-button.el | 4 +--- lisp/erc/erc-common.el | 16 ++++++++++++++++ lisp/erc/erc-goodies.el | 14 +++++--------- lisp/erc/erc-imenu.el | 8 +++----- lisp/erc/erc-stamp.el | 8 +++----- lisp/erc/erc-track.el | 4 +--- lisp/erc/erc-truncate.el | 4 +--- lisp/erc/erc.el | 10 ++++++++-- 9 files changed, 48 insertions(+), 30 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 29041017fd5..d99bac15720 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -25,6 +25,16 @@ were simply reversed as given. Now, just like with global modules, ERC preserves the preferred order when activating local modules for new sessions. +*** Major-mode setup runs before global-module setup in 'erc-open'. +The "enable" body of a global module's minor-mode command will now see +'erc-mode' as the 'major-mode'. Although ERC still delays its +major-mode hook until after it has initialized its main session +variables, a module can also now set any of its own variables that don't +depend on such initialization immediately and without fear of their +being killed. For modules still needing to run delayed, session-aware +code, a new convenience macro called 'erc-with-initialized-session' is +now available to automate any 'erc-mode-hook' wrangling for you. + * Changes in ERC 5.6.2 diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 77aec20c40f..ac646ed507f 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -54,13 +54,11 @@ button "This mode buttonizes all messages according to `erc-button-alist'." ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 30) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 30) - (add-hook 'erc-mode-hook #'erc-button-setup 91) - (unless erc--updating-modules-p (erc-buffer-do #'erc-button-setup)) + (erc-with-initialized-session (erc-button-setup)) (add-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map t "<backtab>" #'erc-button-previous)) ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons) - (remove-hook 'erc-mode-hook #'erc-button-setup) (remove-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map nil "<backtab>" #'erc-button-previous))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e383e92c7ff..da20090ea6a 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -434,6 +434,22 @@ define-erc-module (put ',enable 'definition-name ',name) (put ',disable 'definition-name ',name)))) +(defmacro erc-with-initialized-session (&rest body) + "Run BODY in all ERC buffers if outside `erc-open' and soon otherwise. +When inside `erc-open', run BODY after session variables have been +initialzied and after all `erc-mode-hook' members but before any +`after-change-major-mode-hook' members. Expect caller to know this is +only useful in global-module setup and that they're still responsible +for teardown, which is often done with `erc-buffer-do' or similar." + (let ((fn (make-symbol "fn")) + (hook-var (make-symbol "hook-var"))) + `(let ((,fn (lambda () ,@body))) + (if erc--updating-modules-p + (let ((,hook-var (gensym "erc--oneoff-major-mode-hook-"))) + (set ,hook-var ,fn) + (push ,hook-var delayed-mode-hooks)) + (erc-buffer-do ,fn))))) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 2a787f3e014..5da13409842 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -79,12 +79,11 @@ erc-scrolltobottom-all ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." - ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (when (and erc-scrolltobottom-all (< emacs-major-version 28)) + ((when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") (setq erc-scrolltobottom-all nil)) - (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) + (erc-with-initialized-session (erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) @@ -97,8 +96,7 @@ scrolltobottom (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) - ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (erc-buffer-do #'erc--scrolltobottom-setup) + ((erc-buffer-do #'erc--scrolltobottom-setup) (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) @@ -258,10 +256,8 @@ erc-make-read-only ;;;###autoload(autoload 'erc-move-to-prompt-mode "erc-goodies" nil t) (define-erc-module move-to-prompt nil "This mode causes the point to be moved to the prompt when typing text." - ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-move-to-prompt-setup))) - ((remove-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (dolist (buffer (erc-buffer-list)) + ((erc-with-initialized-session (erc-move-to-prompt-setup))) + ((dolist (buffer (erc-buffer-list)) (with-current-buffer buffer (remove-hook 'pre-command-hook #'erc-move-to-prompt t))))) diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 2e244fa157e..6919e02bc8b 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -135,11 +135,9 @@ erc-imenu--create-index-function ;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t) (define-erc-module imenu nil "Simple Imenu integration for ERC." - ((add-hook 'erc-mode-hook #'erc-imenu-setup) - (add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) - (unless erc--updating-modules-p (erc-buffer-do #'erc-imenu-setup))) - ((remove-hook 'erc-mode-hook #'erc-imenu-setup) - (remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + ((add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + (erc-with-initialized-session (erc-imenu-setup))) + ((remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) (erc-buffer-do #'erc-imenu-setup))) (defun erc-imenu-setup () diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index c3ab155cb24..d49cf8f05e7 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -178,13 +178,11 @@ erc-timestamp-face ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook #'erc-stamp--setup) - (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) + ((add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-stamp--setup) - (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) + (erc-with-initialized-session (erc-stamp--setup))) + ((remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (erc-buffer-do #'erc-stamp--setup))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 2897c3ede93..7c3523670ad 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -607,8 +607,7 @@ track ;; enable the tracking keybindings (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (erc-track-minor-mode-maybe)) - (add-hook 'erc-mode-hook #'erc-track--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-track--setup)) + (erc-with-initialized-session (erc-track--setup)) (add-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer)) ;; Disable: @@ -630,7 +629,6 @@ track (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (when erc-track-minor-mode (erc-track-minor-mode -1))) - (remove-hook 'erc-mode-hook #'erc-track--setup) (erc-buffer-do #'erc-track--setup) (remove-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer))) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index f5404a15b71..7b458b6164a 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -67,12 +67,10 @@ truncate ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (add-hook 'erc-mode-hook #'erc-truncate--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) + (erc-with-initialized-session (erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (remove-hook 'erc-mode-hook #'erc-truncate--setup) (erc-buffer-do #'erc-truncate--setup))) (defvar-local erc-truncate--buffer-size nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bc3ccac55f9..971535a6455 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2470,6 +2470,11 @@ erc--updating-modules-p confidently call (erc-foo-mode 1) without having to learn anything about the dependency's implementation.") +(defvar erc--set-modules-functions nil + "Abnormal hook run before updating modules on major-mode init. +Calls members with ID and TARGET parameters of `erc-open', both possibly +nil, along with a non-nil TARGET's server buffer when applicable.") + (defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules) "Internal hook for module setup involving windows and frames.") @@ -2620,6 +2625,9 @@ erc-open (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) + (delay-mode-hooks (erc-mode)) + (run-hook-with-args 'erc--set-modules-functions id channel + (and channel old-buffer)) (setq delayed-modules (erc--merge-local-modes (let ((erc--updating-modules-p t)) (erc--update-modules @@ -2627,8 +2635,6 @@ erc-open (or erc--server-reconnecting erc--target-priors))) - (delay-mode-hooks (erc-mode)) - (setq erc-server-reconnect-count old-recon-count) (when (setq erc-server-connected (not connect)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.7-Run-mode-hooks-in-ERC-query-buffers-on-reconnect.patch From cb57f04c5728fa7dd7e9a282601aa845431870aa Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 1 May 2024 03:25:51 -0700 Subject: [PATCH 04/14] [5.7] Run mode hooks in ERC query buffers on reconnect * etc/ERC-NEWS: Mention change. * lisp/erc/erc.el (erc-connection-established): Call `erc--open-target' on all existing query buffers after they've been reassociated by erc-networks logic. --- etc/ERC-NEWS | 7 +++++++ lisp/erc/erc.el | 13 ++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index d99bac15720..fb741cf0b97 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -16,6 +16,13 @@ GNU Emacs since Emacs version 22.1. ** Changes in the library API. +*** Mode hooks run in query buffers on reconnect. +Previously, mode hooks would only run in channel buffers on reconnect, +due to channels being rejoined. But user code had no way to affect how +query buffers were (re)initialized for the new session. Though this may +cause churn in some cases, not that query buffers are currently only +distinguishable by name. + *** Local modules activate in preferred order instead of in reverse. In recent versions, ERC has enabled local modules in the reverse order of that produced by the "set" function used by 'setopt' and the Custom diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 971535a6455..fab8df881ac 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6807,9 +6807,16 @@ erc-connection-established (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) - (when erc-unhide-query-prompt - (erc-with-all-buffers-of-server erc-server-process nil - (when (and erc--target (not (erc--target-channel-p erc--target))) + ;; Run mode hooks on all reclaimed query buffers. + (let ((buffer (current-buffer)) + (erc-join-buffer 'bury) + erc-active-buffer) + (erc-with-all-buffers-of-server erc-server-process + #'erc-query-buffer-p + (let ((target (erc-target))) + (with-current-buffer buffer + (erc--open-target target))) + (when erc-unhide-query-prompt (erc--unhide-prompt)))) (run-hook-with-args 'erc-after-connect server nick))))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.x-Add-predicate-to-detect-ERC-module-activation.patch From ba61b66c2c9cca23999d83a174739cbba6a5185a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 6 Jan 2024 12:57:27 -0800 Subject: [PATCH 05/14] [5.x] Add predicate to detect ERC module activation ;; FIXME update stale change log before merging. * lisp/erc/erc.el (erc--module-active-p): New function. (erc--module-active-ensure): New function. * test/lisp/erc/erc-tests.el (erc--module-active-ensure): Add test. --- lisp/erc/erc.el | 12 ++++++++++++ test/lisp/erc/erc-tests.el | 31 +++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fab8df881ac..432b5da6ea6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2441,6 +2441,18 @@ erc--find-mode (fboundp mode) mode))) +(defun erc--module-active-p (module) + "Return non-nil if symbol MODULE has been enabled or will be." + (let ((mode-var (intern-soft (concat "erc-" (symbol-name module) "-mode")))) + (and (or (and mode-var (boundp mode-var) (symbol-value mode-var) t) + (memq module erc-modules))))) + +(defun erc--module-active-ensure (module) + "Enable symbol MODULE if it's configured to be but isn't currently." + (when-let* (((consp (erc--module-active-p module))) + (mode-var (erc--find-mode module))) + (funcall mode-var +1))) + (defun erc--update-modules (modules) (let (local-modes) (dolist (module modules (nreverse local-modes)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5d295ecc995..3e4e6331b67 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3805,6 +3805,37 @@ erc--find-mode (string< (symbol-name a) (symbol-name b))))))) erc-tests--modules)) +(ert-deftest erc--module-active-enable () + (should (featurep 'erc-networks)) + + (should-not (erc--module-active-p 'fake)) + + (let (after-load-alist calls) + + (cl-letf (((symbol-function 'erc-networks-mode) + (lambda (&rest r) (push r calls)))) + + ;; Module is not enabled nor configured to be. + (let ((erc-networks-mode nil) + (erc-modules nil)) + (should-not (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should-not calls)) + + ;; Module is enabled but not configured to be. + (let ((erc-networks-mode t) + erc-modules) + (should (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should-not calls)) + + ;; Module is disabled but slated to be enabled. + (let ((erc-networks-mode nil) + (erc-modules '(networks))) + (should (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should (equal calls '((1)))))))) + (ert-deftest erc--essential-hook-ordering () (erc-tests--assert-printed-in-subprocess '(progn -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-WIP-Add-erc-echo-msg-property-for-self-messages.patch From 8eafd2e8386beeb058e156941867ee2dd4441452 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 20 Oct 2024 18:05:14 -0700 Subject: [PATCH 06/14] [WIP] Add erc--echo msg property for self messages ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Add `erc--echo' prop when sender has client's current nick. Pass inputp to alternate `erc--ctcp-response' constructor. * lisp/erc/erc-common.el (erc--ctcp-response): Add `inputp' slot. * lisp/erc/erc.el (erc--msg-props): Mention `erc--echo'. (erc--send-message-external): Convert to generic. (erc-process-ctcp-query): Skip all response handling for echoed non-ACTION queries, like VERSION, because no spoofed prompt input needs inserting, and no replies need emitting. --- lisp/erc/erc-backend.el | 5 ++++- lisp/erc/erc-common.el | 5 +++-- lisp/erc/erc.el | 36 +++++++++++++++++++++--------------- 3 files changed, 28 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 81907ffa462..18e05c2790c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2185,13 +2185,16 @@ erc--speaker-status-prefix-wanted-p erc-show-speaker-membership-status inputp) (cdr cdata)))))) + (when inputp + (push (cons 'erc--echo t) erc--msg-prop-overrides)) (if (erc-is-message-ctcp-p msg) (if noticep (erc-process-ctcp-reply proc parsed nick login host (match-string 1 msg)) (setq parsed (erc--ctcp-response-from-parsed :parsed parsed :buffer buffer :statusmsg statusmsg - :prefix cmem-prefix :dispname fnick)) + :prefix cmem-prefix :dispname fnick + :inputp inputp)) (erc-process-ctcp-query proc parsed nick login host)) (setq erc-server-last-peers (cons nick (cdr erc-server-last-peers))) (with-current-buffer (or buffer (current-buffer)) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index da20090ea6a..93c665e4fed 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -135,7 +135,7 @@ erc--target (:include erc-response) (:constructor erc--ctcp-response-from-parsed - (&key parsed buffer statusmsg prefix dispname + (&key parsed buffer statusmsg prefix dispname inputp &aux (unparsed (erc-response.unparsed parsed)) (sender (erc-response.sender parsed)) (command (erc-response.command parsed)) @@ -146,7 +146,8 @@ erc--target (buffer nil :type (or buffer null)) (statusmsg nil :type (or null string)) (prefix nil :type (or erc-channel-user null)) - (dispname nil :type (or string null))) + (dispname nil :type (or string null)) + (inputp nil :type boolean)) (cl-defstruct erc--isupport-data "Abstract \"class\" for parsed ISUPPORT data. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 432b5da6ea6..dcda1f4cc49 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -192,6 +192,9 @@ erc--msg-props hooks that the current message should not affect stateful operations, such as recording a channel's most recent speaker + - `erc--echo': t when present; indicates message is an echoed copy + of a something originally spoken by the client. + - `erc--hide': a symbol or list of symbols added as an `invisible' prop value to the entire message, starting *before* the preceding newline and ending before the trailing newline @@ -5128,7 +5131,7 @@ erc-send-message (funcall erc--send-message-nested-function line force) (erc--send-message-external line force))) -(defun erc--send-message-external (line force) +(cl-defmethod erc--send-message-external (line force) "Send a \"PRIVMSG\" to the default target with optional FORCE. Expect caller to bind `erc-default-recipients' if needing to specify a status-prefixed target." @@ -6865,7 +6868,9 @@ erc-process-ctcp-query ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08 "Process a CTCP query." (let ((queries (delete "" (split-string (erc-response.contents parsed) - "\C-a")))) + "\C-a"))) + (echoedp (and (erc--ctcp-response-p parsed) + (erc--ctcp-response-inputp parsed)))) (if (> (length queries) 4) (erc-display-message parsed (list 'notice 'error) proc 'ctcp-too-many) @@ -6884,20 +6889,21 @@ erc-process-ctcp-query hook proc parsed nick login host (car (erc-response.command-args parsed)) (car queries)) - (when erc-paranoid - (if (erc-current-nick-p - (car (erc-response.command-args parsed))) + (unless echoedp + (when erc-paranoid + (if (erc-current-nick-p + (car (erc-response.command-args parsed))) + (erc-display-message + parsed 'error 'active 'ctcp-request + ?n nick ?u login ?h host ?r (car queries)) (erc-display-message - parsed 'error 'active 'ctcp-request - ?n nick ?u login ?h host ?r (car queries)) - (erc-display-message - parsed 'error 'active 'ctcp-request-to - ?n nick ?u login ?h host ?r (car queries) - ?t (car (erc-response.command-args parsed))))) - (run-hook-with-args-until-success - hook proc nick login host - (car (erc-response.command-args parsed)) - (car queries))) + parsed 'error 'active 'ctcp-request-to + ?n nick ?u login ?h host ?r (car queries) + ?t (car (erc-response.command-args parsed))))) + (run-hook-with-args-until-success + hook proc nick login host + (car (erc-response.command-args parsed)) + (car queries)))) (erc-display-message parsed (list 'notice 'error) proc 'undefined-ctcp))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-WIP-Make-ERC-response-handling-more-flexible.patch From 452947fa32b9e9d0cb71b64c8a9f739d97d3f1b7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 17 Jun 2022 01:43:03 -0700 Subject: [PATCH 07/14] [WIP] Make ERC response handling more flexible ;; FIXME update stale change log before merging. The rationale for allowing handlers to be overridden internally is that the existing public hook interface cannot adequately support the level of granularity required. For example, registering a local `erc-server-FOO-functions' member at an earlier hook depth and returning non-nil based on which extensions are active would still preempt existing user functions registered to run after a primary `erc-server-FOO' handler globally. Sticking with this existing interface would require a breaking change in which ERC adds its primary hook member, `erc-server-FOO', buffer-locally on major-mode init. This would render lots of user code unusable. (Bug#49860) * lisp/erc/erc-backend.el (erc--response-function): New variable. (erc--ensure-response-function, erc--tidy-response-function): New function. (erc--set-up-response-function, erc--add-response-function) (erc--remove-response-function): New macros. (define-erc-response-handler): Look for and call alternate handler if appropriate. * lisp/erc/erc-common.el (erc--cmd-to-str): New function --- lisp/erc/erc-backend.el | 73 ++++++++++++++++++++++++++++++++++++++--- lisp/erc/erc-common.el | 4 +++ 2 files changed, 72 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 18e05c2790c..ecb13a194c4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1625,6 +1625,63 @@ erc-handle-unknown-server-response " ")))) (erc-display-message parsed 'notice proc line))) +(defvar erc--response-function nil + "Alternate response handler currently running, if any.") + +(defun erc--ensure-response-function (handler-symbol) + "Add internal variable to CMD's response handler symbol via symbol property." + (unless (get handler-symbol 'erc--response-function) + (set (put handler-symbol 'erc--response-function + (make-symbol (concat "erc--" ; prefer double-hyphenated prefix + (substring (symbol-name handler-symbol) 4) + "-function"))) + handler-symbol))) + +(defun erc--tidy-response-function (handler-symbol) + "Remove symbol property from HANDLER-SYMBOL if no advice remains." + (let ((sym (get handler-symbol 'erc--response-function))) + (unless (or (null sym) (catch 'found + (erc-buffer-filter + (lambda () + (unless (eq (symbol-value sym) handler-symbol) + (throw 'found t)))))) + (cl-callf (lambda (tail) + (let ((out ())) + (while-let ((key (pop tail)) + (val (pop tail))) + (unless (eq key 'erc--response-function) + (setq out `(,val ,key ,@out)))) + (nreverse out))) + (symbol-plist handler-symbol))))) + +(defmacro erc--set-up-response-function (cmd test how function &optional depth) + "If TEST evaluates non-nil at runtime, add advice to CMD's response handler. +If TEST evaluates to nil, remove it. However, if TEST is the literal +symbol nil, only do one or the other, removing it if HOW is also nil. +Use a depth of 50 for adding if DEPTH is unspecified." + (declare (indent 2)) + (let* ((handler-symbol (intern (concat "erc-server-" (erc--cmd-to-str cmd)))) + (place `(local (get ',handler-symbol + 'erc--response-function)))) + (macroexp-let2 nil function-symbol function + (let ((add-form `(progn + (erc--ensure-response-function #',handler-symbol) + (add-function ,how ,place ,function-symbol + '((depth . ,(or depth 50)))))) + (remove-form `((remove-function ,place ,function-symbol) + (erc--tidy-response-function #',handler-symbol)))) + `(unless erc--target + ,@(cond (test `((if ,test ,add-form ,@remove-form))) + (how (macroexp-unprogn add-form)) + (t remove-form))))))) + +(defmacro erc--add-response-function (cmd how function &optional depth) + "Call `erc--set-up-response-function' with CMD, HOW, FUNCTION, and DEPTH." + `(erc--set-up-response-function ,cmd nil ,how ,function ,depth)) + +(defmacro erc--remove-response-function (cmd function) + "Call `erc--set-up-response-function' with CMD and FUNCTION." + `(erc--set-up-response-function ,cmd nil nil ,function)) (cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc @@ -1770,11 +1827,17 @@ define-erc-response-handler ;; unconditionally (defvar ,hook-name nil ,(format hook-doc name)) (add-hook ',hook-name #',fn-name) - ;; Handler function - (defun ,fn-name (proc parsed) - ,fn-doc - (ignore proc parsed) - ,@fn-body) + + ;; Handler function + (defun ,fn-name (proc parsed) + ,fn-doc + ,@(let ((variable (make-symbol "variable"))) + `((let ((,variable (and (null erc--response-function) + (get ',fn-name 'erc--response-function)))) + (if ,variable + (let ((erc--response-function (symbol-value ,variable))) + (funcall erc--response-function proc parsed)) + ,@fn-body))))) ;; Make find-function and find-variable find them (put ',fn-name 'definition-name ',name) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 93c665e4fed..a41d13aee16 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -451,6 +451,10 @@ erc-with-initialized-session (push ,hook-var delayed-mode-hooks)) (erc-buffer-do ,fn))))) +(defmacro erc--cmd-to-str (cmd) + "Return server CMD as a string, ensuring leading zeros." + `(format (if (natnump ,cmd) "%03i" "%s") ,cmd)) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-WIP-Break-up-early-ERC-response-processing.patch From e50f1e65123bcfeae6badd6f481ae835a2de56ad Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 15 Jul 2022 05:02:35 -0700 Subject: [PATCH 08/14] [WIP] Break up early ERC response processing ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-tags-format): Change default from `overridable' nil, and rename const value `overridable' to `warn' for clarity. (erc-get-tag): New function. (erc--tags-get): New function. (erc-parse-server-response): Convert to modular logic and delegate to helpers. (erc--create-response-from-parts): New generic function and method. (erc--partition-line): New function. (erc-parse-server-response): Move partitioning of tags portion to new function `erc--partition-line'. Move creation of message to new function `erc--create-response-from-parts'. (erc--parse-traditional-response): Perform actual parsing-related business formerly handled by `erc-parse-server-response) * lisp/erc/erc-compat.el (erc-compat--with-backtrace-buffer): New macro to wrap ERC's filter function in a `handler-bind' similar to how `ert' does it. This arranges to dump a plain, non-interactive backtrace in an *erc-process-errors* buffer for every error that occurs when `debug-on-error' is not in effect. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-i--parse-message/privmsg): Force legacy parsing behavior. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common-with-cleanup): Ensure no erc-error buffers are hanging around. --- lisp/erc/erc-backend.el | 127 ++++++++++++------ lisp/erc/erc-compat.el | 32 +++++ test/lisp/erc/resources/erc-d/erc-d-tests.el | 5 +- .../erc/resources/erc-scenarios-common.el | 3 + 4 files changed, 121 insertions(+), 46 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ecb13a194c4..34f33e8626f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -995,7 +995,10 @@ erc-server-filter-function (substring erc-server-filter-data (match-end 0)))) (erc-log-irc-protocol line nil) - (erc-parse-server-response process line))))))) + (save-match-data + (unless (string= line "") + (erc-compat--with-backtrace-buffer "*erc-process-error*" + (erc-parse-server-response process line)))))))))) (defun erc--server-reconnect-p (event) "Return non-nil when ERC should attempt to reconnect. @@ -1424,31 +1427,20 @@ erc-send-ctcp-notice ;;;; Handling responses -(defcustom erc-tags-format 'overridable - "Shape of the `tags' alist in `erc-response' objects. -When set to `legacy', pre-5.5 parsing behavior takes effect for -the tags portion of every message. The resulting alist contains -conses of the form (STRING . LIST), in which LIST is comprised of -at most one, possibly empty string. When set to nil, ERC only -parses tags if an active module defines an implementation. It -otherwise ignores them. In such cases, each alist element is a -cons of a symbol and an optional, nonempty string. - -With the default value of `overridable', ERC behaves as it does -with `legacy' except that it emits a warning whenever first -encountering a message containing tags in a given Emacs session. -But it only does so when a module implementing overriding, -non-legacy behavior isn't already active in the current network -context. - -Note that future bundled modules providing IRCv3 functionality -will not be compatible with the legacy format. User code should -eventually transition to expecting this \"5.5+ variant\" and set -this option to nil." - :package-version '(ERC . "5.5") +(defcustom erc-tags-format nil + "Shape of the `tags' alist slot for `erc-response' objects. +When set to `legacy', the alist has members of the form (STRING . LIST), +where LIST contains at most one possibly empty string. When set to nil, +ERC only extracts tags if a connection needs them. It otherwise ignores +them and leaves the slot empty. When needed, each element is a cons +cell of (SYMBOL . STRING-OR-NULL). A value of `warn' tells ERC to +behave like it does with nil except fall back on `legacy' in the absence +of an overriding format for a given connection. It also displays +possibly redundant messages when a format change has occurred." + :package-version '(ERC . "5.7") ; FIXME sync on release (above too) :type '(choice (const nil) (const legacy) - (const overridable))) + (const warn))) (defun erc-parse-tags (string) "Parse IRCv3 tags list in STRING to a (tag . value) alist." @@ -1464,6 +1456,29 @@ erc--parse-tags `(,pair)) tags))))) +(defun erc-get-tag (tag tags) + "Return a cons cell of TAG and maybe its associated value from TAGS." + (assoc tag tags #'string-equal)) + +(defun erc--tags-get (key tags) + "Return KEY's value in TAGS. Like `alist-get' but `erc-tags-format' aware." + (let ((tag (erc-get-tag key tags))) + (if (eq erc-tags-format 'legacy) (cadr tag) (cdr tag)))) + +(gv-define-expander erc--tags-get + (lambda (do tag tags) + (macroexp-let2 macroexp-copyable-p key tag + (gv-letplace (getter _setter) tags + (funcall do `(alist-get ,key ,getter nil nil #'string=) + (lambda (val) + (macroexp-let2 nil val val + `(progn + (setf (alist-get ,key ,getter nil nil #'string=) + (if (eq erc-tags-format 'legacy) + (list ,val) + ,val)) + ,val)))))))) + ;; A benefit of this function being internal is not having to define a ;; separate method just to ensure an `erc-tags-format' value of ;; `legacy' always wins. A downside is that module code must take @@ -1486,21 +1501,39 @@ erc--parse-message-tags " releases. See `erc-tags-format' for more info."))) (erc--parse-tags string))) -(defun erc-parse-server-response (proc string) - "Parse and act upon a complete line from an IRC server. -PROC is the process (connection) from which STRING was received. -PROCs `process-buffer' is `current-buffer' when this function is called." - (unless (string= string "") ;; Ignore empty strings - (save-match-data - (let* ((tag-list (when (eq (aref string 0) ?@) - (substring string 1 - (string-search " " string)))) - (msg (make-erc-response :unparsed string :tags - (when tag-list - (erc--parse-message-tags tag-list)))) - (string (if tag-list - (substring string (+ 1 (string-search " " string))) - string)) +(cl-defgeneric erc--create-response-from-parts (full-line 1459-line tags) + "Parse response from 1459-LINE, considering parsed TAGS and FULL-LINE. +Expect 1459-LINE to be a traditional raw IRC message without a leading +tags portion. Expect TAGS, if non-nil, to conform to the non-legacy +`erc-tags-format'. Return a new `erc-response' object or nil.") + +(cl-defmethod erc--create-response-from-parts (full-line 1459-line tags) + "Parse and decode 1459-LINE into `erc-response' object." + (let ((message (erc--parse-traditional-response 1459-line + :unparsed full-line + :tags tags))) + (erc-decode-parsed-server-response message) + message)) + +(defun erc--partition-line (full-line) + "Return two-tuple list of rfc1459 line and tags list from FULL-LINE. +Strip leading \"@\" and trailing space from FULL-LINE to get 1459 line." + (let ((end (and (eq (aref full-line 0) ?@) (string-search " " full-line)))) + (list (if end (substring full-line (1+ end)) full-line) + (and end (save-match-data + (erc--parse-message-tags + (substring full-line 1 end))))))) + +(defun erc-parse-server-response (process raw-line) + "Parse and act upon a RAW-LINE from PROCESS." + (when-let* ((message (apply #'erc--create-response-from-parts + raw-line (erc--partition-line raw-line)))) + (erc-handle-parsed-server-response process message))) + +(defun erc--parse-traditional-response (string &rest keyword-pairs) + (progn ; preserve indentation until next refactoring + (progn + (let* ((msg (apply #'make-erc-response keyword-pairs)) (posn (if (eq (aref string 0) ?:) (string-search " " string) 0))) @@ -1534,11 +1567,17 @@ erc-parse-server-response (setf (erc-response.command-args msg) (nreverse (erc-response.command-args msg))) - - (erc-decode-parsed-server-response msg) - - (erc-handle-parsed-server-response proc msg))))) - + msg)))) + +;; FIXME this function performs the work of decoding the `contents' slot +;; twice because it's normally `eq' to the last member of +;; `command-args'. Also, `erc-coding-system-for-target' only needs to +;; run once because all slots in an `erc-response' object share the same +;; target and thus the same coding system. ERC's next major version +;; could put off decoding until target discovery, perhaps as a lazy slot +;; on `erc--ztargeted'. If necessary, it could use a heuristic to +;; decode non-ASCII target names for nonstandard "IRC-adjacent" +;; (possibly bridged) protocols. (defun erc-decode-parsed-server-response (parsed-response) "Decode a pre-parsed PARSED-RESPONSE before it can be handled. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4a8029d68ac..c9f4c653539 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -450,6 +450,38 @@ erc-compat--defer-format-spec-in-buffer spec))))) +;;;; Misc 30.1 + +(defvar erc-compat--with-backtrace-buffer-inhibit-p nil) + +(defmacro erc-compat--with-backtrace-buffer (bufname &rest body) + "When BODY fails, print a backtrace in BUFNAME and propagate." + (declare (indent 1)) + `(,@(if (fboundp 'handler-bind) + `(handler-bind + ((error + (lambda (err) + (unless erc-compat--with-backtrace-buffer-inhibit-p + (let ((standard-output (if noninteractive + standard-output + (get-buffer-create ,bufname))) + (info (list :err err + :buffer (current-buffer) + :time (format-time-string "%FT%T.%3NZ" + nil t)))) + (terpri) + (let ((print-escape-newlines t)) + (prin1 info)) + (terpri) + (backtrace) + (unless noninteractive + (signal (car err) + (cons (format "ERC: see buffer %s" ,bufname) + info))))))))) + '(progn)) + ,@body)) + + ;;;; Misc 31.1 (defun erc-compat--window-no-other-p (window) diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index 4964af23b52..b0f2842cb9d 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -264,8 +264,9 @@ erc-d-i--parse-message/privmsg command-args contents tags)) - (let ((ours (erc-d-i--parse-message raw)) - (orig (erc-d-tests--parse-message-upstream raw))) + (let* ((erc-tags-format 'legacy) + (ours (erc-d-i--parse-message raw)) + (orig (erc-d-tests--parse-message-upstream raw))) (ert-info ((format "slot: `%s', orig: %S, ours: %S" slot orig ours)) (if (eq slot 'tags) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index c2453e93616..bf529ac238f 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -137,6 +137,7 @@ erc-scenarios-common--print-trace (quit . ,(erc-quit/part-reason-default)) (erc-version . ,erc-version))) (erc-modules (copy-sequence erc-modules)) + (erc-compat--with-backtrace-buffer-inhibit-p t) (debug-on-error t) (inhibit-interaction noninteractive) (auth-source-do-cache nil) @@ -197,6 +198,8 @@ erc-scenarios-common-with-cleanup (ert-info ("Running extra teardown") (funcall erc-scenarios-common-extra-teardown))) + (should-not (match-buffers (rx "*erc-" (+ (any "a-z-")) + "error*"))) (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) (when (and (boundp 'erc-autojoin-mode) (not (eq erc-autojoin-mode ,orig-autojoin-mode))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0009-WIP-Clearly-define-erc-server-user-info-field-as-an-.patch From c9dadd08833db653e09ddc1e202f45099fcf76de Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 26 Jul 2021 05:40:59 -0700 Subject: [PATCH 09/14] [WIP] Clearly define erc-server-user info field as an alist ;; FIXME add news entry explaining change in erc-server-user schema. ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-server-317): Drop nonstandard usage of `info' slot for misc informational message that's never recalled for later use. This is printed to the buffer anyway, so there's no reason to store degenerate data in the table. Instead, preserve structured data as `idle' entry in erc-server-user-info alist. * lisp/erc/erc-common.el (erc-server-user): Redefine rarely used, confusing `info' slot, formerly an opaque value, and repurpose it as an alist. In the handful of instances where it was used, it was largely misused. Add type descriptions for nickname, host, login, full-name. * lisp/erc/erc-speedbar.el (erc-speedbar-italicize-away, erc-speedbar--italicize-away): Add var and function to facilitate italicizing of away users. (erc-speedbar--expand-info): New function to optionally show various items from the `erc-server-user' `info' alist. (erc-speedbar-expand-user): Appeal to `erc-speedbar--expand-info' for displaying info-derived tags. (erc-speedbar--emulate-sidebar): Conditionally wrap `erc-speedbar--nick-face-function'. * lisp/erc/erc.el (erc-add-server-user): Add optional `info' argument and maybe update `info' field before committing user. (erc-process-away): Add away member with an empty string to `erc-server-user' object's info slot. (erc--server-user-away-p): Add function to extract away field from `info' slot of `erc-server-user'. (erc--server-user-info-collect-p, erc--ensure-server-user-info): New function and internal flag variable to massage obsolete values to be added to the `info' field of an `erc-server-user' object. (erc-update-user): Take special pains to shoehorn `info' into an alist and emit a warning if necessary. * test/lisp/erc/erc-tests.el (erc--ensure-server-user-info): New test. (Bug#49860) --- lisp/erc/erc-backend.el | 9 ++++--- lisp/erc/erc-common.el | 28 +++++++++++++++++--- lisp/erc/erc-speedbar.el | 36 +++++++++++++++++++++---- lisp/erc/erc.el | 54 +++++++++++++++++++++++++++++++++++--- test/lisp/erc/erc-tests.el | 53 +++++++++++++++++++++++++++++++++++++ 5 files changed, 164 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 34f33e8626f..6c99a1d17f8 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2546,9 +2546,10 @@ erc--with-isupport-data (define-erc-response-handler (301) "AWAY notice." nil - (erc-display-message parsed 'notice 'active 's301 - ?n (cadr (erc-response.command-args parsed)) - ?r (erc-response.contents parsed))) + (let ((nick (cadr (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + (erc-update-user-nick nick nil nil nil nil (cons 'away msg) nil) + (erc-display-message parsed 'notice 'active 's301 ?n nick ?r msg))) (define-erc-response-handler (303) "ISON reply" nil @@ -2618,7 +2619,7 @@ erc--with-isupport-data (format-time-string erc-server-timestamp-format (string-to-number on-since)))) (erc-update-user-nick nick nick nil nil nil - (and time (format "on since %s" time))) + (cons 'idle time)) (if time (erc-display-message parsed 'notice 'active 's317-on-since diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index a41d13aee16..d71ddc2d818 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -79,10 +79,30 @@ erc-input (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) - ;; User data - nickname host login full-name info - ;; Buffers - (buffers nil)) + ( nickname nil :type (or null string) + :documentation "The nickname, effectively non-nil and non-empty.") + ( host nil :type (or null string) + :documentation "The hostname.") + ( login nil :type (or null string) + :documentation "The login, also called username.") + ( full-name nil :type (or null string) + :documentation "The full name, also called real name and GECOS.") + ;; This slot was repurposed to accommodate metadata relevant to UI + ;; concerns, such as away status or display names. As of ERC 5.7, + ;; it's an alist of symbols paired with arbitrary values, and its only + ;; known items, when present, are + ;; - `away', a possibly empty string indicating a user is away + ;; (see `erc-server-301') + ;; - `idle', a nonempty string saying how long a user has been idle + ;; (see `erc-server-317') + ;; - `info', a "meta" item for legacy non-alist `info' slot values + ;; (see `erc--ensure-server-user-info') + ( info nil + :type (list-of cons) + :documentation "Alist of `eq'-testable keys with arbitrary values.") + ( buffers nil + :type (list-of buffer) + :documentation "Channel buffers user is joined to.")) (cl-defstruct (erc-channel-user (:type vector) (:constructor diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 720b5cd5d11..63de1b5c5f7 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -299,6 +299,18 @@ erc-speedbar--highlight-self-and-ops erc-button-nickname-face) 'erc-default-face)))) +(defvar erc-speedbar-italicize-away t + "Show channel users who are away in italics.") + +(defun erc-speedbar--italicize-away (orig buffer user cuser) + (let ((others (funcall orig buffer user cuser))) + (if-let* ((info (erc-server-user-info user)) + ((assq 'away info))) + (if others + (cons 'erc-italic-face (ensure-list others)) + 'erc-italic-face) + others))) + (defun erc-speedbar--on-click (nick sbtoken _indent) ;; 0: finger, 1: name, 2: info, 3: buffer-name (with-current-buffer (nth 3 sbtoken) @@ -354,6 +366,20 @@ erc-speedbar-update-channel (speedbar-delete-subblock 1) (erc-speedbar-expand-channel "+" buffer 1))))) +(defun erc-speedbar--expand-info (info indent) + "Create a tag from items in INFO that have a `erc-speedbar-tag' prop. +Expect INFO to be an alist associating symbols with opaque +objects. If the property is a function, call it with the item's +key and value and also the indent level." + (pcase-dolist (`(,key . ,value) info) + (when-let* ((fn (get key 'erc-speedbar-tag)) + ;; FIXME figure out the right way to do this + ;; using the `speedbar' API. + (tag (if (functionp fn) + (funcall fn key value indent) + (format "%s: %s" key value)))) + (speedbar-make-tag-line nil nil nil nil tag nil nil nil (1+ indent))))) + (defun erc-speedbar-expand-user (text token indent) (cond ((string-search "+" text) (speedbar-change-expand-button-char ?-) @@ -374,10 +400,7 @@ erc-speedbar-expand-user name nil nil nil (1+ indent))) (when info - (speedbar-make-tag-line - nil nil nil nil - info nil nil nil - (1+ indent))))))) + (erc-speedbar--expand-info info indent)))))) ((string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) @@ -486,7 +509,10 @@ erc-speedbar--emulate-sidebar (when (memq 'nicks erc-modules) (with-current-buffer speedbar-buffer (add-function :around (local 'erc-speedbar--nick-face-function) - #'erc-speedbar--compose-nicks-face)))) + #'erc-speedbar--compose-nicks-face))) + (when erc-speedbar-italicize-away + (add-function :around (local 'erc-speedbar--nick-face-function) + #'erc-speedbar--italicize-away '((depth . 50))))) (defun erc-speedbar--handle-delete-frame (event) "Disable the nickbar if EVENT is deleting the proxy frame." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index dcda1f4cc49..bf550f9bb92 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -548,11 +548,13 @@ erc--casemapping-rfc1459 (aset cup ?~ ?~) tbl)) -(defun erc-add-server-user (nick user) +(defun erc-add-server-user (nick user &optional info) "This function is for internal use only. Adds USER with nickname NICK to the `erc-server-users' hash table." (erc-with-server-buffer + (when info + (erc--ensure-server-user-info user info)) (puthash (erc-downcase nick) user erc-server-users))) (defvar erc--decouple-query-and-channel-membership-p nil @@ -7104,6 +7106,7 @@ erc-process-away If non-nil, return from being away." (let ((sessionbuf (process-buffer proc))) (when sessionbuf + (cl-assert (eq sessionbuf (current-buffer))) (with-current-buffer sessionbuf (when erc-away-nickname (erc-log (format "erc-process-away: away-nick: %s, away-p: %s" @@ -7111,6 +7114,11 @@ erc-process-away (erc-cmd-NICK (if away-p erc-away-nickname erc-nick))) + (when-let* ((user (erc-get-server-user (erc-current-nick))) + ((not (and away-p + (alist-get 'away + (erc-server-user-info user)))))) + (erc-update-user user nil nil nil nil (cons 'away (and away-p "")))) (cond (away-p (setq erc-away (current-time))) @@ -7278,6 +7286,40 @@ erc-update-user-nick (erc-update-user (erc-get-server-user nick) new-nick host login full-name info)) +(defun erc--server-user-away-p (user) + "Return a possibly empty away message when USER is away. +Expect USER to be a `erc-server-user' object." + (alist-get 'away (erc-server-user-info user))) + +(defvar erc--server-user-info-collect-p nil + "Escape hatch for pre-ERC 5.7 `erc-server-user-info' interface. +When non-nil, ERC adds non-list `info' slot update values to a +list of existing ones stored in the `info' item in the +`erc-server-user-info' alist. Otherwise, it replaces the current +`info' alist value.") ; FIXME sync version on release + +(defun erc--ensure-server-user-info (user info) + "Normalize INFO to conform to `info' slot of `erc-server-user'. +When INFO is a list whose CAR is a symbol, update or create +`erc-server-user-info' instead, removing matching members if +INFO's CDR is nil." + (cond + ((consp (car-safe info)) + (setf (erc-server-user-info user) info)) + ((consp info) + (setf (alist-get (car info) (erc-server-user-info user) nil t #'eq) + (cdr info))) + ((progn (erc-button--display-error-notice-with-keys-and-warn + "Non-alist value given for `info' field of `erc-server-user' " + (erc-server-user-nickname user) + "; storing as alist `info' item " + (if erc--server-user-info-collect-p "(info %S ...)" "(info . %S)") + " instead." (or info (make-symbol "nil"))) + nil)) + (erc--server-user-info-collect-p + (push info (alist-get 'info (erc-server-user-info user)))) + (t (setf (alist-get 'info (erc-server-user-info user)) info)))) + (defun erc-update-user (user &optional new-nick host login full-name info) "Update user info for USER. @@ -7286,6 +7328,11 @@ erc-update-user existing values for USER are used to replace the stored values in USER. +In addition to being a complete replacement for the object's info slot, +INFO can also be a single cons pair indicating a member of the existing +`info' field to update. In such cases, a nil CDR will cause the member +to be deleted. + If, and only if, a change is made, `erc-channel-members-changed-hook' is run for each channel for which USER is a member, and t is returned." @@ -7312,7 +7359,7 @@ erc-update-user (when (and info (not (equal (erc-server-user-info user) info))) (setq changed t) - (setf (erc-server-user-info user) info)) + (erc--ensure-server-user-info user info)) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) @@ -7347,7 +7394,8 @@ erc--create-current-channel-member :full-name full-name :login login :info nil - :buffers (list (current-buffer)))))) + :buffers (list (current-buffer)))) + info)) (let ((cusr (erc-channel-user--make :status (or status 0) :last-message-time (and timep diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3e4e6331b67..56a3267523a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4254,4 +4254,57 @@ erc-retrieve-catalog-entry ;; Terminates. (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) +(ert-deftest erc--ensure-server-user-info () + (with-current-buffer (get-buffer-create "*erc-tests*") + (erc-mode) + (erc--initialize-markers (point) nil) + (should-not erc--server-user-info-collect-p) + + (let ((user (make-erc-server-user :nickname "tester" :login "testeroni" + :info '((a . 1)))) + (erc--server-user-info-collect-p t)) + + (cl-letf (((symbol-function 'display-warning) #'ignore)) + (ert-info ("Collects when `erc--server-user-info-collect-p' non-nil") + (erc--ensure-server-user-info user 42) + (should (equal (erc-server-user-info user) '((info 42) (a . 1)))) + (erc--ensure-server-user-info user 'foo) + (should + (equal (erc-server-user-info user) '((info foo 42) (a . 1))))) + + (ert-info ("Replaces when `erc--server-user-info-collect-p' nil") + (setq erc--server-user-info-collect-p nil) + (erc--ensure-server-user-info user 'bar) + (should (equal (erc-server-user-info user) '((info . bar) (a . 1)))) + (erc--ensure-server-user-info user 'nil) + (should (equal (erc-server-user-info user) '((info . nil) (a . 1)))) + (should (equal (pop (erc-server-user-info user)) '(info))))) + + (erc--ensure-server-user-info user '((b . 2))) + (should (equal (erc-server-user-info user) '((b . 2)))) + + (erc--ensure-server-user-info user '(b . 3)) + (should (equal (erc-server-user-info user) '((b . 3)))) + + (erc--ensure-server-user-info user '(c . 4)) + (should (equal (erc-server-user-info user) '((c . 4) (b . 3)))) + + (erc--ensure-server-user-info user '(b . 5)) + (should (equal (erc-server-user-info user) '((c . 4) (b . 5)))) + + (erc--ensure-server-user-info user '(b . nil)) + (should (equal (erc-server-user-info user) '((c . 4)))) + + (erc--ensure-server-user-info user '(c . nil)) + (should-not (erc-server-user-info user)) + + (goto-char (point-min)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should-not (search-forward "Non-alist value given" nil t))) + + (when noninteractive (kill-buffer)))) + ;;; erc-tests.el ends here -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0010-WIP-Add-account-slot-to-erc-server-user.patch From deab7d6d2fa74502dcde559a241c4ac21f9410b9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 7 Aug 2022 04:12:41 -0700 Subject: [PATCH 10/14] [WIP] Add account slot to erc-server-user ;; FIXME update stale change log before merging. ;; There's some unrelated stuff in erc-button that could go elsewhere. ;; FIMXE combine this with preceding info patch if merging. ;; FIXME add a news entry for all changes to `erc-server-user' and the ;; meaning of empty strings in `erc-update-user'. * lisp/erc/erc-backend.el (erc-server-301): Update user state before displaying message. * lisp/erc/erc-common.el (erc-server-user): Add `account' slots for nick-services account name. * lisp/erc/erc.el (erc-add-server-user): Ensure slots with empty strings whose type can be null or a string are set to nil. (erc-update-user-nick, erc-update-user) (erc-update-current-channel-member, erc-update-channel-member): Add `account' and `away' and parameters. --- lisp/erc/erc-backend.el | 9 ++++- lisp/erc/erc-button.el | 24 ++++++++++--- lisp/erc/erc-common.el | 7 ++++ lisp/erc/erc.el | 77 ++++++++++++++++++++++++++--------------- 4 files changed, 85 insertions(+), 32 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 6c99a1d17f8..3c6f8e8d866 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -187,7 +187,7 @@ erc-verbose-server-ping (declare-function erc-update-channel-topic "erc" (channel topic &optional modify)) (declare-function erc-update-user-nick "erc" - (nick &optional new-nick host login full-name info)) + (nick &optional new-nick host login full-name info account)) (declare-function erc-open "erc" (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id)) @@ -195,6 +195,8 @@ erc-verbose-server-ping (channel nick new-nick &optional add voice halfop op admin owner host login full-name info update-message-time)) +(declare-function erc-update-user-nick "erc" + (nick &optional new-nick host login full-name info account)) ;;;; Variables and options @@ -2709,6 +2711,11 @@ erc-server-322-message (let ((nick (cadr (erc-response.command-args parsed))) (authaccount (nth 2 (erc-response.command-args parsed))) (authmsg (erc-response.contents parsed))) + ;; The 2025 modern docs say: "This does not necessarily mean the + ;; user owns their current nickname, which is covered + ;; byRPL_WHOISREGNICK." The `erc-server-user' slot carries no such + ;; ownership implications either. + (erc-update-user-nick nick nil nil nil nil nil authaccount) (erc-display-message parsed 'notice 'active 's330 ?n nick ?a authmsg ?i authaccount))) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index ac646ed507f..e088d5ebb1b 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -415,17 +415,23 @@ erc-button--get-user-from-spkr-prop (cl-defstruct (erc--phantom-channel-user (:include erc-channel-user))) (cl-defstruct (erc--phantom-server-user (:include erc-server-user))) -(defun erc-button--add-phantom-speaker (downcased nuh _parsed) +(defun erc-button--add-phantom-speaker (downcased nuh parsed) (pcase-let* ((`(,nick ,login ,host) nuh) (cmem (gethash downcased erc-button--phantom-cmems)) + (account (and-let* ((tags (erc-response.tags parsed))) + (erc--tags-get 'account tags))) (user (or (car cmem) (make-erc--phantom-server-user :nickname nick :host (and (not (string-empty-p host)) host) - :login (and (not (string-empty-p login)) login)))) + :login (and (not (string-empty-p login)) login) + :account account))) (cuser (or (cdr cmem) (make-erc--phantom-channel-user - :last-message-time (current-time))))) + :last-message-time (erc--current-time-pair))))) + ;; Can't create `erc-data' object yet without access to the + ;; inserted nick, which we'd need to preserve a weak reference + ;; against `erc-button--nicks-to-data'. (puthash downcased (cons user cuser) erc-button--phantom-cmems) (cons user cuser))) @@ -458,6 +464,15 @@ erc-button--phantom-users-mode #'erc-button--get-phantom-cmem) (kill-local-variable 'erc-button--phantom-cmems))) +(defun erc-button--deemphasize-plebs (nick-object) + "Don't embolden nicks lacking status prefixes." + (when (and nick-object + (erc-button--nick-cusr nick-object) + (let ((cusr (erc-button--nick-cusr nick-object))) + (or (null cusr) (zerop (erc-channel-user-status cusr))))) + (setf (erc-button--nick-nickname-face nick-object) nil)) + nick-object) + (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." (when-let* ((form (nth 2 entry)) @@ -487,7 +502,8 @@ erc-button-add-nickname-buttons down word bounds seen)))) (user (or (and cmem (car cmem)) (and erc-server-users (gethash down erc-server-users)))) - (data (list word))) + ;; Use the nick that's already stored. + (data (and user (list (erc-server-user-nickname user))))) (when (or (not (functionp form)) (and user (setq nick-obj (funcall form (make-erc-button--nick diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d71ddc2d818..d63cd89cde5 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -100,6 +100,13 @@ erc-input ( info nil :type (list-of cons) :documentation "Alist of `eq'-testable keys with arbitrary values.") + ;; This slot could potentially be used for draft/account-id as well, + ;; which would either supersede a normal account name or coexist + ;; alongside one, via some encoding scheme. + ;; https://github.com/ircv3/ircv3-specifications/issues/402 + ( account nil + :type (or null string) + :documentation "Account logged into, which may not own nickname.") ( buffers nil :type (list-of buffer) :documentation "Channel buffers user is joined to.")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bf550f9bb92..7adbe28a4ca 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -550,8 +550,18 @@ erc--casemapping-rfc1459 (defun erc-add-server-user (nick user &optional info) "This function is for internal use only. - -Adds USER with nickname NICK to the `erc-server-users' hash table." +Add `erc-server-user' USER with string NICK to `erc-server-users'. +Ensure slots login, host, full-name, and account in USER are nil instead +of the empty string. Optionally massage INFO with a la carte updates +and deletions." + (when (string-empty-p (erc-server-user-login user)) + (setf (erc-server-user-login user) nil)) + (when (string-empty-p (erc-server-user-host user)) + (setf (erc-server-user-host user) nil)) + (when (string-empty-p (erc-server-user-full-name user)) + (setf (erc-server-user-full-name user) nil)) + (when (member (erc-server-user-account user) '("" "*")) + (setf (erc-server-user-account user) nil)) (erc-with-server-buffer (when info (erc--ensure-server-user-info user info)) @@ -7279,12 +7289,11 @@ erc-channel-receive-names (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick - host login full-name info) + host login full-name info account) "Update the stored user information for the user with nickname NICK. - -See also: `erc-update-user'." - (erc-update-user (erc-get-server-user nick) new-nick - host login full-name info)) +Do nothing if the user doesn't exist." + (when-let* ((user (erc-get-server-user nick))) + (erc-update-user user new-nick host login full-name info account))) (defun erc--server-user-away-p (user) "Return a possibly empty away message when USER is away. @@ -7321,12 +7330,13 @@ erc--ensure-server-user-info (t (setf (alist-get 'info (erc-server-user-info user)) info)))) (defun erc-update-user (user &optional new-nick - host login full-name info) + host login full-name info account) "Update user info for USER. -USER must be an erc-server-user struct. Any of NEW-NICK, HOST, -LOGIN, FULL-NAME, INFO which are non-nil and not equal to the -existing values for USER are used to replace the stored values in -USER. +Replace slot values in in USER, an `erc-server-user' struct, with +NEW-NICK, HOST, LOGIN, FULL-NAME, and ACCOUNT if non-nil and not +`equal'. If HOST, LOGIN, FULL-NAME, or ACCOUNT are an empty string, set +the slot to nil. Do so as well if ACCOUNT is a string containing a lone +asterisk. In addition to being a complete replacement for the object's info slot, INFO can also be a single cons pair indicating a member of the existing @@ -7346,20 +7356,31 @@ erc-update-user (when (and host (not (equal (erc-server-user-host user) host))) (setq changed t) - (setf (erc-server-user-host user) host)) + (setf (erc-server-user-host user) + (and (not (string-empty-p host)) host))) (when (and login (not (equal (erc-server-user-login user) login))) (setq changed t) - (setf (erc-server-user-login user) login)) + (setf (erc-server-user-login user) + (and (not (string-empty-p login)) login))) (when (and full-name (not (equal (erc-server-user-full-name user) full-name))) (setq changed t) - (setf (erc-server-user-full-name user) full-name)) + (setf (erc-server-user-full-name user) + (and (not (string-empty-p full-name)) full-name))) (when (and info (not (equal (erc-server-user-info user) info))) (setq changed t) (erc--ensure-server-user-info user info)) + (when (and account + (not (equal (erc-server-user-account user) account)) + ;; Don't report a change when unset and already nil + (or (not (equal account "*")) + (erc-server-user-account user))) + (setq changed t) + (setf (erc-server-user-account user) + (and (not (member account '("" "*"))) account))) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) @@ -7368,13 +7389,13 @@ erc-update-user changed)) (defun erc--create-current-channel-member - (nick status timep &optional new-nick host login full-name info) + (nick status timep &optional new-nick host login full-name info account) "Add an `erc-channel-member' entry for NICK. Create a new `erc-server-users' entry if necessary, and ensure `erc-channel-members-changed-hook' runs exactly once, regardless. Pass STATUS to the `erc-channel-user' constructor. With TIMEP, assume NICK has just spoken, and initialize `last-message-time'. -Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, INFO, and ACCOUNT to `erc-update-user' if a server user exists and otherwise to the `erc-server-user' constructor." (cl-assert (null (erc-get-channel-member nick))) @@ -7386,7 +7407,7 @@ erc--create-current-channel-member (cl-pushnew (current-buffer) (erc-server-user-buffers user)) ;; Update *after* ^ so hook has chance to run. (setf user-changed-p (erc-update-user user new-nick host login - full-name info))) + full-name info account))) (erc-add-server-user nick (setq user (make-erc-server-user :nickname (or new-nick nick) @@ -7394,6 +7415,7 @@ erc--create-current-channel-member :full-name full-name :login login :info nil + :account account :buffers (list (current-buffer)))) info)) (let ((cusr (erc-channel-user--make @@ -7437,12 +7459,12 @@ erc--update-current-channel-member (defun erc-update-current-channel-member (nick new-nick &optional addp voice halfop op admin owner host login - full-name info update-message-time) + full-name info update-message-time account) "Update or create entry for NICK in current `erc-channel-members' table. With ADDP, ensure an entry exists. When an entry does exist or when ADDP is non-nil and an `erc-server-users' entry already exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN, -FULL-NAME, and INFO. Expect any non-nil membership +FULL-NAME, INFO, and ACCOUNT. Expect any non-nil membership status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the symbol `on' or `off' when needing to influence a new or existing `erc-channel-user' object's `status' slot. Likewise, @@ -7471,23 +7493,24 @@ erc-update-current-channel-member (if cmem (erc--update-current-channel-member cmem status update-message-time new-nick host login - full-name info) + full-name info account) (when addp (erc--create-current-channel-member nick status update-message-time new-nick host login - full-name info))))) + full-name info account))))) (defun erc-update-channel-member (channel nick new-nick - &optional add voice halfop op admin owner host login - full-name info update-message-time) + &optional add voice halfop op admin + owner host login full-name info + update-message-time account) "Update user and channel for user with nickname NICK in channel CHANNEL. See also: `erc-update-current-channel-member'." (erc-with-buffer (channel) - (erc-update-current-channel-member nick new-nick add voice halfop op admin owner host - login full-name info - update-message-time))) + (erc-update-current-channel-member nick new-nick add voice halfop op admin + owner host login full-name info + update-message-time account))) (defun erc-remove-current-channel-member (nick) "Remove NICK from current channel membership list. -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0011-WIP-Make-updating-last-message-time-more-flexible-in.patch From 9053a0998ef9d64380e36cccd6a8902489725963 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 6 Sep 2023 19:52:20 -0700 Subject: [PATCH 11/14] [WIP] Make updating last-message-time more flexible in ERC ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc--time-pair-from-time-tag): New function. (erc-server-TOPIC): Attempt to display time from server-time tag. * lisp/erc/erc-common.el (erc--current-time-pair-function): New variable. (erc--current-time-pair): New function and variable of the same name. (erc--current-lisp-time): New function. (erc-call-hooks): Bind `erc--parse-response' when dispatching response handlers. * lisp/erc/erc-compat.el (erc-compat--iso8601-to-time): New function. (erc-compat--27-iso8601-parse-time): New function. * lisp/erc/erc-stamp.el (erc-stamp--current-time): Replace generic function with normal function. Defer to `erc--current-time-pair' so that features related to IRCv3 time stamps don't need to depend on the `stamp' module. * lisp/erc/erc.el (erc-update-current-channel-member): Use `erc--current-time-pair' instead of `current-time' for updating `last-message-time' slot of channel users. (erc--update-cusr-message-time): New function. * test/lisp/erc/erc-fill-tests.el (erc-stamp--current-time): Remove method. (erc-fill-tests--current-time-value): Remove unused variable. (erc-fill-tests--wrap-populate, erc-fill-wrap--merge) (erc-fill-wrap--merge-action): Update variable name. * test/lisp/erc/erc-tests.el (erc-compat--iso8601-to-time): New test. (Bug#49860) --- lisp/erc/erc-backend.el | 8 ++- lisp/erc/erc-common.el | 15 ++++++ lisp/erc/erc-compat.el | 96 +++++++++++++++++++++++++++++++++ lisp/erc/erc-stamp.el | 7 +-- lisp/erc/erc.el | 15 +++--- test/lisp/erc/erc-fill-tests.el | 11 ++-- test/lisp/erc/erc-tests.el | 15 ++++++ 7 files changed, 147 insertions(+), 20 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 3c6f8e8d866..77a75480859 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1503,6 +1503,11 @@ erc--parse-message-tags " releases. See `erc-tags-format' for more info."))) (erc--parse-tags string))) +(defun erc--time-pair-from-time-tag (parsed) + "Return stamp from `tags' slot of PARSED as lisp-time pair if found." + (and-let* ((stamp (erc--tags-get 'time (erc-response.tags parsed))) + ((erc-compat--iso8601-to-time stamp t))))) + (cl-defgeneric erc--create-response-from-parts (full-line 1459-line tags) "Parse response from 1459-LINE, considering parsed TAGS and FULL-LINE. Expect 1459-LINE to be a traditional raw IRC message without a leading @@ -2342,7 +2347,8 @@ erc--speaker-status-prefix-wanted-p "The channel topic has changed." nil (let* ((ch (car (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) - (time (format-time-string erc-server-timestamp-format))) + (time (format-time-string erc-server-timestamp-format + (erc--time-pair-from-time-tag parsed)))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d63cd89cde5..5759330dc94 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -584,6 +584,21 @@ erc-log (when erc-log-p (erc-log-aux ,string)))) +(defvar erc--current-time-pair-function #'erc--current-lisp-time + "Internal advice interface for `erc--current-time-pair'.") + +(defun erc--current-lisp-time () + "Call `current-time', preferring ticks-hertz if available." + (erc-compat--current-lisp-time)) + +(defvar erc--current-time-pair nil + "Override return value for function of the same name.") + +(define-inline erc--current-time-pair () + "Return lisp timestamp in preferred form." + (inline-quote (or erc--current-time-pair + (funcall erc--current-time-pair-function)))) + (defun erc-downcase (string) "Return a downcased copy of STRING with properties. Use the CASEMAPPING ISUPPORT parameter to determine the style." diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index c9f4c653539..e93ffe635e5 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -428,6 +428,102 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(declare-function decoded-time-set-defaults "time-date" + (time &optional default-zone)) +(declare-function iso8601-parse "iso8601" (string &optional form)) +(declare-function timezone-make-date-arpa-standard "timezone" + (date &optional local timezone)) + +(defun erc-compat--iso8601-to-time (date &optional form) + "Convert DATE to a timestamp with subsecond precision. +On Emacs 29+, always prefer the (TICKS . HZ) form, even for +stamps lacking a fractional component, meaning they represent the +instant a whole second transpired, on the dot. Expect DATE to be +`iso8601-valid-p' and FORM something accepted by `decode-time'." + (require 'iso8601) + (when (= emacs-major-version 27) + (advice-add 'iso8601-parse-time :override + #'erc-compat--27-iso8601-parse-time)) + (let* ((post-convert-p (< emacs-major-version 29)) + (stamp (condition-case _ + (unwind-protect + (let ((parsed (iso8601-parse date form))) + ;; On 29+, coerce stamps with trailing + ;; zeroes to (TICKS . HZ) form + (unless (consp (car parsed)) + (setq post-convert-p t)) + (when (decoded-time-year parsed) + (decoded-time-set-defaults parsed)) + (encode-time parsed)) + (when (= emacs-major-version 27) + (advice-remove 'iso8601-parse-time + #'erc-compat--27-iso8601-parse-time))) + ;; On <29, trailing fractional 0s, like + ;; "01:00:23.000", cause (truncate -1.0e+INF). + (overflow-error + (let* ((ts (timezone-make-date-arpa-standard date)) + (parsed (if (>= emacs-major-version 29) + (parse-time-string ts form) + (parse-time-string ts)))) + (encode-time parsed)))))) + (if post-convert-p + (time-convert stamp (>= emacs-major-version 29)) + stamp))) + +(declare-function iso8601--match "iso8601" (regexp string)) +(declare-function iso8601--decimalize "iso8601" (fraction base)) +(declare-function iso8601--decoded-time "iso8601" (&rest rest)) +(declare-function iso8601-parse-zone "iso8601" (string)) + +(defun erc-compat--27-iso8601-parse-time (string &optional form) + "Parse STRING, which should be an ISO 8601 time string. +See `decode-time' for the meaning of FORM." + (defvar iso8601--full-time-match) + (defvar iso8601--time-match) + (require 'iso8601) + (cl-assert (= 27 emacs-major-version)) + (if (not (iso8601--match iso8601--full-time-match string)) + (signal 'wrong-type-argument (list string)) + (let ((time (match-string 1 string)) + (zone (match-string 2 string))) + (if (not (iso8601--match iso8601--time-match time)) + (signal 'wrong-type-argument (list string)) + (let ((hour (string-to-number (match-string 1 time))) + (minute (and (match-string 2 time) + (string-to-number (match-string 2 time)))) + (second (and (match-string 3 time) + (string-to-number (match-string 3 time)))) + (frac-string (match-string 4 time)) + fraction fraction-precision) + (when frac-string + ;; Remove trailing zeroes. + (setq frac-string + (replace-regexp-in-string "0+\\'" "" frac-string)) + (when (length> frac-string 0) + (setq fraction (string-to-number frac-string) + fraction-precision (length frac-string)))) + (when (and fraction + (eq form t)) + (cond + ;; Sub-second time. + (second + (setq second (cons (+ (* second (expt 10 fraction-precision)) + fraction) + (expt 10 fraction-precision)))) + ;; Fractional minute. + (minute + (setq second (iso8601--decimalize fraction 60))) + (hour + ;; Fractional hour. + (setq minute (iso8601--decimalize fraction 60))))) + (iso8601--decoded-time :hour hour + :minute (or minute 0) + :second (or second 0) + :dst (if (= (length zone) 1) nil -1) + :zone (and zone + (* 60 (iso8601-parse-zone + zone))))))))) + (defmacro erc-compat--defer-format-spec-in-buffer (&rest spec) "Transform SPEC forms into functions that run in the current buffer. For convenience, ensure function wrappers return \"\" as a diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d49cf8f05e7..3ad761ddd99 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -209,13 +209,10 @@ erc-stamp--current-time Specifically, this is the same Lisp time object used to create the stamp passed to `erc-insert-timestamp-function'.") -(cl-defgeneric erc-stamp--current-time () +(defun erc-stamp--current-time () "Return a Lisp time object to associate with an IRC message. This becomes the message's `erc--ts' text property." - (erc-compat--current-lisp-time)) - -(cl-defmethod erc-stamp--current-time :around () - (or erc-stamp--current-time (cl-call-next-method))) + (or erc-stamp--current-time (erc--current-time-pair))) (defvar erc-stamp--allow-unmanaged-p nil "Non-nil means run `erc-add-timestamp' almost unconditionally. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7adbe28a4ca..6ebc688ce4b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4195,8 +4195,7 @@ erc-send-input-line "Send LINE to TARGET." (when-let* ((target) (cmem (erc-get-channel-member (erc-current-nick)))) - (setf (erc-channel-user-last-message-time (cdr cmem)) - (erc-compat--current-lisp-time))) + (erc--update-cusr-message-time (cdr cmem) (erc--current-time-pair))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -7420,8 +7419,7 @@ erc--create-current-channel-member info)) (let ((cusr (erc-channel-user--make :status (or status 0) - :last-message-time (and timep - (erc-compat--current-lisp-time))))) + :last-message-time (and timep (erc--current-time-pair))))) (puthash down (cons user cusr) erc-channel-users)) ;; An existing `cusr' was changed or a new one was added, and ;; `user' was not updated, though possibly just created (since @@ -7444,8 +7442,7 @@ erc--update-current-channel-member (setf (erc-channel-user-status cusr) status cusr-changed-p t)) (when timep - (setf (erc-channel-user-last-message-time cusr) - (erc-compat--current-lisp-time))) + (erc--update-cusr-message-time cusr (erc--current-time-pair))) ;; Ensure `erc-channel-members-changed-hook' runs on change. (cl-assert (memq (current-buffer) (erc-server-user-buffers user))) (setq user-changed-p (apply #'erc-update-user user user-args)) @@ -7541,6 +7538,12 @@ erc-update-channel-topic (t (setq erc-channel-topic topic))) (erc-update-mode-line-buffer (current-buffer)))) +(defun erc--update-cusr-message-time (cusr new-time) + "Maybe update message time for `erc-channel-user' CUSR to NEW-TIME." + (let ((old-time (erc-channel-user-last-message-time cusr))) + (when (or (null old-time) (time-less-p old-time new-time)) + (setf (erc-channel-user-last-message-time cusr) new-time)))) + (defun erc-set-modes (tgt mode-string) "Set the modes for the TGT provided as MODE-STRING." (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 13a3e107d38..97dbeb4e9f8 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -31,11 +31,6 @@ (require 'erc-tests-common))) (defvar erc-fill-tests--buffers nil) -(defvar erc-fill-tests--current-time-value nil) - -(cl-defmethod erc-stamp--current-time - (&context (erc-fill-tests--current-time-value integer)) - erc-fill-tests--current-time-value) (defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) @@ -56,7 +51,7 @@ erc-fill-tests--wrap-populate (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) (inhibit-message noninteractive) - (erc-fill-tests--current-time-value 0) + (erc-stamp--current-time 0) erc-insert-post-hook extended-command-history erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -219,7 +214,7 @@ erc-fill-wrap--merge ;; Set this here so that the first few messages are from 1970. ;; Following the current date stamp, the speaker isn't merged ;; even though it's continued: "<bob> zero." - (let ((erc-fill-tests--current-time-value 1680332400)) + (let ((erc-stamp--current-time 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") (erc-fill-tests--insert-privmsg "alice" "two.") @@ -255,7 +250,7 @@ erc-fill-wrap-tests--merge-action (lambda () ;; Allow prior messages to be from 1970. - (let ((erc-fill-tests--current-time-value 1680332400)) + (let ((erc-stamp--current-time 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "bob" "0.5") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 56a3267523a..038217c4742 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4307,4 +4307,19 @@ erc--ensure-server-user-info (when noninteractive (kill-buffer)))) +(ert-deftest erc-compat--iso8601-to-time () + + ;; This first one is just for comparison. + (should (equal (erc-compat--iso8601-to-time "2023-09-23T07:48:02.933Z" t) + (if (>= emacs-major-version 29) + '(1695455282933 . 1000) + '(25870 38962 933000 0)))) + + ;; Notice the <29 version retains 0s for its micro and pico fields, + ;; which doesn't normally happen when encoding a decoded time obj. + (should (equal (erc-compat--iso8601-to-time "2023-09-23T07:48:02.000Z" t) + (if (>= emacs-major-version 29) + '(1695455282 . 1) + '(25870 38962 0 0))))) + ;;; erc-tests.el ends here -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0012-WIP-Make-erc-insert-line-overridable.patch From e62bd6772f745932068c0f4b5be32fb5bb44e503 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 18 Jul 2021 04:33:17 -0700 Subject: [PATCH 12/14] [WIP] Make erc-insert-line overridable ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc--register-connection-function): New variable. (erc--register-connection): Perform login indirectly, via `erc--register-connection-function'. * lisp/erc/erc-goodies.el (erc-scrolltobottom-confirm): Also recenter when inserting above `erc--insert-marker'. * lisp/erc/erc.el (erc-insert-line): Make obsolete, move body to new internal generic function `erc--insert-line'. (erc--insert-line): Add new generic function to take the place of the now deprecated `erc-insert-line'. (erc--route-insertion): Suppress obsolete warning when calling `erc-insert-line'. (erc--partition-prefixed-names): Convert to generic method. (erc--send-input-lines): Convert to generic function to allow modules control over fundamental insertion and sending operations, which is necessary for next-generation features, like multiline messages. --- lisp/erc/erc-backend.el | 6 ++++-- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 17 +++++++++++++---- 3 files changed, 18 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 77a75480859..fea65765d2d 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -714,10 +714,12 @@ 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 () +(defvar erc--register-connection-function #'erc-login) + +(defun erc--register-connection () "Perform opening IRC protocol exchange with server." (run-hooks 'erc--server-post-connect-hook) - (erc-login)) + (funcall erc--register-connection-function)) (defvar erc--server-post-dial-function #'erc--server-propagate-failed-connection diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 5da13409842..1a0ae836523 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -209,7 +209,7 @@ erc--scrolltobottom-confirm (let ((resize-mini-windows nil)) (save-restriction (widen) - (when (>= (window-point) erc-input-marker) + (when (>= (window-point) (or erc--insert-marker erc-input-marker)) (save-excursion (goto-char (point-max)) (recenter (+ (or scroll-to 0) (or erc-input-line-position -1))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6ebc688ce4b..8243034661d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3528,8 +3528,16 @@ erc-insert-line STRING, which may make it appear incongruous in situ (unless preformatted or anticipated by third-party members of the various modification hooks)." + (declare (obsolete "use higher-level `erc-display-message'" "30.1")) (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) + (erc--insert-line string)))) + +(cl-defmethod erc--insert-line (string) + "Perform work historically done by `erc-insert-line'. +This is always called in the buffer where STRING is to be inserted." + (progn ; Preserve indentation until next major refactoring + (progn (let (insert-position) ;; Initialize ^ below to thwart rogue `erc-insert-pre-hook' ;; members that dare to modify the buffer's length. @@ -3543,7 +3551,7 @@ erc-insert-line '(invisible intangible) string))) (erc-log (concat "erc-display-message: " string (format "(%S)" string) " in buffer " - (format "%s" buffer))) + (format "%s" (current-buffer)))) (setq erc-insert-this t) (run-hook-with-args 'erc-insert-pre-hook string) (setq insert-position (marker-position (or erc--insert-marker @@ -3634,7 +3642,8 @@ erc--route-insertion (when (buffer-live-p buf) (when msg-props (setq erc--msg-props (copy-hash-table msg-props))) - (erc-insert-line string buf) + (with-suppressed-warnings ((obsolete erc-insert-line)) + (erc-insert-line string buf)) (setq seen t))) (unless (or seen (null buffer)) (erc--route-insertion string nil)))) @@ -7252,7 +7261,7 @@ erc-channel-members-changed-hook :group 'erc-hooks :type 'hook) -(defun erc--partition-prefixed-names (name) +(cl-defmethod erc--partition-prefixed-names (name) "From NAME, return a list of (STATUS NICK LOGIN HOST). Expect NAME to be a prefixed name, like @bob." (unless (string-empty-p name) @@ -8412,7 +8421,7 @@ erc--run-send-hooks (user-error "Multiline command detected" )) lines-obj) -(defun erc--send-input-lines (lines-obj) +(cl-defmethod erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (let ((insertp (erc--input-split-insertp lines-obj)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0013-WIP-Fix-some-message-display-bugs-in-erc-backend.patch From 3d6fb97a3e7a7e4e930c520e01ecce7e8ccb4945 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 29 Feb 2024 21:14:53 -0800 Subject: [PATCH 13/14] [WIP] Fix some message display bugs in erc-backend * lisp/erc/erc-backend.el (erc-server-JOIN, erc-server-NICK): Return nil. (erc-server-PART): Fix thinko involving positional arguments where a channel would be displayed twice when a trailing reason was absent. (erc-server-353): Receive names before inserting message so that insertion hooks have the latest user information. Return nil so that user code wanting to run afterwards on the handler hook can do so, since the return value of `erc-display-message' is undefined. --- lisp/erc/erc-backend.el | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index fea65765d2d..9c70665b329 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1972,7 +1972,8 @@ erc--server-determine-join-display-context (erc--ensure-query-member nick)) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) - (apply #'erc-display-message parsed 'notice buffer args)))))) + (apply #'erc-display-message parsed 'notice buffer args))))) + nil) (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil @@ -2101,12 +2102,14 @@ erc--wrangle-query-buffers-on-nick-change (erc--ensure-query-member nn)) (erc-handle-user-status-change 'nick (list nick login host) (list nn)) (erc-display-message parsed 'notice bufs 'NICK ?n nick - ?u login ?h host ?N nn)))))) + ?u login ?h host ?N nn))))) + nil) (define-erc-response-handler (PART) "Handle part messages." nil (let* ((chnl (car (erc-response.command-args parsed))) - (reason (erc-trim-string (erc-response.contents parsed))) + (reason (erc-trim-string (and (cdr (erc-response.command-args parsed)) + (erc-response.contents parsed)))) (buffer (erc-get-buffer chnl proc))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) @@ -2357,7 +2360,8 @@ erc--speaker-status-prefix-wanted-p (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) 'TOPIC ?n nick ?u login ?h host - ?c ch ?T topic)))) + ?c ch ?T topic))) + nil) (define-erc-response-handler (WALLOPS) "Display a WALLOPS message." nil @@ -2788,11 +2792,12 @@ erc--extract-352-full-name "NAMES notice." nil (let ((channel (nth 2 (erc-response.command-args parsed))) (users (erc-response.contents parsed))) + (erc-with-buffer (channel proc) + (erc-channel-receive-names users)) (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) 'active) - 's353 ?c channel ?u users) - (erc-with-buffer (channel proc) - (erc-channel-receive-names users)))) + 's353 ?c channel ?u users)) + nil) (define-erc-response-handler (366) "End of NAMES." nil -- 2.51.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0014-WIP-Add-IRCv3-building-blocks-to-ERC.patch Content-Transfer-Encoding: quoted-printable From f5bb315b02dc02e45d01b86c7aa75938d6ca17a5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 12 Jul 2021 04:03:42 -0700 Subject: [PATCH 14/14] [WIP] Add IRCv3 building blocks to ERC ;; FIXME update stale change log before merging. ;; There are SASL-related changes missing. * lisp/erc/erc-v3.el: New file. * lisp/erc/erc.el (erc-modules): Add `v3' module. * test/lisp/erc/erc-scenarios-v3-account-notify.el: New file. * test/lisp/erc/erc-scenarios-v3-sasl.el: New file. * test/lisp/erc/erc-scenarios-v3.el: New file. * test/lisp/erc/erc-tests.el (erc-tests--modules): Add `v3'. * test/lisp/erc/erc-v3-tests.el: New file. * test/lisp/erc/resources/erc-scenarios-common.el: (erc-scenarios-common--nick-at-point): New function. * test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld: New file * test/lisp/erc/resources/v3/account-notify/no-extended-join.eld: New file. * test/lisp/erc/resources/v3/away-notify/basic.eld: New file. * test/lisp/erc/resources/v3/cap-notify/basic.eld: New file. * test/lisp/erc/resources/v3/echo-message/basic.eld: New file. * test/lisp/erc/resources/v3/extended-join/basic.eld: New file. * test/lisp/erc/resources/v3/multi-prefix/basic.eld: New file. * test/lisp/erc/resources/v3/sasl/plain-failed.eld: New file. * test/lisp/erc/resources/v3/sasl/plain-unsupported.eld: New file. * test/lisp/erc/resources/v3/sasl/plain.eld: New file. * test/lisp/erc/resources/v3/sasl/scram-sha-1.eld: New file. * test/lisp/erc/resources/v3/sasl/scram-sha-256.eld: New file. * test/lisp/erc/resources/v3/server-time/basic.eld: New file. * test/lisp/erc/resources/v3/userhost-in-names/basic.eld: New file. * test/lisp/erc/resources/v3/whox/basic.eld: New file. * test/lisp/erc/resources/v3/whox/rate-limited.eld: New file. (Bug#49860) --- lisp/erc/erc-sasl.el | 173 +- lisp/erc/erc-v3.el | 2365 +++++++++++++++++ lisp/erc/erc.el | 1 + .../erc/erc-scenarios-v3-account-notify.el | 133 + test/lisp/erc/erc-scenarios-v3-sasl.el | 200 ++ test/lisp/erc/erc-scenarios-v3.el | 587 ++++ test/lisp/erc/erc-tests.el | 1 + test/lisp/erc/erc-v3-tests.el | 1459 ++++++++++ .../erc/resources/erc-scenarios-common.el | 25 + .../account-notify/chghost-no-account-tag.eld | 77 + .../v3/account-notify/no-extended-join.eld | 50 + .../erc/resources/v3/away-notify/basic.eld | 63 + .../erc/resources/v3/cap-notify/basic.eld | 67 + .../erc/resources/v3/echo-message/basic.eld | 74 + .../erc/resources/v3/extended-join/basic.eld | 56 + .../erc/resources/v3/multi-prefix/basic.eld | 51 + .../erc/resources/v3/sasl/plain-failed.eld | 18 + .../resources/v3/sasl/plain-unsupported.eld | 7 + test/lisp/erc/resources/v3/sasl/plain.eld | 39 + .../erc/resources/v3/sasl/scram-sha-1.eld | 51 + .../erc/resources/v3/sasl/scram-sha-256.eld | 51 + .../erc/resources/v3/server-time/basic.eld | 57 + .../resources/v3/userhost-in-names/basic.eld | 59 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 25 files changed, 5881 insertions(+), 4 deletions(-) create mode 100644 lisp/erc/erc-v3.el create mode 100644 test/lisp/erc/erc-scenarios-v3-account-notify.el create mode 100644 test/lisp/erc/erc-scenarios-v3-sasl.el create mode 100644 test/lisp/erc/erc-scenarios-v3.el create mode 100644 test/lisp/erc/erc-v3-tests.el create mode 100644 test/lisp/erc/resources/v3/account-notify/chghost-no-ac= count-tag.eld create mode 100644 test/lisp/erc/resources/v3/account-notify/no-extended-j= oin.eld create mode 100644 test/lisp/erc/resources/v3/away-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/cap-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/echo-message/basic.eld create mode 100644 test/lisp/erc/resources/v3/extended-join/basic.eld create mode 100644 test/lisp/erc/resources/v3/multi-prefix/basic.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-unsupported.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-256.eld create mode 100644 test/lisp/erc/resources/v3/server-time/basic.eld create mode 100644 test/lisp/erc/resources/v3/userhost-in-names/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/rate-limited.eld diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el index 5228fc5e5aa..5f0d6062663 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -36,7 +36,7 @@ ;; mechanism for you. Requires CAP 3.2 (see bug#49860). =20 ;;; Code: -(require 'erc) +(require 'erc-v3) (require 'rx) (require 'sasl) (require 'sasl-scram-rfc) @@ -312,6 +312,7 @@ sasl doesn't currently solicit or validate supported mechanisms." ((if erc--target (erc-sasl-mode -1) + (erc-sasl--set-up-register-connection-function t) (setq erc-sasl--state (make-erc-sasl--state)) ;; If the previous attempt failed during registration, this may be ;; non-nil and contain erroneous values, but how can we detect that? @@ -330,9 +331,17 @@ sasl (error "Unknown or unsupported SASL mechanism: `%s'" mech)) (setf (erc-sasl--state-client erc-sasl--state) client)))) ((kill-local-variable 'erc-sasl--state) - (kill-local-variable 'erc-sasl--options)) + (kill-local-variable 'erc-sasl--options) + (erc-sasl--set-up-register-connection-function nil)) localp) =20 +(defun erc-sasl--set-up-register-connection-function (wantp) + (if wantp + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--register-connection '((depth . 60))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--register-connection))) + (define-erc-response-handler (AUTHENTICATE) "Begin or resume an SASL session." nil (if-let* ((response (car (erc-response.command-args parsed))) @@ -410,7 +419,7 @@ erc-sasl--send-cap-ls into a user option, please let ERC know via \\[erc-bug]. Otherwise, expect it to disappear in subsequent versions.") =20 -(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t))) +(defun erc-sasl--register-connection (inner) "Send speculative CAP and pipelined AUTHENTICATE and hope for the best." (if-let* ((c (erc-sasl--state-client erc-sasl--state)) (m (sasl-mechanism-name (sasl-client-mechanism c)))) @@ -426,12 +435,168 @@ erc--register-connection (if (eq :user (alist-get 'user erc-sasl--options)) (erc-current-nick) erc-session-username))) - (cl-call-next-method)) + (funcall inner)) (when erc-sasl--send-cap-ls (erc-server-send "CAP REQ :sasl")) (erc-server-send (format "AUTHENTICATE %s" m))) (erc-sasl--destroy erc-server-process))) =20 + +;;;; Extension: sasl + +;; The following is glue to adapt the `sasl' module to the IRCv3 +;; capability negotiation process. There's no need to add `sasl' to +;; `erc-modules' so long as `sasl' appears in `erc-v3-extensions'. + +;; When this module loads, `cl-struct-define' associates this struct's +;; type with that of its parent, `erc-v3--extension'. The `v3' module +;; then leverages this association as a discovery mechanism to run the +;; `initp' slot of every constructor. This slot's code in particular +;; adds `sasl' to the session's copy of `erc-v3-extensions', which tells +;; ERC to mark it as wanted during capability negotiation. +(erc-v3--define-capability sasl + :initp (erc-sasl--v3-on-wantedp-init) + :slots ((done-cmd nil :type (or null string))) ; e.g., "903" + (unless erc-v3--sasl + (remove-hook 'erc-sasl-mode-hook #'erc-sasl--v3-on-minor-mode t) + (erc-sasl-mode -1))) + +(defun erc-sasl--v3-on-minor-mode () + "Inhibit CL methods specializing on `erc-sasl-mode' `eql'ing t." + (unless erc--target + (if erc-sasl-mode + (progn + (erc-sasl--set-up-register-connection-function nil) + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK '((depth . 40)))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection) + (remove-function (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS) + (remove-function (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK))) + (erc--set-up-response-function 903 erc-sasl-mode ; success + :override #'erc-sasl--v3-server-903) + (erc--set-up-response-function 902 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 904 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 908 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed)) + +(defun erc-sasl--v3-on-wantedp-init () + "Manage module `sasl'." + (when (erc--module-active-p 'sasl) + ;; Tell ERC to request this extension when advertised. + (cl-pushnew 'sasl erc-v3-extensions)) + (when (memq 'sasl erc-v3-extensions) + (cl-assert (erc--server-buffer-p)) + ;; This function is called on `erc-v3-mode' in the server buffer. + ;; It may run before or after `erc-sasl-enable' because the ordering + ;; of modules isn't well defined or controlled. + (add-hook 'erc-sasl-mode-hook #'erc-sasl--v3-on-minor-mode nil t) + (cond (erc-sasl-mode (erc-sasl--v3-on-minor-mode)) ; already up, do se= tup + ((memq 'sasl erc-modules)) ; will run soon, hook will mark + (t (erc-sasl-mode +1))) ; fully managed by this module + t)) + +(defun erc-sasl--v3-subcmd-LS (inner cap) + "Validate mechanism for `erc-v3--sasl' object CAP. +Call INNER if everything checks out. Otherwise, display an error and +destroy the session." + (if (not (erc-v3--sasl-p cap)) + (funcall inner cap) + (cl-assert (null erc--target)) + (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) + (unless erc-sasl-mode + (error "erc-v3--subcmd-LS: %s" cap)) + (let ((val (erc-v3--capability-val cap))) + (if (or (null val) (erc-sasl--mechanism-offered-p val)) + (funcall inner cap) + (erc-v3--transition cap erc-v3--event-wERR) + (erc-button--display-error-notice-with-keys + "Chosen SASL mechanism " + (upcase (symbol-name (alist-get 'mechanism erc-sasl--options))) + " not among those offered: " val ". Aborting.") + (erc-sasl--destroy erc-server-process)))))) + +;; This suspends negotiation by ignoring the queued ACK message, which +;; is ready for handling. It then resumes execution when a 9xx response +;; arrives by simulating the arrival of the same "ACK", except limiting +;; processing only to only the cap `sasl'. +;; +;; The `extended-isupport' capability, when implemented, would do much +;; the same: specify an overriding "ACK" method and spoof continued +;; execution on BATCH end instead of on 9xx. +(defun erc-sasl--v3-subcmd-ACK (inner cap) + "Suspend negotiation for `erc-v3--capability' CAP and initiate sub-proto= col. +Call INNER if CAP is not `erc-v3--sasl' or authentication is already done." + (if (or (not (erc-v3--sasl-p cap)) (erc-v3--sasl-done-cmd cap)) + (funcall inner cap) + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + ;; Extend request timer by 10 seconds. + (timer-inc-time (erc-v3--caps-timer erc-v3--caps) + erc-v3--sync-timeout-seconds) + ;; Not advancing past `qin' inhibits further processing. + (let ((client (erc-sasl--state-client erc-sasl--state))) + ;; When mechanism is unknown this fails with a wrong-type error. + (let ((m (sasl-mechanism-name (sasl-client-mechanism client)))) + (erc-server-send (format "AUTHENTICATE %s" m)))))) + +(defun erc-sasl--v3-register-connection (inner) + "Call INNER with `erc-session-password' and `erc-session-username' bound= ." + ;; FIXME during a normal Makefile test run, a failing `cl-assert' on + ;; the following line prints a backtrace and stops execution, but the + ;; test is marked as passed! Witnessed on arbitrary commit + ;; 5be32aa047d18b578412e8b249bb4f128a0dc207 + (unless (memq 'sasl (erc-v3--caps-extensions erc-v3--caps)) + (error "Missing `sasl' from session extensions")) + (let ((erc-session-password + (and erc-session-password + (not (eq :password (alist-get 'password erc-sasl--options))) + erc-session-password)) + (erc-session-username + ;; The SASL username may contain a colon or a space. + (if (eq :user (alist-get 'user erc-sasl--options)) + (erc-current-nick) + erc-session-username))) + (funcall inner))) + +;; An alternative approach to manually calling the lower-level ACK +;; handlers a la carte like this would be to "roll back" (revert) to the +;; prior state by copying over the current set of relevant slots (with a +;; special fake event, like `w-rev'), but only after pushing the current +;; set atop the history stack. +(defun erc-sasl--v3-server-903 (&rest _) + "Run \"CAP\" finalizer to conclude capability negotiation. +When `erc-sasl-mode' is the symbol `v3', call DEFAULT 903 handler with +PROC and PARSED." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + ;; FIXME remove assertions once convinced in case some rogue server + ;; sends a 903 for some reason other than to end an SASL subprotocol + ;; dialog. + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + (cl-assert (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (when (and (eq erc-v3--phase-QIN (erc-v3--extension-phase cap)) + (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (setf (erc-v3--sasl-done-cmd cap) "903") + (erc-v3--consider-answered) + (erc-v3--finish-negotiating))) + nil) + +(defun erc-sasl--v3-finalize-failed (_ parsed) + "Record activation as failed and disable mode if enabled." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + (cl-assert cap) + (setf (erc-v3--sasl-done-cmd cap) (erc-response.command parsed)) + (erc-v3--ensure-disabled (list cap)) + (erc-v3--transition cap erc-v3--event-wERR))) + + (provide 'erc-sasl) ;;; erc-sasl.el ends here ;; diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el new file mode 100644 index 00000000000..2ec7bbcc849 --- /dev/null +++ b/lisp/erc/erc-v3.el @@ -0,0 +1,2365 @@ +;;; erc-v3.el --- IRCv3 support for ERC -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file adds IRCv3 capability negotiation [1] in accordance with +;; version 302 of the spec. It provides a module called `v3' that must +;; be present in `erc-modules' for any IRCv3 features to come to life. +;; All extensions requested by default live in this file. Other +;; IRCv3-related libraries may exist in the ERC tree, and some may +;; contain multiple related extensions. Feature names may not contain +;; the letters "v3", but you can grep for "erc-v3--define" to find them. +;; +;; Unfortunately, there is currently no public library API. +;; +;; [1] https://ircv3.github.io/specs/core/capability-negotiation.html + +;;; Code: +(require 'erc) + +(defgroup erc-v3 nil + "IRCv3 extensions for ERC." + :group 'erc + :package-version '(ERC . "5.7")) ; FIXME sync on release + +(defcustom erc-v3-extensions '(account-tag + echo-message + standard-replies) + "List of extensions to enable for a given session. +In addition to these, ERC attempts to enable all foundational extensions +listed in `erc-v3-base-extensions'. Members of the combined set +represent implementations of IRCv3 specifications, some of which may not +define a corresponding \"requestable\" capability. Extensions with +dependencies need them to also be members of the set." + :type '(set (const account-tag) + (const echo-message) + (const sasl) + (const standard-replies))) + +(defconst erc-v3-base-extensions + '(account-notify + away-notify + cap-notify + chghost + extended-join + extended-monitor + message-tags + multi-prefix + server-time + setname + userhost-in-names + ;; Non-caps + whox + monitor) + "Hard-coded essentials that IRCv3 depends on for basic functionality. +ERC attempts to enable these unconditionally when advertised.") + +(cl-defstruct erc-v3--caps + "Data related to capability negotiation." + ( continued nil + ;; This assumes replies won't be intermingled for adjacent requests. + :documentation "Stashed arguments from a continued LS or LIST reply." + :type (list-of cons)) + ( extensions nil + :documentation "Snapshot of desired canonical extensions on init." + :type (list-of symbol) + :read-only t) + ( objects nil + :documentation "List of `erc-v3--extension' sorted objects." + :type (list-of erc-v3--extension)) + ( queue-out nil + :documentation "Subset of OBJECTS slot used for outgoing requests." + :type list) + ( queue-in nil + :documentation "List of (SUBCMD-SYM . CAP) for current round of ACK/NA= Ks." + :type (list-of cons)) + ( timer nil + :documentation "Registration request timer." + :type (or null timer)) + ( negotiated-p nil + :documentation "Non-nil when CAP END has been sent." + :type bool)) + +(defvar-local erc-v3--caps nil + "Unique `erc-v3--caps' object for server process. +Local to the server buffer.") + +;; Could also generate intermediate edges for a less verbose +;; representation. +(defmacro erc-v3--make-edges (name body) + "Define a `defconst' for all unique states in transition graph BODY. +Expect BODY to be an alist of members like (state . transitions) where +transitions is a list of triples of the form (event state phase). +Define a new `defvar' NAME whose value is a copy of BODY with all state +symbols replaced by their generated counterparts." + (declare (indent 1)) + (let* ((states ()) + (events ()) + (phases ()) + (entries + (mapcar + (pcase-lambda (`(,in . ,next)) + (cl-pushnew in states) + `(,@(list (list '\, (intern (format "erc-v3--state-%s" in)))) + ,@(mapcar + (pcase-lambda (`(,event ,out ,phase)) + (cl-pushnew out states) + (cl-pushnew event events) + (cl-pushnew phase phases) + `(,(list '\, (intern (format "erc-v3--event-%s" event)= )) + ,(list '\, (intern (format "erc-v3--state-%s" out))) + ,(list '\, (intern (format "erc-v3--phase-%s" phase)= )))) + next))) + body))) + `(progn + ,@(let (out) + (pcase-dolist (`(,kind . ,items) + (list (cons 'event events) + (cons 'phase phases) + (cons 'state (sort states #'string-lessp))= )) + (push (mapcar + (lambda (s) + `(defconst ,(intern (format "erc-v3--%s-%s" kind s)) + (make-symbol ,(symbol-name s)))) + items) + out)) + (apply #'nconc out)) + (defvar ,name + ,(list '\` entries))))) + +;; States: +;; Server {u: unknown/unavail, a: avail/passive, i: cap enabled} +;; Wanted {o: off, i: on, e: err} +;; Mode {o: off, i: on, e: err} +;; Pending {u: n/a, a: avail, y: queued, o: REQ-, i: REQ+, e: err} +;; +;; Events: +;; mOK: calling extension's mode command succeeds (+1 or -1) +;; mERR: error calling extension's mode command (+1 or -1) +;; pIN: all replies from last round of REQs received +;; pOUT: all requests for new round of REQs ready to be sent +;; pERR: request timed out +;; wON: extension object created on module init +;; wOK: pre-flight validation/prep succeeded +;; wERR: application error during activation inc. timed out +;; s005: 005 received relevant to ISUPPORT-centric extension +;; sACK (sNAK, sDEL, sLS, sNEW): server command received +;; +;; Phases: +;; nil: default value on new struct instance +;; INIT: instantiate, record whether extension is initially wanted +;; TRACK: remember advertised (w. key and value for caps) +;; CHECK: dependencies, validate advertised values, etc. +;; QOUT: mark as needing REQ to be sent +;; QIN: mark as REQ reply needing processing +;; SEND: (possibly negated) REQ sent to server +;; UP: attempt to enable extension's minor mode and dependencies +;; DOWN: attempt to disable extension's minor mode and dependents +;; LOG: insert user-facing "error notice" in server buffer +;; RUN, PASS: do nothing +;; S_-W_-M_-P_ +;; Symbol-name indexes used in related predicates: .1..4..7..a + +(erc-v3--make-edges erc-v3--edges + ;; Unavailable and unwanted (non-cap) extension + ((Su-Wo-Mo-Pu (wON Su-Wi-Mo-Pu INIT) ; new struct on module init + (s005 Sa-Wo-Mo-Pu TRACK)) ; unwanted ISUPPORT-based (1) + ;; Unavailable but wanted (non-cap) extension + (Su-Wi-Mo-Pu (s005 Sa-Wi-Mo-Pu CHECK)) ; wanted ISUPPORT-based + ;; Available and wanted (non-cap) extension + (Sa-Wi-Mo-Pu (mOK Sa-Wi-Mi-Pu RUN) ; minor-mode up success + (mERR Sa-We-Mo-Pu LOG) ; minor-mode up failure (2) + (wERR Sa-We-Mo-Pu LOG)) ; validation failure (2) + ;; Unavailable and unwanted capability + (Su-Wo-Mo-Pa (wON Su-Wi-Mo-Pa INIT) ; new struct on module init + (sLS Sa-Wo-Mo-Pa TRACK) ; passive update, k/v stored + (sNEW Sa-Wo-Mo-Pa TRACK)) ; same as ^ + ;; Available but unwanted capability + (Sa-Wo-Mo-Pa (sDEL Su-Wo-Mo-Pa PASS)) ; server makes unavailable + ;; Unavailable but wanted capability + (Su-Wi-Mo-Pa (sLS Sa-Wi-Mo-Pa CHECK) ; needs pre-flight REQ+ check + (sNEW Sa-Wi-Mo-Pa CHECK)) ; same as ^ + ;; Available and wanted capability + (Sa-Wi-Mo-Pa (wOK Sa-Wi-Mo-Py QOUT) ; check passed, queue as REQ+ + (wERR Sa-We-Mo-Pa LOG)) ; check failed, non-fatal log + ;; Available and wanted capability awaiting outgoing request + (Sa-Wi-Mo-Py (pOUT Sa-Wi-Mo-Pi SEND)) ; send REQ+/-, clear queue + ;; Available and wanted capability awaiting reply + (Sa-Wi-Mo-Pi (sACK Si-Wi-Mo-Py QIN) ; server enabled, queue sync + (sNAK Sa-We-Mo-Py QIN) ; request denied, needs attn (5) + (pERR Su-Wi-Mo-Pe LOG)) ; timeout or transport error (2) + ;; Provided and wanted capability awaiting processing + (Si-Wi-Mo-Py (pIN Si-Wi-Mo-Pa UP) ; REQs all received, do sync + (wERR Sa-We-Mo-Pa LOG)) ; log fatal, e.g., SASL 904 + ;; Available but tainted capability awaiting processing + (Sa-We-Mo-Py (pIN Sa-We-Mo-Pa LOG)) ; log rejection + ;; Provided and wanted capability awaiting local sync + (Si-Wi-Mo-Pa (mOK Si-Wi-Mi-Pa RUN) ; minor-mode +1 sync succeeded + (mERR Si-Wi-Me-Py QOUT)) ; minor-mode +1 sync failed + ;; Provided and wanted cap with activation taint awaiting server sync + (Si-Wi-Me-Py (pOUT Si-Wi-Me-Po SEND)) ; sent REQ- (3) + ;; Provided and wanted cap with activation taint awaiting reply + (Si-Wi-Me-Po (sACK Sa-Wi-Me-Py QIN) ; queue to log error from sync (3) + (sNAK Sa-We-Me-Py QIN) ; rejected REQ-, queue log (3) + (pERR Su-Wi-Me-Pe LOG)) ; REQ- timed out, log (3) + ;; Available and wanted cap with activation taint awaiting processing + (Sa-Wi-Me-Py (pIN Sa-Wi-Me-Pa LOG)) ; log error for *good* REQ- (3) + ;; Available and doubly tainted capability awaiting ingress processing + (Sa-We-Me-Py (pIN Sa-We-Me-Pa LOG)) ; log error for rejected REQ- (3) + ;; Provided, wanted, and active capability (idle) + (Si-Wi-Mi-Pa (sDEL Su-Wi-Mi-Pa DOWN)) ; server mandate to sync down + ;; Unavailable but wanted and active cap awaiting immediate local sync + (Su-Wi-Mi-Pa (mOK Su-Wi-Mo-Pa PASS) ; mode -1 success + (mERR Su-Wi-Me-Pa LOG)))) ; mode -1 failed (2) + +;; Notes for transition table above: +;; 1. Currently not possible because WHOX and MONITOR are hard-coded +;; 2. Not currently part of test suite but plausible +;; 3. Possibly temporary for demo purposes. See `erc-v3--ensure-enabled'. +;; 4. Unlikely, though possible and covered by tests; could be removed +;; 5. Possibly unreachable unless pathological + +;; This module revolves around the `erc-v3--extension' "object," which +;; serves as the value of an extension's active minor-mode variable in +;; all buffers of a session. Even though ERC only enables a minor mode +;; after the server confirms support, the extension's object's begins +;; life long before that, on initial `erc-v3-mode' activation in the +;; server buffer. ERC looks to each object's `initp' slot to decide +;; whether to attempt to enable it, which, for a capability, means +;; requesting it. +(cl-defstruct erc-v3--extension + "\"Abstract class\" for basic info relevant to an IRCv3 extension. +If the `initp' slot's \"init form\" evaluates non-nil when activating +`erc-v3-mode' in a server buffer, ERC marks the extension as being +\"wanted\". By default, this happens if the extension's name appears in +the value of the option `erc-v3-extensions'. Then, if the server +advertises support during negotiation (or sometimes beyond), ERC enables +the extension's associated minor mode via `erc-v3--ensure-enabled'." + ( canon nil + :type symbol ; :allocation class + :read-only t + :documentation "Name in specification as a canonical symbol.") + ( depends nil ; :allocation class + :type (list-of symbol) + :documentation "Hard dependencies as canonical symbols.") + ( supports nil ; merged with ^ when loading + :type (list-of symbol) + :documentation "Optional dependencies loaded first if possible.") + ( aliases nil ; :allocation class + :type (list-of symbol) + :documentation "Alternate names for the same extension.") + ( event nil + :type symbol + :documentation "Last event triggering the current state and phase.") + ( state erc-v3--state-Su-Wo-Mo-Pu + :type symbol + :documentation "Internal symbol representing current negotiation state= .") + ( phase nil + :type symbol + :documentation "Associated phase from latest transition output.") + ( history nil + :type list + :documentation "Append-only snapshot of past states at every transitio= n.") + ( initp (erc-v3--init-p) + :type boolean + :documentation "Whether ERC should attempt to enable this extension.")) + +(cl-defstruct (erc-v3--capability (:include erc-v3--extension + (state erc-v3--state-Su-Wo-Mo-= Pa))) + "\"Abstract class\" for info relevant to an IRCv3 capability. +ERC populates the `key' and `val' slots from pairs advertised during +negotiation. The set of reachable events and states stored in the +`event' and `state' slots is almost entirely unique." + ;; It wouldn't make sense to move `key' and `val' to the base + ;; extension class and overload it to accommodate ISUPPORT parameters + ;; because one extension can be associated with multiple parameters. + ( key nil + :type symbol + :documentation "Name used by server. Must be in (CANON . ALIASES).") + ( val nil + :type (or string null) + :documentation "Value advertised by server, if any.")) + +(defvar erc-v3--init-p nil) + +(defun erc-v3--init-p () + "Non-nil if extension name or alias appears in `erc-v3-extensions'. +Only valid on module init in server buffers." + (declare (ftype (function () boolean))) + (and erc-v3--init-p t)) + +;; This function only exists so it can be instrumented to find +;; unreachable transitions that can be pruned from `erc-v3--edges'. +;; Always use `erc-v3--transition' instead. See related comment in +;; tests. +(defun erc-v3--get-state (state event) + "Return transition triple keyed by EVENT in entry for STATE in graph." + (declare (ftype (function (symbol symbol) list))) + (and-let* ((events (alist-get state erc-v3--edges)) + ((alist-get event events))))) + +(defun erc-v3--log-state-error (ext) + "Display error for `erc-v3--extension' EXT if its phase is `log'." + (when (eq (erc-v3--extension-phase ext) erc-v3--phase-LOG) + (let ((name (if (erc-v3--capability-p ext) + (erc-v3--capability-key ext) + (erc-v3--extension-canon ext)))) + (erc-button--display-error-notice-with-keys + (current-buffer) + "Problem processing extension '%s'. See %s for details." + name (messages-buffer)) + (unless noninteractive + (message "Problem processing extension '%s':" name) + (pp (cons (list :event (erc-v3--extension-event ext) + :state (erc-v3--extension-state ext) + :phase (erc-v3--extension-phase ext)) + (mapcar (pcase-lambda (`(,e ,s ,p)) + (list :event e :state s :phase p)) + (erc-v3--extension-history ext)))))))) + +(defun erc-v3--enqueue-in (extension) + "Add EXTENSION to `erc-v3--caps-queue-in' slot if phase dictates." + (if (eq erc-v3--phase-QIN (erc-v3--extension-phase extension)) + (push (cons (let ((e (erc-v3--extension-event extension))) + (cond ((eq e erc-v3--event-sACK) 'ACK) + ((eq e erc-v3--event-sNAK) 'NAK) + (t (error "Wrong event: %S" e)))) + extension) + (erc-v3--caps-queue-in erc-v3--caps)))) + +(defun erc-v3--enqueue-out (extension) + "Add EXTENSION to `erc-v3--caps-queue-out' slot if phase dictates." + (if (eq (erc-v3--extension-phase extension) erc-v3--phase-QOUT) + (push extension (erc-v3--caps-queue-out erc-v3--caps)))) + +(defvar erc-v3--transition-functions (list #'erc-v3--enqueue-in + #'erc-v3--enqueue-out + #'erc-v3--log-state-error)) + +(defun erc-v3--transition (ext event) + "Transition `erc-v3--extension' EXT if it accepts EVENT. +Then call `erc-v3--transition-functions' to perform side effects, like +logging and queuing, before returning the new phase symbol." + (declare (ftype (function (erc-v3--extension symbol) symbol))) + (when-let* ((entry (erc-v3--get-state (erc-v3--extension-state ext) even= t))) + (pcase-let* ((`(,state ,phase) entry)) + (cl-assert state) + ;; Add last trio to history before committing the new one. + (push (list (erc-v3--extension-event ext) + (erc-v3--extension-state ext) + (erc-v3--extension-phase ext)) + (erc-v3--extension-history ext)) + (setf (erc-v3--extension-event ext) event + (erc-v3--extension-state ext) state + (erc-v3--extension-phase ext) phase) + (run-hook-with-args 'erc-v3--transition-functions ext) + phase))) + +;; FIXME either cover these with tests or define and use constants for +;; the indexes instead of literal integers. +(defun erc-v3--wanted-p (ext) + "Return non-nil if EXT's state slot has a Wi component." + (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 4))) + +(defun erc-v3--unwanted-p (ext) + "Return non-nil if EXT's state slot has a Wo component." + (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 4))) + +(defun erc-v3--enabled-p (ext) + "Return non-nil if EXT's state slot has a Mi component." + (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 7))) + +(defun erc-v3--queued-p (ext) + "Return non-nil if EXT's state slot has a Py component." + (eq ?y (aref (symbol-name (erc-v3--extension-state ext)) 10))) + +(defun erc-v3--pending-negated-p (ext) + "Return non-nil if EXT's state slot has a Po component." + (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 10))) + +(defun erc-v3--error-p (ext) + "Return non-nil if EXT's state slot has a We, Me, or Pe component." + (or (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 4)) + (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 7)) + (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 10)))) + +(defmacro erc-v3--caps-by-phase (phase) + "Return all extensions whose phase matches symbol PHASE." + `(seq-filter (lambda (o) + (eq ,(intern (format "erc-v3--phase-%s" phase)) + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps))) + +(defun erc-v3--sync-mode-value (var value) + "Set VAR in current buffer to server buffer's local VALUE for VAR." + (when-let* ((buf (erc-server-buffer)) + ((or (not (eq buf (current-buffer))) + (not value)))) + (set var (and value (buffer-local-value var buf))))) + +(defmacro erc-v3--define-extension-subclass (default-super body) + "Define a cl-struct and minor mode from DEFAULT-SUPER class and BODY." + (pcase-let* + ((head (pop body)) + (name (if (consp head) (pop head) (prog1 head (setq head nil)))) + (doc (if (stringp (car body)) + (pop body) + (format "IRCv3 `%s' %s." name + (substring (symbol-name default-super) + (length "erc-v3--"))))) + ;; Handle various leading keywords in `body'. + (`(,keymap ,new-slots . ,rev-overs) + (let ((info (cdr (cl-struct-slot-info default-super))) + rev-overs keymap new-slots) + (while (keywordp (car body)) + (pcase-exhaustive (pop body) + (:slots (setq new-slots (pop body))) + (:keymap (setq keymap (pop body))) + ;; Any remaining de-coloned keywords are overriding init + ;; form parameters for the child's `:include' option. + ((and k (let slot (intern-soft (substring (symbol-name k) 1)= )) + (guard (and slot (assq slot info)))) + (push (if (seq-some (lambda (e) + (memq e (ensure-list (car body)))) + '(:type :documentation :read-only)) + (cons slot (pop body)) ; full replacement def + (list slot (pop body))) ; init form + rev-overs)))) + `(,keymap ,new-slots ,@rev-overs))) + (defname (intern (format "erc-v3--%s" name))) + (modname (intern (format "erc-v3--%s-mode" name))) + (overs (reverse rev-overs)) + (inc-def `(:include ,default-super (canon ',name) ,@overs)) + (options (if (keywordp (car (car-safe head))) + (if-let* ((include (alist-get :include head))) + (prog1 head + (unless (assq 'canon include) + (dolist (s `(,@rev-overs (canon ',name))) + (push s (cdr (alist-get :include head)))))) + (push inc-def head)) + (list inc-def)))) + ;; Framework allows other constructors but only calls `defname'. + (setq options `(,@options (:constructor ,defname))) + `(progn + (cl-defstruct (,defname ,@options) + ,doc + ,@new-slots) + ,@(mapcar (lambda (n) + `(put ',n 'erc-v3--extension-class ',defname)) + ;; Find aliases (bar draft/foo) in (quote (bar draft/foo)) + (cons name (cadar (alist-get 'aliases overs)))) + (put ',name 'erc-v3--extension-minor-mode ',modname) + (put ',defname 'erc-v3--extension-canon ',name) + (put ',defname 'erc-v3--extension-super ',default-super) + (defvar-local ,defname nil + ,(format "Local instance of `%s' when enabled." defname)) + (define-minor-mode ,modname + ,(if (stringp (car body)) + (pop body) + (format "Internal minor mode for `%s'." defname)) + :interactive nil + :variable ((buffer-local-value ',defname (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value ',defname v))) + ,@body) + ,@(and keymap `((setf (alist-get ',defname minor-mode-map-alist) + ,keymap)))))) + +(def-edebug-spec erc-v3-extension + (&define [&or symbolp (symbolp &rest sexp)] + [&optional stringp] ; cl-struct doc when present + [&rest [keywordp sexp]] + [&optional stringp] ; minor-mode doc when present + def-body)) + +(defmacro erc-v3--define-extension (&rest body) + "Define an `erc-v3--extension'-derived struct and supporting items. +From BODY, create a struct type named erc-v3--NAME with an identically +named constructor, and have it \"subclass\" `erc-v3--extension'. Expect +NAME to be a symbol or, alternatively, a list containing a symbol and +`cl-defstruct' options. If OPTS, which is a span of zero or more +top-level keyword-value pairs, contains a `:slots' keyword, interpret +its paired value as an unquoted alist of `cl-defstruct' slot definitions +suitable for opaque application state. Expect users to favor `:slots' +over local variables for state shared among all buffers of a connection. +If OPTS contains an `:aliases' keyword, interpret its value, a form that +evaluates to a list of symbols, as an overriding \"initform\" for the +resulting class's `aliases' slot. And in doing so, ensure each alias +has an `erc-v3--extension-class' symbol property set to the struct +constructor's symbol, normally erc-v3--NAME, so that ERC can create +equivalent objects from effectively equivalent extensions, like +`draft/my-cap' and `my-cap'. Finally, in a similar manner, add any +other keyword pairs in OPTS matching existing slots to the superclass' +`:include' form as well. + +Other than the struct type, define a variable sharing the constructor's +name, but set its value to nil, and make it local when set. From this, +create an \"internal\" minor mode with this as its mode variable, and +have it activate in all buffers of the connection. Make this mode +non-interactive, but allow a `:keymap' argument in OPTS to specify the +minor mode's keymap. Beyond that, interpret all forms following the +last keyword/value pair or second doc string as comprising the +MODE-BODY. In target buffers, arrange for this body to run alongside +normal local-module activation, where `erc--target-priors' is populated. +In server buffers, have it run during connection registration, where +`erc--server-reconnecting' is empty and `erc--restore-initialize-priors' +ineffective -- though it can also run later if triggered by a \"CAP +NEW\". Expect contributors to know that since modules depended on by an +extension are reactivated upon reconnect, their hooks can serve as a +convenient place to wrangle persistent data. + +\(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" + (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) + `(erc-v3--define-extension-subclass erc-v3--extension ,body)) + +(defmacro erc-v3--define-capability (&rest body) + "Define an `erc-v3--capability'-derived struct and supporting items. +In almost all respects, act like `erc-v3--define-extension', whose doc +string explains the various parts of BODY. + +\(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" + (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) + `(erc-v3--define-extension-subclass erc-v3--capability ,body)) + +;; As mentioned, each extension is a minor mode whose mode variable is +;; the session's instance of the `erc-v3--extension'-derived struct of +;; the same name, such as `erc-v3--cap-notify'. During target-buffer +;; setup, this module copies over each extension's minor mode variable +;; from the server buffer. The values themselves are shared (`eq'). +(defun erc-v3--activate-module-for-target () + "Initialize `erc-v3-mode' in a target buffer. +Replicate the server buffer's set of enabled extensions locally by +running their minor-mode commands. Do this in sorted order so that +dependencies come first." + (cl-assert erc--target) + (let ((server-buffer (erc-server-buffer))) + (dolist (cap (erc-v3--caps-objects + (buffer-local-value 'erc-v3--caps server-buffer))) + (when-let* ((canon (erc-v3--extension-canon cap)) + (variable (get canon 'erc-v3--extension-class)) + ((buffer-local-value variable server-buffer)) + (mode (get canon 'erc-v3--extension-minor-mode))) + (funcall mode +1))))) + +(defun erc-v3--activate-module () + "Perform steps to initialize buffer for `erc-v3-mode'. +Create a local `erc-v3--caps' object in the server buffer and populate +its `extensions' slot with a copy of `erc-v3-extensions'. For each +member, attempt to load an associated \"erc-\" prefixed library. Next, +call the constructor of every non-parent type appearing in the list +`cl-struct-erc-v3--extension-tags'. If the `initp' slot of the +resulting instance is non-nil, mark the extension as \"wanted\", meaning +ERC will request it if advertised by the server. Finally, save these +instances in the `objects' slot of the `erc-v3--caps' for this session." + (cl-assert (null erc--target)) + ;; Bind `erc-v3-extensions' for constructors to modify in special + ;; cases via their `initp' slot. See SASL for an example. + (let* ((erc-v3-extensions erc-v3-extensions) + (exts (cl-union erc-v3-base-extensions erc-v3-extensions)) + (wanted-constructors ()) + (objects ())) + ;; Load libraries of configured extensions. Additional loading is + ;; not attempted when later reviewing unknown advertised caps. + (dolist (ext exts) + (require (or (get ext 'erc--feature) + (intern (concat "erc-" + (if-let* ((n (symbol-name ext)) + ((string-prefix-p "draft/" n)= )) + (substring n 6) + n)))) + nil 'no-error)) + (setq wanted-constructors ; this must follow loading ^ + (mapcar (lambda (s) (get s 'erc-v3--extension-class)) exts)) + ;; Create objects to track all known extensions. + (dolist (constructor cl-struct-erc-v3--extension-tags) + ;; Skip abstract subtypes, like `erc-v3--capability'. + (when (get constructor 'erc-v3--extension-canon) + (push (let ((erc-v3--init-p (and (memq constructor wanted-construc= tors) + t))) + (funcall constructor)) + objects) + (when (erc-v3--extension-initp (car objects)) + (cl-assert (eq erc-v3--phase-INIT + (erc-v3--transition (car objects) + erc-v3--event-wON)))))) + (setq exts (append erc-v3-base-extensions + (mapcar (lambda (s) + (get (get s 'erc-v3--extension-class) + 'erc-v3--extension-canon)) + erc-v3-extensions)) + objects (erc-v3--deps-tsort objects + (erc-v3--deps-build-dag objects t)) + erc-v3--caps (make-erc-v3--caps :extensions exts :objects object= s)))) + +(define-erc-module v3 nil + "IRCv3 extension support for ERC. +When activating this local module, take steps to ensure capability +negotiation will commence and the necessary bookkeeping performed to +carry the protocol dialog to completion. When deactivating, print an +error message and destroy the entire ERC session." + ((unless erc--target + (pcase erc-tags-format + ('legacy + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 will be incompatible with an `erc-tags-format' value = of" + " `legacy' in a future release. Please update your code.")) + ((or 'warn 'overridable) + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 has changed the format of the `erc-response' slot" + " for this session to an alist of (SYMBOL . STRING-OR-NIL)."))) + (add-function :before (local 'erc--register-connection-function) + #'erc-v3--register-connection '((depth . 45)))) + (erc--add-response-function 005 :after #'erc-v3--server-005) + (erc--add-response-function 353 :around #'erc-v3--server-353) + (erc--add-response-function 366 :before #'erc-v3--server-366) + (erc--add-response-function 900 :override #'erc-v3--server-900) + (erc--add-response-function CAP :override #'erc-v3--server-CAP) + (if erc--target + (erc-v3--activate-module-for-target) + (erc-v3--activate-module))) + ;; XXX tearing this down properly is likely not worth doing because it + ;; requires syncing with the server. It's much easier to destroy the + ;; session and reconnect. To make this work, you'd have to REQ -foo + ;; all extensions and wait until they're all ACK'd before finishing. + ((unless erc--target + (erc-button--display-error-notice-with-keys-and-warn + (erc-server-buffer) + "Disabling `erc-v3-mode' is not currently supported." + (and (memq 'v3 erc-modules) + " Please remove v3 from `erc-modules' if unwanted."))) + ;; Since this is a local module, set the mode var back to t. + (setq erc-v3-mode t) + ;; Things that would be torn down were that supported. + (unless 'inhibited + (remove-function (local 'erc--register-connection-function) + #'erc-v3--register-connection) + (erc--remove-response-function 005 #'erc-v3--server-005) + (erc--remove-response-function 353 #'erc-v3--server-353) + (erc--remove-response-function 366 #'erc-v3--server-366) + (erc--remove-response-function 900 #'erc-v3--server-900) + (erc--remove-response-function CAP #'erc-v3--server-CAP))) + localp) + +;; To profile the negotiation sequence, put a `profiler-start' here and +;; a `profiler-stop' in `erc-v3--finish-negotiating'. +(defun erc-v3--register-connection () + "Start capability negotiation with server when ERC-V3-MODE is non-nil." + (erc-server-send "CAP LS 302")) + +(defun erc-v3--handle-negotiation-timeout (buffer event) + "Destroy session in server BUFFER and dump info about caps. +Transition all objects with EVENT." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (dolist (o (erc-v3--caps-objects erc-v3--caps)) + (erc-v3--transition o event)) + (delete-process erc-server-process) + (let ((erc-active-buffer buffer)) + (erc-button--display-error-notice-with-keys + buffer "Processing timed out. Destroying session." + " Please report info in %s via \\[erc-bug]." (messages-buffer)) + (pp erc-v3--caps))))) + +(defvar erc-v3--request-timeout-seconds 30 + "Time allowed between last emitted \"REQ\" and last answered.") + +(defvar erc-v3--sync-timeout-seconds 10 + "Time allowed between last answered \"REQ\" and \"END\".") + +(defun erc-v3--run-timer (event secs) + "Run timer SECS seconds from now. +Arrange to call `erc-v3--handle-negotiation-timeout' with EVENT." + (when (erc-v3--caps-timer erc-v3--caps) + (cancel-timer (erc-v3--caps-timer erc-v3--caps))) + (setf (erc-v3--caps-timer erc-v3--caps) + (run-at-time secs nil #'erc-v3--handle-negotiation-timeout + (current-buffer) event))) + +(defun erc-v3--send-requests () + "Request all caps in the `erc-v3--caps-queue-out'. +Create and return a request timer." + (cl-assert (erc-v3--caps-queue-out erc-v3--caps)) + (let (todo) + (while-let ((cap (pop (erc-v3--caps-queue-out erc-v3--caps)))) + (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase cap))) + (when (eq erc-v3--phase-SEND (erc-v3--transition cap erc-v3--event-p= OUT)) + (push (concat (and (erc-v3--pending-negated-p cap) "-") + (symbol-name (erc-v3--capability-key cap))) + todo))) + (while todo + (erc-server-send (format "CAP REQ :%s" (string-join (take 10 todo) "= "))) + (setq todo (nthcdr 10 todo)))) + (erc-v3--run-timer erc-v3--event-pERR erc-v3--request-timeout-seconds)) + +(defun erc-v3--run-subcmd (key subcmd) + "Run \"CAP\" SUBCMD handler for capability's KEY." + (when-let* ((canon (erc-v3--canon-from-key key)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall (erc-v3--subcmd2handler subcmd) cap))) + +(defun erc-v3--run-subcmds-piecemeal (subcmd alist) + "Run all SUBCMD handlers for a \"CAP LS\" or a \"CAP NEW\". +Expect ALIST to have members with symbols at the head representing +capabilities." + (pcase-dolist (`(,key . ,_) alist) + (erc-v3--run-subcmd key subcmd))) + +(defun erc-v3--finish-negotiating () + "Finalize \"CAP\" dialog." + (when-let* ((timer (erc-v3--caps-timer erc-v3--caps))) + (cancel-timer timer) + (setf (erc-v3--caps-timer erc-v3--caps) nil)) + (unless (erc-v3--caps-negotiated-p erc-v3--caps) + (erc-server-send "CAP END") + (setf (erc-v3--caps-negotiated-p erc-v3--caps) t))) + +;; FIXME ensure a "CAP NEW" arriving unexpectedly during registration +;; won't cause problems. +(defun erc-v3--server-CAP (_proc parsed) + "Handle a subcommand for \"CAP\" response PARSED and return nil. +Always send queued requests or, if all have been answered, a \"CAP +END\", but only during connection registration." + (let* ((subcmd (intern (nth 1 (erc-response.command-args parsed)))) + (contents (if (memq subcmd '(LS LIST)) + (erc-v3--check-continued parsed) ; may be null + (list (erc-response.contents parsed)))) + (server-buffer (current-buffer)) + (pairs ())) + (when contents + (with-temp-buffer + (while-let ((contents (pop contents))) + (insert " " contents)) + (goto-char (point-min)) + (skip-syntax-forward "-") + (while-let (((not (eobp))) + (beg (point)) + ((not (zerop (skip-syntax-forward "^-"))))) + ;; Maybe split token into a k/v pair. + (let* ((end (point)) + (p (and (memq subcmd '(LS NEW)) + (save-excursion (goto-char beg) + (search-forward "=3D" end t)))) + (key (intern (buffer-substring beg (or (and p (1- p)) end= )))) + (val (and p (buffer-substring p end)))) + (with-current-buffer server-buffer + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--mark-offered subcmd key val)) + ((or 'ACK 'NAK) (erc-v3--check-answered subcmd key)) + ('DEL (erc-v3--run-subcmd key subcmd)))) + (push (cons key val) pairs)) + (skip-syntax-forward "-")))) + ;; Perform deferred processing. + (when pairs + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--run-subcmds-piecemeal subcmd (nreverse pai= rs))) + ((or 'ACK 'NAK) (erc-v3--consider-answered)) + ('LIST (erc-v3--handle-subcmd-list parsed (nreverse pairs))) + ('DEL (erc-v3--ensure-disabled (erc-v3--caps-by-phase DOWN)))) + ;; Deal with queued items or finish negotiation. + (cond ((erc-v3--caps-queue-out erc-v3--caps) (erc-v3--send-requests)) + ;; Inhibited ACK/NAK. + ((seq-some #'erc-v3--queued-p (erc-v3--caps-objects erc-v3--ca= ps)) + (cl-assert (erc-v3--caps-by-phase QIN)) + (cl-assert (erc-v3--caps-queue-in erc-v3--caps))) + (t (erc-v3--finish-negotiating))))) + nil) + +(define-erc-response-handler (CAP) + "Handle \"CAP\" response or server-initiated command. +Return nil to allow `erc-call-hooks' to keep going." + nil) + +(defvar erc-message-english-s410 "Invalid CAP subcommand: %s" + "English `erc-format-message' template for key `s410'.") + +;; FIXME destroy session here. +(define-erc-response-handler (410) + "Protocol error 410 (ERR_INVALIDCAPCMD) for unknown subcommand." nil + (erc-display-message parsed '(notice error) (erc-server-buffer) + 's410 ?s (cadr (erc-response.command-args parsed)))) + + +;;;; Dependency sorting + +(defun erc-v3--deps-build-dag (objects &optional softp) + "Return an alist of (DEPENDENCY . DEPENDENTS) from OBJECTS. +Where OBJECTS is a list of `erc--v3-extension' instances. With SOFTP, +include members of the `support' slot." + (let (graph) + (dolist (v objects graph) + (dolist (u-name (if softp ; would be nice to iterate lazily + (append (erc-v3--extension-supports v) + (erc-v3--extension-depends v)) + (erc-v3--extension-depends v))) + (let ((u (cl-find u-name objects :key #'erc-v3--extension-canon))) + (cl-pushnew v (alist-get u graph))))))) + +(defun erc-v3--deps-tsort (objects graph) + "Return `erc-v3--extension' list OBJECTS sorted by GRAPH's dependencies." + (let ((out ())) + (named-let doit ((us objects)) + (dolist (u us) + (unless (memq u out) + (doit (alist-get u graph)) + (push u out)))) + out)) + +(defvar-local erc-v3--session-dag nil) + +(defun erc-v3--deps-gather-dependents (cap &optional filter-predicate) + "Return a subset of `erc-v3--caps-objects' that depend on CAP. +Skip those that don't satisfy FILTER-PREDICATE if given. Populate +`erc-v3--session-dag' via `erc-v3--deps-build-dag' if unset." + (let* ((graph (or erc-v3--session-dag + ;; Thankfully, this signals without `erc-v3--caps'. + (setq erc-v3--session-dag + (erc-v3--deps-build-dag + (erc-v3--caps-objects erc-v3--caps))))) + (seen (list cap)) + (todo (alist-get cap graph)) + out) + (while todo + (let ((next (pop todo))) + (unless (memq next seen) + (push next seen) + (when (or (null filter-predicate) + (funcall filter-predicate next)) + (push next out)) + ;; Still need to explore remaining edges because they might + ;; have transitive hops, right? + (dolist (next (alist-get next graph)) + (push next todo))))) + out)) + + +;;;; Subcommand handlers + +;; There's currently no "fallback" LS/NEW handler for unknown caps +;; because the current design views membership in the objects list as +;; immutable. + +;; If ever switching to blind-REQ style without initial CAP LS, move +;; `erc-v3--ensure-deps' call from this handler to the default ACK +;; method and adjust expected negotiation states accordingly. +(defvar erc-v3--subcmd-LS-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP LS\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NEW-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP NEW\" arg as an`erc-v3--capability'.") + +(defvar erc-v3--subcmd-DEL-function #'erc-v3--subcmd-DEL + "Function to visit a single \"CAP DEL\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-ACK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP ACK\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NAK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP NAK\" arg as an `erc-v3--capability'.") + +(defun erc-v3--subcmd-DEL (capability) + "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-sDEL)) + +(defun erc-v3--trigger-event-pIN (capability) + "Apply `erc-v3--event-pIN' event to `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-pIN)) + + +;;;; Subcommand helpers + +(defun erc-v3--subcmd2handler (subcmd) + "Return handler function associated with \"CAP\" SUBCMD symbol." + (pcase-exhaustive subcmd + ('LS erc-v3--subcmd-LS-function) + ('NEW erc-v3--subcmd-NEW-function) + ('DEL erc-v3--subcmd-DEL-function) + ('ACK erc-v3--subcmd-ACK-function) + ('NAK erc-v3--subcmd-NAK-function))) + +(define-inline erc-v3--cap-negated-p (cap-sym) + "Indicate whether CAP-SYM is negated (has a leading hyphen)." + (inline-quote (eq ?- (aref (symbol-name ,cap-sym) 0)))) + +(defun erc-v3--check-continued (parsed) + "Update the `continued' slot of `erc-v3--caps' from ALIST. +Return the updated value if PARSED response is terminal and not to be +continued." + (let ((contents (push (erc-response.contents parsed) + (erc-v3--caps-continued erc-v3--caps)))) + (unless (string=3D "*" (nth 2 (erc-response.command-args parsed))) + (setf (erc-v3--caps-continued erc-v3--caps) nil) + (nreverse contents)))) + +(defvar erc-message-english-CAP-LIST "Enabled CAPs: %m" + "English `erc-message-template' template for key `CAP-LIST'.") + +;; TODO also print enabled non-caps, like WHOX and MONITOR. +(defun erc-v3--handle-subcmd-list (parsed pairs) + "Display PAIRS named for \"LIST\" subcommand in PARSED response." + (when-let* ((m (mapcar (lambda (i) (symbol-name (car i))) pairs))) + (erc-display-message parsed 'notice 'active 'CAP-LIST + ?m (string-join m ", ")))) + +(defun erc-v3--find-capability-by-key (key) + "Return `erc-v3--capability' matching KEY." + (cl-find (erc-v3--canon-from-key key) (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon)) + +(defun erc-v3--subcmd2event (subcmd) + "Return event for SUBCMD." + (pcase-exhaustive subcmd + ('ACK erc-v3--event-sACK) + ('NAK erc-v3--event-sNAK) + ('LS erc-v3--event-sLS) + ('NEW erc-v3--event-sNEW) + ('DEL erc-v3--event-sDEL))) + +(defun erc-v3--mark-offered (subcmd key val) + "Mark cap as ready for checking if named by SUBCMD. +Record KEY and VAL unconditionally, possibly clobbering existing." + (cl-assert (not (erc-v3--cap-negated-p key))) + (when-let* ((o (erc-v3--find-capability-by-key key))) + (cl-assert (erc-v3--capability-p o)) ; not a plain extension + ;; Clobber an existing value even if the cap is already somehow + ;; enabled. + (setf (erc-v3--capability-key o) key + (erc-v3--capability-val o) val) + (erc-v3--transition o (erc-v3--subcmd2event subcmd)))) + +(defun erc-v3--canon-from-key (key) + "Return canonical capability name for KEY." + (when (erc-v3--cap-negated-p key) + (setq key (intern (substring (symbol-name key) 1)))) + (and-let* + ((constructor (get key 'erc-v3--extension-class)) + ;; Skip plain extensions because KEY is from a "CAP" subcmd arg. + ;; `erc-v3--define-extension-subclass' stores the superclass name + ;; as a symbol property of the constructor to avoid having to + ;; search through things like `cl-struct-erc-v3--extension-tags' + ;; or `cl--struct-class-parents'. + (_ (eq 'erc-v3--capability (get constructor 'erc-v3--extension-supe= r)))) + (get constructor 'erc-v3--extension-canon))) + +(defun erc-v3--ensure-deps (extension) + "Check `depends' slot of `erc-v3--extension' EXTENSION. +If dependencies remain unmet, print an error notice and send a `wERR' +into the state machine. Otherwise, transition via `wOK'." + (catch 'done + (dolist (canon (erc-v3--extension-depends extension)) + (when-let* + ((dep (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon)) + ;; Unless dependency is slated to be enabled or already is... + (_ (not (or (memq (erc-v3--extension-phase dep) + (list erc-v3--phase-CHECK erc-v3--phase-QOUT)) + (erc-v3--enabled-p dep))))) + (erc-v3--transition extension erc-v3--event-wERR) + (erc-button--display-error-notice-with-keys + (current-buffer) "Problem resolving dependencies." + " Disabling capability '%s' because of unmet requirement '%s'." + " Try checking option `erc-v3-extensions'." + (erc-v3--capability-key extension) canon) + (throw 'done t))) + (erc-v3--transition extension erc-v3--event-wOK))) + +(defvar erc-v3--fatal-mode-body-failure-p t + "Whether to destroy the session if an extension's mode body signals.") + +;; XXX the attempt to gracefully handle a desync below is just for +;; discussion purposes and will likely be removed, along with related +;; items from the transition table and the test suite. Instead, it +;; should mark the mode as having failed (m=3De) and print a message +;; recommending manual intervention: investigate, /QUIT, report, etc. +(defun erc-v3--ensure-enabled (candidates) + "Enable presorted list of `erc-v3--extension' CANDIDATES. +If a candidate's mode variable is null in any buffer of the connection, +set it to the existing `erc-v3--extension' instance from the `object' +slot of the server buffer's `erc-v3--caps' object, and then call the +equivalent of its \"mode command\"." + (while-let ((cap (pop candidates)) + (variable (get (erc-v3--extension-canon cap) + 'erc-v3--extension-class)) + (mode (get (erc-v3--extension-canon cap) + 'erc-v3--extension-minor-mode))) + ;; Even though extensions are supposed to use the shared struct + ;; for shared state, rogue hooks may blindly assume the "enable + ;; body" always runs first in the server buffer. + (condition-case-unless-debug err + (progn + (unless (symbol-value variable) + (set variable cap) + (funcall mode +1)) + (erc-with-all-buffers-of-server erc-server-process #'erc-target + ;; Unlike some normal minor modes, extensions never disable + ;; themselves if requirements are unmet. + (unless (symbol-value variable) + (funcall mode +1))) + (erc-v3--transition cap erc-v3--event-mOK)) + (error + ;; The remaining members of CANDIDATES that depend on cap must + ;; also be taken offline, in addition to anything already up. + (let* ((others candidates) + (test (lambda (o) + (or (and (erc-v3--enabled-p o) (not (erc-v3--error-p= o))) + (memq o others))))) + (setq candidates nil) ; break loop + (dolist (o (cons cap (erc-v3--deps-gather-dependents cap test))) + (erc-v3--transition o erc-v3--event-mERR) + (let ((mode (get (erc-v3--extension-canon o) + 'erc-v3--extension-minor-mode))) + (erc-button--display-error-notice-with-keys + "Failed to activate %s: %S" mode err) + (if erc-v3--fatal-mode-body-failure-p + (when (eq cap o) + (delete-process erc-server-process)) + (erc-with-all-buffers-of-server erc-server-process nil + (with-demoted-errors "Problem disabling extension: %S" + (funcall mode -1))))))))))) + +(defun erc-v3--ensure-disabled (candidates) + "Disable list of `erc-v3--extension' CANDIDATES and their dependencies. +Do so in reverse-topo order so that the most dependent objects go down +first. Don't attempt to fail gracefully by syncing on mode-command +failure. Destroy the session instead." + (let* ((gathered (delete-dups + `(,@candidates + ,@(mapcan #'erc-v3--deps-gather-dependents candidate= s)))) + (todo (erc-v3--deps-tsort gathered + (erc-v3--deps-build-dag gathered)))) + (dolist (o (nreverse todo)) + (when-let* ((variable (get (erc-v3--extension-canon o) + 'erc-v3--extension-class)) + ((symbol-value variable)) + (mode (get (erc-v3--extension-canon o) + 'erc-v3--extension-minor-mode))) + (set variable nil) + (condition-case-unless-debug err + (progn + (funcall mode -1) + (erc-with-all-buffers-of-server erc-server-process #'erc-tar= get + (funcall mode -1))) + ;; This can happen if an active extension is DEL'd by the + ;; server and its "disable body" signals. + (error + (erc-v3--transition o erc-v3--event-mERR) + (erc-button--display-error-notice-with-keys + "Failed to disable %s properly: %S. ERC is now out of sync wit= h" + " the server and cannot recover." + (if erc-v3--fatal-mode-body-failure-p + (progn (delete-process erc-server-process) " Disconnecting= ...") + "Recommend issuing a /QUIT and investigating.") + mode err))) + (erc-v3--transition o erc-v3--event-mOK))))) + +;; ACK handling is complicated +;; +;; > If an ACK reply originating from the server is spread across +;; > multiple lines, a client MUST NOT change capabilities until the +;; > last ACK of the set is received. +;; +;; What this means is that a server may not send all ACKs for one or +;; more REQs in a single message. (Not to be confused with multi-line +;; LS and LIST responses.) As a consequence of this requirement, the +;; state table gains the "QIN" rendezvous, which extensions, like SASL, +;; can use for suspending the main protocol. + +(defun erc-v3--consider-answered () + "Run subcommand handlers and perform mode (de)activation. +Only do the latter if all queues are empty, and do nothing if all +outstanding \"REQ\"s haven't all been accounted for." + ;; Start a new deadline for processing ACKs. + (unless (seq-some (lambda (o) (eq erc-v3--phase-SEND + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps)) + (erc-v3--run-timer erc-v3--event-wERR erc-v3--sync-timeout-seconds) + (let ((inhibited ())) + (dolist (item (erc-v3--caps-queue-in erc-v3--caps)) + (funcall (erc-v3--subcmd2handler (car item)) (cdr item)) + ;; Push back if still queued to maintain invariant. + (when (eq erc-v3--phase-QIN (erc-v3--extension-phase (cdr item))) + (push item inhibited))) + (setf (erc-v3--caps-queue-in erc-v3--caps) (nreverse inhibited))) + ;; Check that handlers haven't suspended processing to conduct + ;; external business, such as SASL or `extended-isupport'. + (unless (seq-some #'erc-v3--queued-p (erc-v3--caps-queue-out erc-v3--c= aps)) + ;; Disable negated and DEL'd caps after disabling their dependents. + (when-let* ((down (erc-v3--caps-by-phase DOWN))) + (erc-v3--ensure-disabled down)) + ;; Enable all other caps after their dependencies. + (when-let* ((up (erc-v3--caps-by-phase UP))) + (erc-v3--ensure-enabled up))))) + +(defun erc-v3--check-answered (subcmd key) + "Enqueue KEY's capability to be enabled on SUBCMD \"ACK\". +Or disabled on \"NAK\"." + (let ((cap (erc-v3--find-capability-by-key key))) + (cl-assert (or (eq (erc-v3--cap-negated-p key) (erc-v3--unwanted-p cap= )) + (erc-v3--error-p cap))) + (cl-assert (eq erc-v3--phase-QIN + (erc-v3--transition cap (erc-v3--subcmd2event subcmd)))= ))) + + +;;;; ISUPPORT-based extensions + +;; This is only for simple, old-school extensions associated with a +;; single parameter whose presence advertises support. Likely useless +;; for capabilities, like `chathistory', that use ISUPPORT parameters +;; for other purposes. + +(defvar erc-v3--isupport-params + `((WHOX whox ,#'erc-v3--on-isupport-param) + (MONITOR monitor ,#'erc-v3--monitor-on-isupport-param))) + +(defun erc-v3--on-isupport-param (extension _key _value) + "Call EXTENSION with \"ISUPPORT\" parameter KEY and VALUE." + (when (eq erc-v3--phase-CHECK + (erc-v3--transition extension erc-v3--event-s005)) + (unless (eq erc-v3--phase-LOG (erc-v3--ensure-deps extension)) + (erc-v3--ensure-enabled (list extension))))) + +(defun erc-v3--server-005 (&rest _) + "Run code for params in `erc-v3--isupport-params' in server buffer." + (pcase-dolist (`(,param ,canon ,handler) erc-v3--isupport-params) + (when-let* ((item (erc--get-isupport-entry param)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall handler cap (car item) (cdr item)))) + nil) + + +;;;; Extension: cap-notify + +(erc-v3--define-capability cap-notify) + + +;;;; Extension: multi-prefix + +;; User tables aren't currently updated from /WHOIS responses because +;; servers only send 319, which includes status prefixes, for users in +;; shared channels. And such status info should already be current. + +(erc-v3--define-capability multi-prefix + (erc--set-up-response-function 352 erc-v3--multi-prefix + :override #'erc-v3--server-352)) + +(defvar erc-message-english-s352-v3 "%-11c %-10n %-3s %-2a %u@%h (%f)" + "English `erc-message-template' template for key `s352-v3'.") + +(defun erc-v3--multi-prefix--partition (name statuses) + "Parse NAME as a status-prefixed nick or full NUH. +Use STATUSES to determine the set of valid channel-membership prefixes. +Return a backward-compatible list of (STATUS SUBSET NUH), where STATUS +is the numeric union of all applicable statuses, SUBSET is the string of +enabled status chars, and NUH is the nick or full NUH suffixing NAME." + (declare (ftype (function (string string) list))) + (let ((status 0) + (count 0)) + (catch 'done + (seq-doseq (c name) + (if-let* ((p (erc--strpos c statuses))) + (setq status (logior status (ash 1 p)) + count (1+ count)) + (throw 'done t)))) + (list status (substring name 0 count) (substring name count)))) + +(defun erc-v3--multi-prefix-split-flags (flag-string) + "Return a list of parts from \"RPL_WHOREPLY\" 352 or 354 FLAG-STRING. +Return a list of (AWAY OPER-P (STATUS . PREFIX) REST), where AWAY is the +away char ?H, for here, or ?G, for gone; OPER-P is a boolean indicating +whether the user is an operator; STATUS is an internal number +representing PREFIX; and REST is a list of remaining chars, like ?B for +bot or ?r for registered (varies per IRCd)." + (unless (string-empty-p flag-string) + (let* ((away (aref flag-string 0)) ; either ?H or ?G + (oper (and (> (length flag-string) 1) (eq ?* (aref flag-string = 1)))) + (alist (erc--parsed-prefix-alist (erc--parsed-prefix))) + (statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) + (remaining (substring flag-string (if oper 2 1)))) + ;; Here, `rest' is usually something like (?B ?r) or (?s) + (pcase-let* ((`(,status ,prefix ,rest) + (erc-v3--multi-prefix--partition remaining statuses)) + (letters (apply #'string + (mapcar (lambda (c) (car (rassq c alist= ))) + prefix)))) + (list away oper (cons status letters) (append rest nil)))))) + +(defun erc-v3--update-server-user (nick host full-name login account info) + "Add or update `erc-server-users' entry with params. +Use NICK, HOST, FULL-NAME, LOGIN, and ACCOUNT to init new server user if +needed. Pass INFO to `erc--ensure-server-user-info' before committing." + (if-let* ((server-user (erc-get-server-user nick))) + (erc-update-user server-user nick host login full-name) + (erc-add-server-user nick (make-erc-server-user :nickname nick + :host host + :full-name full-name + :login login + :account account) + info))) + +;; This applies to basic /WHO #chan, etc. Automated WHOs sent by this +;; module are of the WHOX variety. +(defun erc-v3--server-352 (_ parsed) + "Act like `erc-server-352' and handle PARSED \"RPL_WHOREPLY\". +Attempt to parse multi-prefixes. Update existing user records in server +and query/channel tables." + (pcase-let* ((`(,channel ,login ,host ,_server ,nick ,flags ,hop-real) + (cdr (erc-response.command-args parsed))) + (`(,away-flag ,_oper (,status . ,letters) ,_rest) + (erc-v3--multi-prefix-split-flags flags)) + ;; Discard hops in trailing arg. + (full-name (and (string-match (rx (: bot (+ (any "0-9")) " = ") + (group (* nonl)) eot) + hop-real) + (match-string 1 hop-real)))) + (if (equal channel "*") + (erc-v3--update-server-user nick host full-name login nil nil) + (erc-with-buffer (channel) ; no-op if buffer doesn't exist + (erc--update-current-channel-member + (erc-get-channel-member nick) status nil nick host login full-nam= e) + (erc-display-message parsed 'notice (current-buffer) 's352-v3 + ?c channel ?n nick ?a (string away-flag) + ?s letters + ?u login ?h host ?f full-name)))) + nil) + + +;;;; Extension: userhost-in-names + +(erc-v3--define-capability userhost-in-names) + + +;;;; Extension: message-tags + +;; TODO when a backing store is eventually implemented, this extension +;; should use a native ID, likely a fixnum corresponding to a row ID or +;; similar in the store, instead of retaining the message ID in-buffer +;; via a text property. + +(defvar erc-v3--message-tags-retain-ids-p nil + "Whether to store IDs as a per-message msg property.") + +(erc-v3--define-capability message-tags + (if erc-v3--message-tags + (when erc-v3--message-tags-retain-ids-p + (add-hook 'erc-insert-pre-hook + #'erc-v3--message-tags-add-message-id-text-prop 20 t)) + (remove-hook 'erc-insert-pre-hook + #'erc-v3--message-tags-add-message-id-text-prop t))) + +(defconst erc-v3--message-tags-tag-escapes + '((";" . "\\:") + (" " . "\\s") + ("\\" . "\\\\") + ("\r" . "\\r") + ("\n" . "\\n"))) + +(defconst erc-v3--message-tags-tag-escaped-regexp + (rx (or ?\; ?\ ?\\ ?\r ?\n))) + +(defconst erc-v3--message-tags-tag-unescaped-regexp + (rx (or "\\:" "\\s" "\\\\" "\\r" "\\n" + (seq "\\" (or string-end (not (or ":" "s" "n" "r" "\\"))))))) + +;; These operations are not inverses: unescaping may degenerate the +;; original by dropping stranded or misplaced backslashes. See +;; test/lisp/erc/resources/erc-d/erc-d-tests.el for tests. + +(defun erc-v3--message-tags-unescape-tag-value (str) + "Undo substitution of char placeholders in raw tag value STR." + (replace-regexp-in-string erc-v3--message-tags-tag-unescaped-regexp + (lambda (s) + (or (car (rassoc + s erc-v3--message-tags-tag-escapes= )) + (substring s 1))) + str t t)) + +(defun erc-v3--message-tags-escape-tag-value (str) + "Swap out banned chars in tag value STR with message representation." + (replace-regexp-in-string erc-v3--message-tags-tag-escaped-regexp + (lambda (s) + (cdr (assoc s erc-v3--message-tags-tag-escap= es))) + str t t)) + +(defun erc-v3--message-tags-add-message-id-text-prop (_) + "Add message ID as `erc--msgid' property on inserted message." + (cl-assert erc-v3--message-tags-retain-ids-p) + (when-let* ((parsed erc--parsed-response) + (tags (erc-response.tags parsed)) + (found (erc--tags-get 'msgid tags))) + (puthash 'erc--msgid found erc--msg-props))) + +(cl-defmethod erc--parse-message-tags (raw &context (erc-v3-mode (eql t))) + "Parse RAW string into an alist of symbol keys and string values. +Assume client code interacting with the returned alist will have +interned the keys they care about if only by virtue of their inclusion +as literals in the program text. Only dedupe tags with known keys. Use +uninterned symbols for keys not already interned." + (if (eq erc-tags-format 'legacy) + (cl-call-next-method) + (let (tags) + (dolist (part (split-string raw ";") (nreverse tags)) + (let* ((pos (string-search "=3D" part)) + (name (if pos (substring part 0 pos) part)) + (key (and (not (string-empty-p name)) + (or (intern-soft name) (make-symbol name))))) + ;; Clobber existing items for known tags. + (when key + (setf (alist-get key tags) ; could use string=3D for unknown + (and-let* ((pos) + (value (substring part (1+ pos))) + ((not (string-empty-p value)))) + (erc-v3--message-tags-unescape-tag-value + (decode-coding-string value 'utf-8 t)))))))))) + +;; TODO make this useful. Currently, it just ensures messages don't +;; end up in the server buffer. +(define-erc-response-handler (TAGMSG) + "Handle a TAGMSG command." nil + nil) + +(defun erc-v3--merge-client-tags (tags) + "Reassemble client TAGS in preparation for sending." + (let ((parts ())) + (dolist (tag tags) + ;; Account for differing tag formats. + (let* ((raw-value (or (car-safe (cdr tag)) (cdr tag))) + (val (and raw-value (not (string-empty-p raw-value)) + (encode-coding-string + (erc-v3--message-tags-escape-tag-value raw-value) + 'utf-8)))) + (push (concat (if (symbolp (car tag)) + (symbol-name (car tag)) + (car tag)) + (and val "=3D") val) + parts))) + (let ((data (string-join (nreverse parts) ";"))) + (when (> (string-bytes data) 4094) + (error "Max allowed tags size exceeded: %d" (string-bytes data))) + (concat "@" data " ")))) + +(defvar erc-v3--unescaped-client-tags nil + "Client tags for current outgoing request.") + +(cl-defmethod erc--server-send + (string force target &context (erc-v3--unescaped-client-tags cons)) + (setq string + (concat (erc-v3--merge-client-tags erc-v3--unescaped-client-tags) + string)) + (cl-call-next-method string force target)) + + +;;;; Extension: server-time + +;; For znc.in/server-time-iso, override `erc-stamp--current-time'. + +(erc-v3--define-capability server-time + (if erc-v3--server-time + (progn + (when (and erc--target (erc--module-active-p 'button)) + (require 'erc-button) + (defvar erc-button--phantom-users-mode) + (when erc-button--phantom-users-mode + (erc-v3--server-time-on-phantom-users-mode)) + (add-hook 'erc-button--phantom-users-mode-hook + #'erc-v3--server-time-on-phantom-users-mode 20 t)) + (add-function :before-until (local 'erc--current-time-pair-functio= n) + #'erc-v3--current-time-pair '((depth . 40)))) + (remove-function (local 'erc--current-time-pair-function) + #'erc-v3--current-time-pair) + (kill-local-variable 'erc-v3--server-time-display-latest) + (remove-hook 'erc-button--phantom-users-mode-hook + #'erc-v3--server-time-on-phantom-users-mode t))) + +(defvar-local erc-v3--server-time-display-latest nil) +(defvar erc-v3--server-time-display-nested-p nil) +(defvar erc-v3--server-time-pulse-late-arrivals-p (not noninteractive)) + +(defun erc-v3--server-time-find-splice-point (p target-time) + "Scan backwards to find newest message with TARGET-TIME, starting from P= ." + (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (qq (erc--get-inserted-msg-beg q)) + (ts (get-text-property qq 'erc--ts)) + ((time-less-p target-time ts))) + (setq p qq)) + p) + +(defun erc-v3--server-time-pulse () + "Highlight entire narrowed buffer." + (pulse-momentary-highlight-region (point-min) (point-max))) + +(cl-defmethod erc--insert-line + (_ &context (erc-v3--server-time erc-v3--server-time)) + "Insert late-arriving messages earlier in buffer." + (if-let* (((null erc--insert-marker)) + ((not (buffer-narrowed-p))) + ((not erc-v3--server-time-display-nested-p)) + (current (erc--current-time-pair)) ; used in else form + (last-seen erc-v3--server-time-display-latest) + ((time-less-p current last-seen)) + (p (erc--get-inserted-msg-beg erc-insert-marker)) + (pt (erc-v3--server-time-find-splice-point p current))) + (let ((erc-v3--server-time-display-nested-p t) + (erc-insert-post-hook + (if (and erc-v3--server-time-pulse-late-arrivals-p + (eq (window-buffer) (current-buffer)) + ;; Suppress during help text and history. + (time-less-p 1.0 (time-subtract last-seen current))) + `(,@(ensure-list erc-insert-post-hook) + erc-v3--server-time-pulse) + erc-insert-post-hook))) + (erc--with-spliced-insertion pt + (cl-call-next-method))) + (unless (or erc-v3--server-time-display-nested-p + (erc--check-msg-prop 'erc--msg 'datestamp)) + (setq erc-v3--server-time-display-latest current)) + (cl-call-next-method))) + +(defun erc-v3--current-time-pair () + "Return a Lisp time from tag if `erc--parsed-response' is non-nil." + (and erc--parsed-response + (erc--time-pair-from-time-tag erc--parsed-response))) + +(defun erc-v3--server-time-on-phantom-users-mode () + "Perform setup/teardown for server-time extension." + (defvar erc-button--phantom-users-mode) + (if erc-button--phantom-users-mode + (add-function :filter-return (local 'erc--cmem-from-nick-function) + #'erc-v3--server-time-update-phantom-cmem '((depth . 2= 0))) + (remove-function (local 'erc--cmem-from-nick-function) + #'erc-v3--server-time-update-phantom-cmem))) + +(defun erc-v3--server-time-update-phantom-cmem (cmem) + "Update last-message-time slot of channel-user of CMEM." + (when-let* ((cusr (cdr cmem)) + ((eq 'erc--phantom-channel-user (aref cusr 0)))) + (cl-assert (erc-v3--server-time-p erc-v3--server-time)) + (cl-assert (erc-response-p erc--parsed-response)) + (cl-assert (erc-response.tags erc--parsed-response)) + (setf (erc-channel-user-last-message-time cusr) + (erc--current-time-pair))) + cmem) + + +;;;; Extension: echo-message + +;; TODO make sure this works with servers offering a permanent presence +;; feature that specify a different host in the source/sender NUH +;; depending on the originating client. + +(erc-v3--define-capability echo-message + (if erc-v3--echo-message + (progn + (add-function :override (local 'erc--send-action-function) + #'erc--send-action-perform-ctcp) + (add-function :around (local 'erc--send-message-nested-function) + #'erc-v3--echo-message-inhibit-insert-on-send-messag= e) + (add-hook 'erc--input-review-functions + #'erc-v3--echo-message-on-pre-send 75 t)) + (remove-function (local 'erc--send-action-function) + #'erc--send-action-perform-ctcp) + (remove-function (local 'erc--send-message-nested-function) + #'erc-v3--echo-message-inhibit-insert-on-send-message) + (remove-hook 'erc--input-review-functions + #'erc-v3--echo-message-on-pre-send t))) + +(defun erc-v3--echo-message-on-pre-send (input) + "Suppress insertion of `erc-input' object INPUT." + (cl-assert erc-v3--echo-message) + (setf (erc-input-insertp input) nil)) + +(cl-defmethod erc--send-message-external + (line force &context (erc-v3--echo-message erc-v3--echo-message)) + (erc-message "PRIVMSG" (concat (erc-target) " " line) force) + t) + +;; Echoing of command lines for /SAY, /SV, etc. would normally be +;; suppressed on account of their being slash commands. However, +;; since they handle their own insertion, additional steps are +;; required. /ME is different because it uses `erc-display-message' +;; instead of `erc-display-msg', even though it's basically identical +;; to an outgoing chat message. + +(defvar erc-v3--echo-message-allow-noncommands-p nil + "Allow non-commands, such as /SAY, /SV, etc. to emit labeled messages. +This flag does not concern original, submitted command lines themselves +but rather replacement text those commands generate, which is sent via +nested calls to `erc--send-input-lines'.") + +(defun erc-v3--echo-message-inhibit-insert-on-send-message (orig &rest arg= s) + "With `erc-v3--echo-message-allow-noncommands-p', call ORIG with ARGS. +Otherwise, arrange to do so while suppressing input insertion." + (cl-assert erc-v3--echo-message) + (if erc-v3--echo-message-allow-noncommands-p + (apply orig args) + (let ((erc-pre-send-functions (cons #'erc-v3--echo-message-on-pre-send + (ensure-list erc-pre-send-function= s)))) + (apply orig args)))) + + +;;;; Extension: WHOX + +;; This extension could probably be moved to `erc-v3-extensions' to make +;; it optional, but it seems pretty necessary for full account support. +;; It stood apart for decades before becoming an official extension [1]. +;; The older specs appear to be more extensive [2], and some servers +;; apparently still adhere to these variants. The quakenet one says the +;; "flags" field always contains all prefixes, as if `multi-prefix' were +;; always enabled: +;; +;; > flags will contain all the information about a user on a channel. +;; > @ for op'd, + for voiced, and ! for zombie. +;; +;; However, as of June 2024, there's some ambiguity as to whether this +;; should be the case when `multi-prefix' is disabled, whether by +;; omission or otherwise. It's been reported that Solanum behaves as +;; if it's enabled whenever WHOX is advertised. +;; +;; [1] https://ircv3.net/specs/extensions/whox (official as of 2022) +;; [2] https://github.com/quakenet/snircd/raw/master/doc/readme.who +;; https://faerion.sourceforge.net/doc/irc/whox.var +;; https://ircu.sourceforge.net/release.2.10.01-who.html + +(erc-v3--define-extension whox + :slots (( token 0 :type natnum + :documentation "Counter for generated tokens.") + ( requests nil :type (list-of erc-v3--whox-request) + :documentation "List of pending jobs.") + ( req-seen nil :type list + :documentation "Finished jobs removed from `requests'.") + ( penalty 10 :type natnum + :documentation "Back-off duration in seconds for delay timer.") + ( timer nil :type (or null vector) + :documentation "Delay timer.")) + (erc--set-up-response-function 263 erc-v3--whox + :override #'erc-v3--server-263) + (unless erc--target + ;; When `erc-server-flood-queue' is empty, requesting WHO info on + ;; JOIN is too early. + (if erc-v3--whox + (progn + (add-hook 'erc-server-329-functions + #'erc-v3--request-who-after-mode 40 t) + (add-hook 'erc-server-315-functions #'erc-v3--whox-handle-315 -2= 0 t)) + (remove-hook 'erc-server-329-functions + #'erc-v3--request-who-after-mode t) + (remove-hook 'erc-server-315-functions #'erc-v3--whox-handle-315 t))= )) + +(cl-defstruct erc-v3--whox-request + "WHOX request object." + (token (cl-callf (lambda (v) (% (1+ v) 1024)) + (erc-v3--whox-token erc-v3--whox)) + :type natnum) + (target (error "Required `:target' keyword missing") :type string) + (fields (error "Required `:fields' keyword missing") :type string) + (handler (error "Required `:handler' keyword missing") :type function)) + +(defun erc-v3--whox-delete (token) + "Remove request for TOKEN from `requests' slot of `erc-v3--whox'." + (setf (erc-v3--whox-requests erc-v3--whox) + (cl-delete token (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token))) + +(defun erc-v3--whox-make-request (request) + "Prepare a \"WHO\" REQUEST." + (pcase-exhaustive request + ((cl-struct erc-v3--whox-request token target fields) + (cl-assert token) + (setq fields (concat (and (/=3D ?t (aref fields 0)) "t") fields "," + (number-to-string token))) + (erc-server-send (concat "WHO " target " %" fields) nil target)))) + +(defun erc-v3--whox-enqueue (target fields handler) + "Schedule a \"WHO\" request for immediate or deferred sending. +Use TARGET, FIELDS, and HANDLER to make a new request object." + (let ((existing (erc-v3--whox-requests erc-v3--whox)) + (new (make-erc-v3--whox-request :target target + :fields fields + :handler handler))) + (push new (erc-v3--whox-requests erc-v3--whox)) + (unless existing + (erc-v3--whox-make-request new)))) + +(defvar erc-v3--whox-on-354-functions nil) + +(defun erc-v3--whox-handle-channel-user (parsed parts) + "Update channel user from PARSED \"WHOX\" reply with fields \"cuhnflar\". +Do so with response parameters PARTS." + ;; FIXME explain why `idle' is ignored here. + (pcase-let* ((`(,target ,login ,host ,nick ,flags ,_idle ,account) parts) + (account (and (not (string=3D account "0")) account)) + (full-name (erc-response.contents parsed)) + (`(,away ,_oper (,status . ,_) ,_rest) + (erc-v3--multi-prefix-split-flags flags))) + (setq away (if (eq away ?G) "" nil)) + ;; The request may be for a query buffer, whose `erc-channel-member' + ;; table also needs updating. + (when (string=3D target "*") + (setq target nick)) + (erc-with-buffer (target) + (if-let* ((cmem (erc-get-channel-user nick))) + (erc--update-current-channel-member + cmem status nil nick host login full-name `(away . ,away) accou= nt) + (erc--create-current-channel-member + nick status nil nick host login full-name `(away . ,away) account= )) + (run-hooks 'erc-v3--whox-on-354-functions)))) + +(defun erc-v3--request-who-after-mode (_ parsed) + "Schedule a \"WHOX\" request on PARSED \"329\" response." + (when-let* ((channel (cadr (erc-response.command-args parsed)))) + (erc-with-buffer (channel) + (erc-v3--whox-on-join))) + nil) + +;; FIXME reduce the amount of fields, especially those we just ignore. +(cl-defmethod erc-v3--whox-on-join () + "Request WHO info on \"JOIN\" for WHOX-aware target buffers. +Specify fields parameter as \"cuhnflar\" for channel, user, host, nick, +flags, idle, account, and real-name respectively." + (erc-v3--whox-enqueue (erc-target) "cuhnflar" + #'erc-v3--whox-handle-channel-user)) + +(define-erc-response-handler (354) "WHOX RPL_WHOSPCRPL." nil + (pcase-let* + ;; The CAR is normally our current nick. + ((`(,_ ,token . ,parts) (erc-response.command-args parsed)) + (token (and token + (string-match-p (rx bot (+ (any "0-9")) eot) token) + (string-to-number token))) + (seen (cl-find token (erc-v3--whox-req-seen erc-v3--whox) + :key #'erc-v3--whox-request-token)) + (new (or seen (cl-find token (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token)))) + ;; At the very least, server sends one 354 with your info. + (unless seen + (push new (erc-v3--whox-req-seen erc-v3--whox)) + (setf (erc-v3--whox-requests erc-v3--whox) + (delq new (erc-v3--whox-requests erc-v3--whox)))) + (funcall (erc-v3--whox-request-handler new) parsed parts)) + nil) + +(defun erc-v3--whox-request-delayed (buffer) + "Request a \"WHOX\" query in BUFFER." + (with-current-buffer buffer + (setf (erc-v3--whox-timer erc-v3--whox) nil) + (cl-assert (erc-v3--whox-requests erc-v3--whox)) + (when (erc-server-process-alive buffer) + (erc-v3--whox-make-request + (car (last (erc-v3--whox-requests erc-v3--whox))))))) + +;; An internal method could be used instead, but it would need to take +;; care to avoid running on 318, etc. +(defun erc-v3--whox-handle-315 (_proc parsed) + "Make a \"WHOX\" request from PARSED \"315\" response." + (pcase-let* ((`(,_ ,target . ,_) (erc-response.command-args parsed)) + (found (cl-find target (erc-v3--whox-req-seen erc-v3--whox) + :key #'erc-v3--whox-request-target + :test #'string=3D))) + (when (erc-v3--whox-requests erc-v3--whox) + (if found + (erc-v3--whox-make-request + (cl-find (1+ (erc-v3--whox-request-token found)) + (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token)) + ;; Could spin for a bit here, but that could hide an actual + ;; concurrency problem. Better to know if the user did + ;; something strange, like quit immediately upon joining a + ;; channel. + ;; + ;; Seems `target' may be an asterisk if a 263 has just arrived. + (unless (erc-v3--whox-timer erc-v3--whox) + (erc-button--display-error-notice-with-keys + (erc-server-buffer) + "Missing responses for " target " %S. Please report." + (list :seen (erc-v3--whox-req-seen erc-v3--whox) + :reqs (erc-v3--whox-requests erc-v3--whox))))))) + nil) + +(defvar erc-message-english-s263-rate-limit + "Rate limit exceeded retrieving user data for %t. Next attempt in %us." + "English `erc-format-message' template for key `s263-rate-limit'.") + +;; Without labeled-response, there's no way to tell which request was +;; the offending one. Hopefully, restricting their issuance to serial +;; round trips reduces the likelihood of mistaken identity. +(defun erc-v3--server-263 (_proc parsed) + "Handle a PARSED 263 response for a query made by `erc-v3--whox'. +Schedule another attempt `erc-v3--whox-penalty' seconds in the future. +Then double `erc-v3--whox-penalty'." + (pcase (erc-response.command-args parsed) + ((and `(,_ "WHO" ,_) + (let `(,oldest . ,_) (last (erc-v3--whox-requests erc-v3--whox))= )) + (erc-display-message parsed 'notice (current-buffer) 's263-rate-limit + ?t (erc-v3--whox-request-target oldest) + ?u (erc-v3--whox-penalty erc-v3--whox)) + (when (and (null (erc-v3--whox-timer erc-v3--whox)) + (erc-v3--whox-requests erc-v3--whox)) + (setf (erc-v3--whox-timer erc-v3--whox) + (run-at-time (erc-v3--whox-penalty erc-v3--whox) nil + #'erc-v3--whox-request-delayed + (current-buffer)) + ;; + (erc-v3--whox-penalty erc-v3--whox) + (* 2 (erc-v3--whox-penalty erc-v3--whox)))))) + nil) + + +;;;; Extension: Monitor + +;; TODO add tests for this extension! + +(erc-v3--define-extension monitor + :slots (( targets nil :type (list-of string) + :documentation "Targets with active monitor jobs.") + ( count 0 :type natnum + :documentation "Number of monitored targets.") + ( max 0 :type natnum + :documentation "Max number of active monitor jobs.")) + (if erc--target + (if erc-v3--monitor + (progn + (add-hook 'erc-connect-pre-hook #'erc-v3--monitor-on-new-query= 40 t) + (add-hook 'erc-kill-buffer-hook #'erc-v3--monitor-forget 40 t) + (when (erc-query-buffer-p) + (add-function :override + (local 'erc--query-table-synced-predicate) + #'erc-v3--monitor-active-p)) + (add-function :override (local 'erc--forget-server-user-functi= on) + #'erc--forget-server-user)) + (remove-hook 'erc-connect-pre-hook #'erc-v3--monitor-on-new-query = t) + (remove-hook 'erc-kill-buffer-hook #'erc-v3--monitor-forget t) + (remove-function (local 'erc--query-table-synced-predicate) + #'erc-v3--monitor-active-p) + (remove-function (local 'erc--forget-server-user-function) + #'erc--forget-server-user)) + (when (erc--module-active-p 'querypoll) + (erc-button--display-error-notice-with-keys + (current-buffer) + "The `monitor' extension obsoletes module `querypoll'." + " Disabling the latter.") + (when (fboundp 'erc-querypoll-mode) + (erc-querypoll-mode -1))))) + +;; Currently, this capability can't easily formally depend on plain +;; `monitor' because it's an ISUPPORT-based extension, which is normally +;; only discovered and enabled after negotiation ends. However, with +;; `extended-isupport', it may be possible to defer activation via +;; overridden "ACK" method or similar, marking the extension as resolved +;; upon seeing a matching 005 before BATCH end. +(erc-v3--define-capability extended-monitor) + +(defun erc-v3--monitor-on-isupport-param (ext key value) + "Remember KEY and VALUE for \"MONITOR\" EXT and enable." + (cl-assert (eq key 'MONITOR)) + (cl-assert (erc-v3--monitor-p ext)) + (setf (erc-v3--monitor-max ext) + (or (and value (string-to-number (car value))) most-positive-fixnu= m)) + (erc-v3--on-isupport-param ext key value)) + +(defun erc-v3--monitor-active-p () + "Return non-nil when the monitor extension is enabled." + erc-v3--monitor) + +;; FIXME make this an option, possibly of a different type. +(defvar erc-v3--monitor-exclude-regexp + (rx bot + (or "alis" "NickServ" "ChanServ" "MemoServ" "BouncerServ" "SaslServ") + eot) + "Pattern to ignore common services and bots you regularly query.") + +(defun erc-v3--monitor-on-new-query (&rest _) + "Send \"MONITOR\" request when initializing a query buffer." + (when (and erc-v3--monitor (erc-query-buffer-p)) + (let* ((target (erc-target)) + (nickd (erc-downcase target))) + (unless (or (member nickd (erc-v3--monitor-targets erc-v3--monitor)) + (string-match erc-v3--monitor-exclude-regexp target) + (not (erc-is-valid-nick-p target)) + (erc-current-nick-p nickd) + (>=3D (erc-v3--monitor-count erc-v3--monitor) + (erc-v3--monitor-max erc-v3--monitor))) + (push nickd (erc-v3--monitor-targets erc-v3--monitor)) + (cl-incf (erc-v3--monitor-count erc-v3--monitor)) + (erc-server-send (concat "MONITOR + " target) nil target))))) + +(defun erc-v3--monitor-forget () + "Send a \"MONITOR\" unsubscribe request when killing a query buffer." + (when (erc-query-buffer-p) + (let ((target (erc-target))) + (when (and erc-server-connected + (not erc-networks--target-transplant-in-progress-p)) + (erc-server-send (concat "MONITOR - " target) nil target)) + (cl-decf (erc-v3--monitor-count erc-v3--monitor)) + (setf (erc-v3--monitor-targets erc-v3--monitor) + (delete (erc-downcase target) + (erc-v3--monitor-targets erc-v3--monitor)))))) + +(defvar erc-message-english-s730 "%n is online" + "English `erc-format-message' template for key `s730'.") + +(defvar erc-message-english-s731 "%n is offline" + "English `erc-format-message' template for key `s731'.") + +(define-erc-response-handler (730) "RPL_MONONLINE." nil + (dolist (added (split-string (erc-response.contents parsed) ",")) + (when-let* ((nuh (erc-parse-user added)) + (nick (car nuh)) + (buffer (erc-get-buffer nick erc-server-process))) + (with-current-buffer buffer + (cl-assert (member (erc-downcase nick) + (erc-v3--monitor-targets erc-v3--monitor))) + (unless (erc-get-channel-member nick) + (erc-update-current-channel-member nick nick t nil nil nil nil n= il + (nth 2 nuh) (nth 1 nuh))) + (letrec ((show-fn + (lambda () + (remove-hook 'erc-v3--whox-on-354-functions show-fn t) + ;; Suppress duplicate 730 messages. + (unless (eq 's730 (erc--get-inserted-msg-prop 'erc--ms= g)) + (erc-display-message parsed 'notice (current-buffer) + 's730 ?n nick))))) + (if erc-v3--whox + (progn + (add-hook 'erc-v3--whox-on-354-functions show-fn 20 t) + (erc-v3--whox-on-join)) + (funcall show-fn)))))) + nil) + +(define-erc-response-handler (731) "RPL_MONOFFLINE." nil + (dolist (removed (split-string (erc-response.contents parsed) ",")) + (if-let* ((nuh (erc-parse-user removed)) + (nick (car nuh)) + (nickd (erc-downcase nick)) + (buffer (erc-get-buffer nick erc-server-process))) + (with-current-buffer buffer + (when (and (member nickd (erc-v3--monitor-targets erc-v3--monito= r)) + (or (erc-get-channel-member nick) + ;; User is not in any other target buffer. + (null (erc-get-server-user nick)))) + (unless (eq 's731 (erc--get-inserted-msg-prop 'erc--msg)) + (erc-display-message parsed 'notice (current-buffer) + 's731 ?n nick)) + (erc-remove-current-channel-member nick))) + ;; FIXME how can buffer be non-nil if it's the last item in the VARL= IST? + (unless buffer + (cl-assert nickd) + (cl-decf (erc-v3--monitor-count erc-v3--monitor)) + (setf (erc-v3--monitor-targets erc-v3--monitor) + (delete nickd (erc-v3--monitor-targets erc-v3--monitor)))))) + nil) + + +;;;; Extension: extended-join + +(erc-v3--define-capability extended-join + (erc--set-up-response-function JOIN erc-v3--extended-join + :override #'erc-v3--server-JOIN) + (if erc-v3--extended-join + (if erc--target + (add-hook 'erc-join-hook #'erc-v3--send-mode-on-join 30 t)) + (remove-hook 'erc-join-hook #'erc-v3--send-mode-on-join t))) + +(defvar erc-message-english-JOIN-X "%n (%a: %u@%h) has joined channel %c" + "English `erc-format-message' template for key `JOIN-X'.") + +;; Move "MODE #chan" to a hook so modules like chathistory can process +;; JOINs for the client's nick. +(defun erc-v3--send-mode-on-join () + "Send a \"MODE\" command for current channel or query." + (erc-server-send (concat "MODE " (erc-target)))) + +;; FIXME explain who "others" are and what traditional behavior this +;; compatibility flag restores. +(defvar erc-v3--create-unknown-channel-buffer-when-others-join-p nil + "When non-nil, create a buffer for unknown targets joined by others.") + +(defun erc-v3--join-with-display-context (channel) + "Join CHANNEL with relevant display context." + (let ((erc--display-context (erc--server-determine-join-display-context + channel erc--display-context))) + (save-excursion (erc--open-target channel)))) + +(defun erc-v3--server-JOIN (_ parsed) + "Handle a PARSED \"JOIN\" response containing extended syntax. +Unlike `erc-server-JOIN', do nothing when the buffer has already been +joined. Also, don't bother with `erc-channel-begin-receiving-names' +because the default handler for \"353\" calls it when needed, and +extensions may prevent names from automatically being sent altogether." + (setq parsed erc--parsed-response) + (pcase-let* + ((`(,chnl ,account ,full) (erc-response.command-args parsed)) + (`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)= )) + (account (and (not (string=3D account "*")) account)) + (nickp (erc-current-nick-p nick)) ; we are the ones joining + (buffer (if nickp + (erc-v3--join-with-display-context chnl) + (erc-get-buffer chnl erc-server-process)))) + (when (and (null buffer) + erc-v3--create-unknown-channel-buffer-when-others-join-p + (erc-channel-p chnl)) + (setq buffer (erc-v3--join-with-display-context chnl))) + (when buffer + (with-current-buffer buffer + (unless (and nickp (erc--target-channel-joined-p erc--target)) + (erc-update-current-channel-member nick nick t nil nil nil nil n= il + host login full nil nil accou= nt) + (when nickp + (setf (erc--target-channel-joined-p erc--target) t) + (erc-update-mode-line) + (run-hooks 'erc-join-hook)) + (let ((args (cond + (nickp (list 'JOIN-you ?c chnl)) + (account (list 'JOIN-X ?a account + ?n nick ?u login ?h host ?c chnl)) + (t (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) + (apply #'erc-display-message parsed 'notice buffer args)))))) + nil) + + +;;;; Extension: account-notify + +(erc-v3--define-capability account-notify) + +(defvar erc-message-english-ACCOUNT "Account status for %a: %s as %n" + "English `erc-format-message' template for key `ACCOUNT'.") + +;; When a user logs out of an account, all messages from that nick +;; currently lose their association to that user because account +;; info is not included in the displayed-message metadata. + +(defun erc-v3--update-account (account nick &optional login host) + "Update ACCOUNT field for NICK's `erc-server-user' object. +Use LOGIN and HOST for new server user if needed." + (cl-assert (not (string-empty-p account))) + (if-let* ((user (erc-get-server-user nick))) + (erc-update-user user nil nil nil nil nil account) + ;; `erc-update-current-channel-member' will still honor an ADD + ;; argument so long as nothing yet exists in `erc-channel-users'. + (when (string=3D account "*") + (setq account nil)) + (erc-add-server-user nick (make-erc-server-user :nickname nick + :host host + :login login + :account account)))) + +(define-erc-response-handler (ACCOUNT) + "Handle an ACCOUNT message." nil + (pcase-let* ((account (car (erc-response.command-args parsed))) + (`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) + (erc-v3--update-account account nick login host) + (when (erc-current-nick-p nick) + (erc-display-message parsed 'notice (current-buffer) + 'ACCOUNT ?a account ?n nick ?s "logged in")))) + + +;;;; Extension: account-tag + +;; Some servers send `account-tag' whether you ask for it or not, +;; courtesy of `message-tags'. Assuming `extended-join' and `whox' are +;; provided, negotiating `account-tag' may only buy you account +;; knowledge for queries from those you don't share a channel with. It +;; may also help when trying to determine if the speaker of some +;; historical message, possibly residing in a non-contiguous history +;; playback region, was authenticated when first received by the +;; network. + +(defun erc-v3--key-resolved-p (key) + "Return non-nil if associated minor mode for KEY is enabled." + (and-let* ((o (erc-v3--find-capability-by-key key))) + (erc-v3--enabled-p o))) + +(defvar erc-v3--account-tag-fallback-handler-hooks + '( erc-server-PRIVMSG-functions erc-server-NOTICE-functions + erc-server-JOIN-functions erc-server-MODE-functions + erc-server-PART-functions erc-server-QUIT-functions + erc-server-NICK-functions erc-server-TOPIC-functions + erc-server-KICK-functions erc-server-TAGMSG-functions) + "Handler functions to update account info through if necessary. +Only used if `extended-join' and `account-notify' are missing.") + +(erc-v3--define-capability account-tag + ;; If the server lacks `extended-join' and `account-notify', update + ;; account on certain channel-user server commands, like PRIVMSG, + ;; NOTICE, KICK, JOIN, PART, etc. + (unless erc--target + (if erc-v3--account-tag + ;; FIXME improve these unreliable heuristics or arrange to + ;; remove hook members if those extensions later become active, + ;; maybe via `erc-v3--account-notify-mode-hook', etc. Some + ;; servers and proxies send a bunch of single "NEW :my-cap" + ;; offers upon JOIN (after history playback), but the ordering + ;; is not predictable. (Thankfully, ZNC 1.10.1 happens to send + ;; `account-notify' first.) + (unless (and (or erc-v3--extended-join + (erc-v3--key-resolved-p 'extended-join)) + (or erc-v3--account-notify + (erc-v3--key-resolved-p 'account-notify))) + (dolist (fn erc-v3--account-tag-fallback-handler-hooks) + ;; Place *before* main handler so commands, like NICK, that + ;; refile the existing record under another name still work. + ;; Stick with the less reliable traditional response hooks + ;; here rather than the `erc--response-function' interface + ;; because this fallback scenario is likely rare. + (add-hook fn #'erc-v3--ensure-account -20 t))) + (dolist (fn erc-v3--account-tag-fallback-handler-hooks) + (remove-hook fn #'erc-v3--ensure-account t))))) + +(defun erc-v3--ensure-account (_ parsed) + "Update account info if PARSED response is typically sent by a user." + (when-let* ((tags (erc-response.tags parsed)) + (account (erc--tags-get 'account tags))) + (pcase-let + ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parse= d)))) + (erc-v3--update-account account nick login host))) + nil) + + +;;;; Extension: away-notify + +(erc-v3--define-capability away-notify) + +(define-erc-response-handler (AWAY) + "Handle an AWAY message. +See also RPL_AWAY 301." nil + (pcase-let* ((msg (erc-response.contents parsed)) + (nick (erc-extract-nick (erc-response.sender parsed)))) + (when (string-empty-p msg) + (setq msg nil)) + (erc-update-user-nick nick nil nil nil nil (cons 'away msg) nil)) + nil) + + +;;;; Extension: chghost + +(erc-v3--define-capability chghost) + +(define-erc-response-handler (CHGHOST) + "Handle a CHGHOST message." nil + (pcase-let* ((`(,login ,host) (erc-response.command-args parsed)) + (nick (erc-extract-nick (erc-response.sender parsed)))) + (erc-v3--update-server-user nick host nil login nil nil)) + nil) + + +;;;; Extension: standard-replies + +;; ERC handles arbitrary (unknown) replies regardless of whether the +;; capability has been negotiated because servers can send them +;; regardless. https://github.com/ircv3/ircv3-specifications/pull/506 + +(erc-v3--define-capability standard-replies) + +(defvar erc-message-english-FAIL "%c command failed. %m: %n" + "English `erc-format-message' template for key `FAIL'.") + +(defvar erc-message-english-WARN "Warning re %c command. %m: %n" + "English `erc-format-message' template for key `WARN'.") + +(defvar erc-message-english-NOTE "Note re %c command. %m: %n" + "English `erc-format-message' template for key `NOTE'.") + +(cl-defgeneric erc-v3--standard-replies-handle (type command code rest par= sed) + "Handle a `standard-replies' message of type TYPE. +Expect CODE to be an error code defined in an IRCv3 spec, for example, +\"MULTILINE_INVALID\" from `draft/multiline'. Expect COMMAND to be the +offending command originally sent by ERC. Expect REST to be the +remaining args and PARSED to be an `erc-repsonse' object.") + +(cl-defmethod erc-v3--standard-replies-handle (type command code rest pars= ed) + "Emit a `standard-replies' catch-all message to server buffer. +Determine how to display message from TYPE, COMMAND, CODE, REST, PARSED." + (let ((msg-type (pcase type + ('NOTE 'notice) + ('WARN '(notice error)) + ('FAIL '(t notice error))))) + (erc-display-message parsed msg-type (erc-server-buffer) + type ?c command ?m code + ?n (string-join rest " ")))) + +(defun erc-v3--standard-replies-dispatch (parsed) + "Call method for PARSED standard reply." + (pcase-let* ((`(,maybe-cmd ,code . ,rest) (erc-response.command-args par= sed)) + (command (and (not (equal "*" maybe-cmd)) (intern maybe-cmd= ))) + (code (intern code)) + (type (intern (erc-response.command parsed)))) + (erc-v3--standard-replies-handle type command code rest parsed))) + +(define-erc-response-handler (FAIL) + "Handle a FAIL `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + +(define-erc-response-handler (WARN) + "Handle a WARN `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + +(define-erc-response-handler (NOTE) + "Handle a NOTE `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + + +;;;; Extension: setname + +;; FIXME set `max' from NAMELEN. +(erc-v3--define-capability setname + :slots ((max nil :type (or null integer)))) + +(defvar erc-message-english-name-too-long + "Full-name length (%i) exceeds NAMELEN (%l) defined by the server." + "English `erc-format-message' template for overlong full name.") + +(defun erc-cmd-SETNAME (full-name) + "Tell server to set client's full name to FULL-NAME." + (when-let* ((max (erc-v3--setname-max erc-v3--setname)) + (current (length full-name)) + ((string> current max))) + (erc-display-message nil 'notice 'active 'name-too-long current max)) + (erc-server-send (concat "SETNAME :" (string-remove-prefix " " full-name= )))) +(put 'erc-cmd-SETNAME 'do-not-parse-args t) + +(define-erc-response-handler (SETNAME) + "Handle a \"SETNAME\" message." nil + (pcase-let ((full-name (erc-response.contents parsed)) + (`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) + (erc-v3--update-server-user nick host full-name login nil nil)) + nil) + + +;;;; Common extension utilities + +;; This first set of handlers and utilities provides smart(er) +;; collecting of nicknames, using `multi-prefix' and +;; `userhost-in-names', when applicable. + +;; FIXME relocate this at the top of the file. +(defcustom erc-v3-simulated-names-message-size 200 + "Number of nicks displayed per simulated \"NAMES\" reply (353) message. +When the userhost-in-names extension is active, displaying a 353 line as +originally received tends to be distracting because many nick!user@host +tokens are wide enough that only a couple end up occupying each line, +depending on the frame's dimensions. In large rooms, this can feel like +multiple pages of names scrolling by on end. + +This option attempts to replicate the feel of how ERC has traditionally +displayed 353 messages without the extension, that is, by only printing +the nick portion of each token and waiting until more than a few arrive +before displaying them, so more fit on a single line and in a single +formatted message. However, if the value is nil, ERC won't perform any +of this and will instead faithfully print the contents of each message +as received." + :package-version '(ERC . "5.7") + :type '(choice (const nil) + natnum)) + +(defvar erc-message-english-s353-v3 "Users on %c (%d): %u" + "English `erc-format-message' template for key `s353-v3'.") + +(defvar-local erc-v3--channel-new-member-names nil + "Temporary hash table containing a subset of `erc-channel-members'.") + +(cl-defmethod erc--partition-prefixed-names (name &context + (erc-v3-mode (eql t))) + "Return a list of (STATUS NICK LOGIN HOST). +Act like the base method, except handle multiple prefix chars before +NAME. Only run when ERC-V3-MODE is t." + (pcase-let* + ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) + (`(,status ,_ ,nuh) (erc-v3--multi-prefix--partition name statuses)) + (`(,nick ,login ,host) (erc--parse-nuh nuh))) + (when (and (or nick ; this macro returns nick + (cl-multiple-value-setq (nick login host) + (erc--shuffle-nuh-nickward nick login host)))) + `(,status ,nick ,login ,host)))) + +(declare-function erc-button--deemphasize-plebs "erc-button" (nick-object)) + +(defun erc-v3--print-names (parsed) + "Insert aggregated PARSED implicit \"NAMES\" response into current CHANN= EL. +Expect NAMES to be a list of statusted nicks." + (add-function :filter-return (local 'erc-button--modify-nick-function) + #'erc-button--deemphasize-plebs '((depth . 95))) + ;; Since we wait to print 353s in one go (on 366), spoof the former + ;; command so users who ignore it can opt out. + (unless (equal (erc-response.command parsed) "353") + (setf parsed (copy-erc-response parsed) + (erc-response.command parsed) "353")) + (let* ((sorted (sort (hash-table-values erc-v3--channel-new-member-names) + (lambda (a b) + (let ((status-a (erc-channel-user-status (cdr a))) + (status-b (erc-channel-user-status (cdr b))= )) + (if (=3D status-a status-b) + (string< (erc-downcase + (erc-server-user-nickname (car a)= )) + (erc-downcase + (erc-server-user-nickname (car b)= ))) + (> status-a status-b)))))) ; bigger status fi= rst + (names (mapcar (pcase-lambda (`(,user . ,cusr)) + (concat + (and (not (zerop (erc-channel-user-status cusr)= )) + (erc-v3--format-prefix cusr)) + (erc-server-user-nickname user))) + sorted))) + (erc-display-message parsed 'notice (current-buffer) + 's353-v3 + ?c (erc-target) + ?d (hash-table-count erc-channel-users) + ?u (string-join names " "))) + (remove-function (local 'erc-button--modify-nick-function) + #'erc-button--deemphasize-plebs)) + +;; TODO find out why `erc-channel-end-receiving-names' treats +;; `erc-channel-new-member-names' like a subset of +;; `erc-channel-users'. Aren't they equal (for initial NAMES)? +(defun erc-v3--process-new-member-names (parsed forcep) + "Call `erc-channel-receive-names' with users temporary table. +Afterwards, update actual table with any new members. Ensure +`erc-v3--channel-new-member-names' is non-nil, and add new members here +as well. With FORCEP or if `erc-v3--channel-new-member-names' is larger +than `erc-v3-simulated-names-message-size', call `erc-v3--print-names' +with PARSED." + (unless erc-v3--channel-new-member-names + (setq erc-v3--channel-new-member-names (make-hash-table :test #'equal)= )) + (let ((actual (or erc-channel-new-member-names + (erc-channel-begin-receiving-names))) + (erc-channel-new-member-names (make-hash-table :test #'equal))) + (unless forcep ; 366 + (erc-channel-receive-names (erc-response.contents parsed))) + (maphash (lambda (key value) + (cl-assert (eq value t)) + (puthash key value actual) + (puthash key (gethash key erc-channel-members) + erc-v3--channel-new-member-names)) + erc-channel-new-member-names)) + (when (or forcep (> (hash-table-count erc-v3--channel-new-member-names) + erc-v3-simulated-names-message-size)) + (erc-v3--print-names parsed) + (clrhash erc-v3--channel-new-member-names))) + +;; The reason names aren't merely collected here and only later printed +;; in the 366 handler is because giant rooms with many thousands of +;; names (typically encountered when dealing with a bridge to a non-IRC +;; protocol) would otherwise sit for minutes without any feedback. +(defun erc-v3--server-353 (default proc parsed) + "Maybe override DEFAULT \"RPL_NAMREPLY\" handler. +If `erc-v3-simulated-names-message-size' is non-nil, display a simulated +message containing truncated names. Otherwise, call DEFAULT with PROC +and PARSED." + (if (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((nth 2 (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed nil) + nil) + (funcall default proc parsed))) + +(defun erc-v3--server-366 (proc parsed) + "Maybe run `erc-v3--process-new-member-names'. +If necessary, display a simulated 353 message in PROC's target buffer +for the PARSED 366 response." + ;; :test.libera.chat 366 someNick #emacs :End of /NAMES list + (when (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed 'forcep)))) + +;; These last two handlers are account aware. + +(defun erc-v3--server-900 (_proc parsed) + "Given `erc-response' PARSED, mark this session's user as being logged i= n." + (pcase-let* ((`(,nick ,userhost ,account) + (erc-response.command-args parsed)) + (`(,uh-nick ,login ,host) + (when (and userhost + (not (string=3D userhost "*"))) + (erc-parse-user userhost)))) + ;; Servers may (be configured to) ignore the first two fields. + (when (or (null nick) (string=3D nick "*")) + (setq nick (or uh-nick (erc-current-nick)))) + (cl-assert nick) ; erase me + (erc-v3--update-account account nick login host) + (erc-display-message parsed 'notice (current-buffer) + (erc-response.contents parsed))) + nil) + +(define-erc-response-handler (901) + "Handle \"RPL_LOGGEDOUT\" server command." nil + ;; Some servers send * for target (first arg). + (pcase-let* ((`(,nick ,userhost) (erc-response.command-args parsed)) + (`(,uh-nick ,login ,host) + (when (and userhost (not (string=3D userhost "*"))) + (erc-parse-user userhost))) + (account)) + (when (or (not nick) (string=3D nick "*")) + (setq nick (or uh-nick (erc-current-nick)))) + (cl-assert nick) ; erase me + (setq account (erc-server-user-account (erc-get-server-user nick))) + (erc-v3--update-account "*" nick login host) + (erc-display-message parsed 'notice (current-buffer) + 'ACCOUNT ?a account ?n nick ?s "logged out"))) + + +;;;; UI Helpers + +(defun erc-v3--format-prefix (cusr &optional lettersp) + "When applicable, return string of membership prefixes or letters. +Expect CUSR to be an `erc-channel-user' object. With LETTERSP, +return letters. Add `help-echo' descriptions to all characters." + (and (not (zerop (erc-channel-user-status cusr))) + (let ((alist (erc--parsed-prefix-alist (erc--parsed-prefix)))) + (concat + (and (erc-channel-user-owner cusr) + (propertize (if lettersp "q" (string (alist-get ?q alist))) + 'help-echo "owner")) + (and (erc-channel-user-admin cusr) + (propertize (if lettersp "a" (string (alist-get ?a alist))) + 'help-echo "admin")) + (and (erc-channel-user-op cusr) + (propertize (if lettersp "o" (string (alist-get ?o alist))) + 'help-echo "op")) + (and (erc-channel-user-halfop cusr) + (propertize (if lettersp "h" (string (alist-get ?h alist))) + 'help-echo "half-op")) + (and (erc-channel-user-voice cusr) + (propertize (if lettersp "v" (string (alist-get ?v alist))) + 'help-echo "voice")))))) + +(defun erc-v3--assemble-server-user-info-string (user) + "Format an informative string for USER to display in the echo area. +This is basically what `erc-nick-at-point' shows but with some extra +info." + (let ((away-msg (erc--server-user-away-p user))) + ;; Some NUHs don't have a userhost or just have one or the other. + ;; For now, ignore those. + (concat (and-let* ((login (erc-server-user-login user)) + (host (erc-server-user-host user))) + (concat login "@" host)) + (and-let* ((full-name (erc-server-user-full-name user)) + ((not (string-empty-p full-name)))) + (format " %S" full-name)) + (and away-msg " G") + (and away-msg (not (string-empty-p away-msg)) + (format ": %s" away-msg))))) + +(provide 'erc-v3) + +;;; erc-v3.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 8243034661d..d92c57f835d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2406,6 +2406,7 @@ erc-modules (const :tag "track: Track channel activity in the mode-line" track) (const :tag "truncate: Truncate buffers to a certain size" truncate) (const :tag "unmorse: Translate morse code in messages" unmorse) + (const :tag "v3: Enable IRCv3 features" v3) (const :tag "xdcc: Act as an XDCC file-server" xdcc) (repeat :tag "Others" :inline t symbol)) :package-version '(ERC . "5.6") diff --git a/test/lisp/erc/erc-scenarios-v3-account-notify.el b/test/lisp/e= rc/erc-scenarios-v3-account-notify.el new file mode 100644 index 00000000000..29f53e49266 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3-account-notify.el @@ -0,0 +1,133 @@ +;;; erc-scenarios-v3-account-notify.el --- Scenarios for account-notify -*= - lexical-binding: t -*- + +;; Copyright (C) 2022-2025 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 +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + +;; This shows that JOINs for new channel participants still update the +;; account field if the server lacks `extended-join' but supports +;; `account-tag' (unlikely). The full name remains unknown. +(ert-deftest erc-scenarios-v3-account-notify--account-tag-no-extended-join= () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/account-notify") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + (cons `(now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))) + erc-d-tmpl-vars)) + (erc-v3-extensions '(account-tag echo-message standard-replies)) + (dumb-server (erc-d-run "localhost" t 'no-extended-join)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (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=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 10 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan")) + (let ((inhibit-message t)) + (funcall expect 10 "dummy ([email protected]) has joined") + + ;; Note the lack of a full name after the UH. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol)= )) + "dummy: [email protected]")) ; +4 from "*** " + + (funcall expect 10 "welcome"))))) + +;; This shows that the account field in user records of channel +;; participants is updated when `account-notify' is present and +;; `account-tag' is not. Note that `extended-join' isn't relevant here +;; because users "hacker" and "fool" are not logged in when they JOIN. +;; WHOX is present but not relevant either because the users in question +;; join after the client. This also happens to test the `chghost' +;; extension. Note that this is somewhat unrealistic because some +;; servers send `account-tag' regardless of whether it's been +;; negotiated, so long as `message-tags' has. +(ert-deftest erc-scenarios-v3-account-notify--no-account-tag/chghost () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/account-notify") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + (cons `(now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))) + erc-d-tmpl-vars)) + (dumb-server (erc-d-run "localhost" t 'chghost-no-account-tag)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message standard-replies)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (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" + :full-name "Tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "foonet")) + (ert-info ("Join #chan") + (funcall expect 5 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "hacker ([email protected]) has joined") + + ;; Original host and user for "hacker" still on file. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol))) + "*: [email protected] \"hacker\"")) ; +4 for "*** " + (erc-scenarios-common-say "checkpoint 0") + (funcall expect 5 "fool ([email protected]) has joined") + + ;; Account field for user "fool" is empty. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol))) + "*: [email protected] \"fool\"")) ; +4 for "*** " + (erc-scenarios-common-say "checkpoint 1") + + ;; Host and login updated for "hacker" via CHGHOST. + (funcall expect 5 "<hacker> Changed my host") + (should (equal (erc-scenarios-common--nick-at-point (1+ (pos-bol))) + "jph: [email protected] \"hacker\"")) + (erc-scenarios-common-say "checkpoint 2") + + ;; Account field for user "fool" is populated after ACCOUNT msg. + (funcall expect 5 "<fool> Just logged in") + (should (equal (erc-scenarios-common--nick-at-point (1+ (pos-bol))) + "fool: [email protected] \"fool\"")) + + (funcall expect 5 "<alice> bob: Why do they run away ?")))) + +;;; erc-scenarios-v3-account-notify.el ends here diff --git a/test/lisp/erc/erc-scenarios-v3-sasl.el b/test/lisp/erc/erc-sce= narios-v3-sasl.el new file mode 100644 index 00000000000..de388590571 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3-sasl.el @@ -0,0 +1,200 @@ +;;; erc-scenarios-v3-sasl.el --- SASL v3 tests for ERC -*- lexical-binding= : t -*- + +;; Copyright (C) 2022-2025 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 +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The point of this file is to test the integration between `erc-v3' +;; and `erc-sasl' because the older library has its own limited stub +;; form of CAP negotiation, which can't coexist with the full version. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + +(defun erc-scenarios-v3-sasl--module-sync () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (erc-email-userid "tester@school") + (dumb-server (erc-d-run "localhost" t 'plain)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-sasl-mechanism 'plain) + (erc-sasl-user :nick) + (erc-sasl-password "password123") + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (should (string=3D (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=3D erc-sasl-password "password123")))))) + +(ert-deftest erc-scenarios-v3-sasl--extension-only () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions '(sasl))) + (erc-scenarios-v3-sasl--module-sync))) + +(ert-deftest erc-scenarios-v3-sasl--module-only () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions nil) + (erc-modules (cons 'sasl erc-modules))) + (erc-scenarios-v3-sasl--module-sync))) + +(ert-deftest erc-scenarios-v3-sasl--module-and-extension () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions '(sasl)) + (erc-modules (cons 'sasl erc-modules))) + (erc-scenarios-v3-sasl--module-sync))) + +(defun erc-v3-scenarios--common--v3-sasl (mech) + (defvar sasl-unique-id-function) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/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 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-user :nick) + (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" + :password "sesame" + :full-name "jilles") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Notices received") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "jaguar")) + (funcall expect 10 "Found your hostname") + (funcall expect 20 "marked as being away"))))) + +;; This has a 3.2 extension value "sasl=3Dmech". It also simulates a user +;; having the `sasl' module loaded. +(ert-deftest erc-scenarios-v3-sasl--scram-sha-1 () + :tags '(:expensive-test) + (defvar erc-sasl-authzid) + (let ((erc-modules (cons 'sasl erc-modules)) + (erc-sasl-authzid "jilles")) + (erc-v3-scenarios--common--v3-sasl 'scram-sha-1))) + +;; This has no associated CAP value: "LS cap-notify sasl batch ..." +(ert-deftest erc-scenarios-v3-sasl--scram-sha-256 () + :tags '(:expensive-test) + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (erc-v3-scenarios--common--v3-sasl 'scram-sha-256)) + +(ert-deftest erc-scenarios-v3-sasl--authentication-failure () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-failed)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-password "wrong") + (erc--warnings-buffer-name "*ERC test warnings*") + (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "Opening connection") + (funcall expect 20 "Problem processing extension") + (funcall expect 20 "SASL authentication failed") + (funcall expect 20 "Connection failed!") + (should-not (erc-server-process-alive)) + (defvar erc-v3--sasl) + (should-not erc-v3--sasl)) ; mode disabled + + (with-current-buffer warnings-buffer + (funcall expect 10 "please review SASL settings"))) + + (when noninteractive + (should-not (get-buffer "*ERC test warnings*")))) + +(ert-deftest erc-scenarios-v3-sasl--unsupported-mechanism () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-unsupported)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-mechanism 'scram-sha-1) + (erc--warnings-buffer-name "*ERC test warnings*") + (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter)) + (buf nil)) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "mechanism") + (funcall expect 20 "aborting") + (funcall expect 20 "Connection failed!"))) + + (with-current-buffer warnings-buffer + (funcall expect 10 "please review SASL settings"))) + + (when noninteractive + (should-not (get-buffer "*ERC test warnings*")))) + +;;; erc-scenarios-v3-sasl.el ends here diff --git a/test/lisp/erc/erc-scenarios-v3.el b/test/lisp/erc/erc-scenario= s-v3.el new file mode 100644 index 00000000000..158748583af --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3.el @@ -0,0 +1,587 @@ +;;; erc-scenarios-v3.el --- Scenarios for ERC v3 -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2025 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 +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; To control the set of active base extensions, edit the selection +;; offered by the server in its CAP LS response. That way, ERC will +;; only ever ask for what's available. + +;; FIXME some of these tests assert brittle implementation details. +;; These should be replaced with higher level behavioral assertions. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + + +;; This only really shows that status prefixes in 352 RPL_WHOREPLY are +;; reflected in channel-member records. The updates from the /WHO +;; aren't necessary, since the info should already be synced as a result +;; of the MODE #chan +v. +(ert-deftest erc-scenarios-v3-multi-prefix () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/multi-prefix") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-autojoin-channels-alist '((ExampleOrg "#chan"))) + (erc-modules (cons 'v3 erc-modules)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "modes for tester"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (erc-d-t-wait-for 5 "Own status updated" + (erc-channel-user-op-p "tester")) + + ;; Statuses from initial NAMES reply are correct. + (should-not (erc-channel-user-owner-p "tester")) + (should-not (erc-channel-user-admin-p "tester")) + (should-not (erc-channel-user-halfop-p "tester")) + (should-not (erc-channel-user-voice-p "tester")) + + (should-not (erc-channel-user-admin-p "fsbot")) + (should-not (erc-channel-user-halfop-p "fsbot")) + (should (erc-channel-user-owner-p "fsbot")) + (should (erc-channel-user-op-p "fsbot")) + (should (erc-channel-user-voice-p "fsbot")) + + ;; NAMES line printed correctly with correct buttonization. + (funcall expect 10 "~@+fsbot") + (should (equal '(erc-button-nick-default-face erc-notice-face) + (get-text-property (+ 3 (match-beginning 0)) + 'font-lock-face))) + + ;; FIXME the face for the user's current-nick should appear in + ;; front of `erc-default-face', but that's no longer the case. + (funcall expect 10 "@tester") + (should (equal 'erc-current-nick-face + (get-text-property (+ 2 (match-beginning 0)) + 'font-lock-face))) + + (ert-info ("Add voice to self") + (erc-scenarios-common-say "/MODE #chan +v tester") + ;; This is redundant and just for presentation purposes because + ;; the MODE reply triggers the initial record update. + (erc-scenarios-common-say "/WHO #chan")) + + (erc-d-t-wait-for 5 "Voice added to self" + (funcall expect 10 '(: "tester" (+ nonl) " ov "))) + + ;; Internal state updated: user tester has both statuses. + (should-not (or (erc-channel-user-owner-p "tester") + (erc-channel-user-admin-p "tester") + (erc-channel-user-halfop-p "tester"))) + (should (erc-channel-user-op-p "tester")) + (should (erc-channel-user-voice-p "tester"))))) + +;; This shows that full NUHs in a NAMES reply update user records. It +;; also shows that status-prefix updates continue to work even though +;; the reply is now a 353 instead of the 352 at play in the standalone +;; `multi-prefix' test above. +(ert-deftest erc-scenarios-v3-userhost-in-names () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/userhost-in-names") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-modules (cons 'v3 erc-modules)) + (erc-autojoin-channels-alist '((ExampleOrg "#chan" "#spam"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "password123" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "modes for tester"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + + (ert-info ("Ensure NAMES reply updates NUH fields") + (funcall expect 10 "+alice") + (goto-char (1+ (match-beginning 0))) + ;; Without this cap, we'd have a login (~user) and a host name + ;; for Bob (because he speaks) but only a nick for Alice. + (let ((user-data (erc-nick-at-point))) + (should (eq user-data (erc-get-server-user "alice"))) + (should (erc-server-user-login user-data)))) ; ~user + + ;; Everything below concerns the multi-prefix integration. + (ert-info ("Prefixes correctly assigned") + (should-not (erc-channel-user-owner-p "alice")) + (should-not (erc-channel-user-admin-p "alice")) + (should-not (erc-channel-user-op-p "alice")) + (should-not (erc-channel-user-halfop-p "alice")) + (should (erc-channel-user-voice-p "alice")) + + (should-not (erc-channel-user-owner-p "bob")) + (should-not (erc-channel-user-admin-p "bob")) + (should (erc-channel-user-op-p "bob")) + (should (erc-channel-user-halfop-p "bob")) + (should (erc-channel-user-voice-p "bob"))) + + (ert-info ("Buttonizing correctly applied") + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (should (search-forward "tester" nil t)) + ;; FIXME the face for the user's current-nick should appear in + ;; front of `erc-default-face', but that's no longer the case. + (should (memq 'erc-current-nick-face + (ensure-list + (get-text-property (1- (point)) 'font-lock-face))))= )) + + ;; Check buttonizing of statused nicks in names list. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 "*** Users on #spam (215): ~@Q @D") + (funcall expect 10 "*** Users on #spam (436): abErGAVeNny") + ;; Mike appears before joe because @ is more important than +. + (funcall expect 10 "*** Users on #spam (461): @mike") + (should (equal (get-text-property (- (match-end 0) (length "mike")) + 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (funcall expect 10 "+joe") + (should (equal (get-text-property (1+ (match-beginning 0)) + 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (funcall expect 10 "RELAX") + (should (equal (get-text-property (match-beginning 0) 'font-lock-fac= e) + '(erc-notice-face)))))) + +(ert-deftest erc-scenarios-v3-server-time () + :tags '(:expensive-test) + (let ((erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/server-time") + (erc-server-flood-penalty 0.1) + (erc-stamp--tz t) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-v3-extensions ()) ; server-time included in base set + ;; See `erc-v3--server-time-update-phantom-cmem' for the + ;; trivial `nicks' and `button' integration. + (erc-modules `(v3 nicks fill-wrap ,@erc-modules)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "password123" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#foo")) + ;; Wait for the last message in replay because messages are + ;; inserted out of order. + (funcall expect 20 "<underpersona> \"Beware the") + (funcall expect 2 "[Wed Sep 23 2020]" (point-min)) + (funcall expect 2 "<underpersona> 'Twas brillig") + (funcall expect 2 "[23:50]") + (funcall expect 2 "<underpersona> Did gyre and gimble") + (funcall expect 2 "[23:51]") + ;; + (funcall expect 2 "[Thu Sep 24 2020]") + (funcall expect 2 "<sneercat> All mimsy") + (funcall expect 2 "[00:00]") + (funcall expect 2 "<sneercat> And the mome") + (funcall expect 2 "[00:01]") + (funcall expect 2 "<underpersona> \"Beware the") + (funcall expect 2 "[00:05]") + (funcall expect 10 "\n\n[") + (funcall expect 10 "*** You have joined channel #foo") + (funcall expect 10 "*** Users on #foo") + (funcall expect 10 "*** #foo modes:") + (funcall expect 10 "*** #foo was created on")) + + (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#bar")) + ;; Wait for the the last message in replay. + (funcall expect 20 "<sneercat> And stood awhile") + (funcall expect 10 "[Thu Sep 24 2020]" (point-min)) + (funcall expect 2 "<underpersona> The jaws that bite") + (funcall expect 2 "[06:46]") + (funcall expect 2 "<sneercat> Beware the Jubjub") + (funcall expect 2 "[06:55]") + (funcall expect 2 "<sneercat> The frumious") + (funcall expect 2 "[06:56]") + (funcall expect 2 "<underpersona> He took") + (funcall expect 2 "[07:03]") + (funcall expect 2 "<underpersona> Long time") + (funcall expect 2 "<sneercat> So rested") + (funcall expect 2 "[07:20]") + (funcall expect 2 "<sneercat> And stood awhile") + (funcall expect 10 "\n\n[") + (funcall expect 10 "*** You have joined channel #bar") + (funcall expect 10 "*** Users on #bar") + (funcall expect 10 "*** #bar modes:") + (funcall expect 10 "*** #bar was created on"))))) + +(ert-deftest erc-scenarios-v3-echo-message () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/echo-message") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `(,@erc-d-tmpl-vars + (now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter)) + ;; Ensure the message text body appears in `erc-input-face'. + (check-input-face + (lambda () + (eq 'erc-input-face + (get-text-property (1- (point)) 'font-lock-face)))) + (check-action-face + (lambda () + (equal '(erc-input-face erc-action-face) + (get-text-property (1- (point)) 'font-lock-face))))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "You have been marked as being away"))) + + (ert-info ("Chan buffer #chan populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + ;; Ensure own messages in non-batch playback history show up. + (funcall expect 5 "<tester> Howdy from the past!") + (should (funcall check-input-face)) + ;; Ensure the speaker looks like that for an outgoing message. + (should (equal '(erc-button-nick-default-face erc-my-nick-face) + (get-text-property (+ 2 (pos-bol)) 'font-lock-face)= )) + + (funcall expect 5 "That lady is not now living") + (erc-scenarios-common-say "hi from the present") + (funcall expect 5 "<tester> hi from the present") + (should (funcall check-input-face)) + ;; Ensure the speaker looks like that for an outgoing message. + (should (equal '(erc-button-nick-default-face erc-my-nick-face) + (get-text-property (+ 2 (pos-bol)) 'font-lock-face)= )) + (erc-d-t-absent-for 0.1 "<tester> hi" (point)) ; no dupes + + (funcall expect 5 "<alice> bob: And reason says you") + (erc-scenarios-common-say "/me sad") + (funcall expect 5 "* tester sad") + (should (funcall check-action-face)) + (erc-d-t-absent-for 0.1 "* tester sad" (point)) + + (funcall expect 5 "<alice> bob: Than all yon fiery") + ;; Sending a /msg opens a query on receipt of the echo. + (erc-scenarios-common-say "/msg bob hi"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "bob")) + (funcall expect 1 "<tester> hi") + (should (funcall check-input-face)) + (erc-d-t-absent-for 0.1 "<tester> hi" (point)) + (funcall expect 5 "<bob> Here lives a caitiff wretch") + + ;; Echoed non-ACTION CTCPs don't trigger an outgoing answer (NOTICE). + (erc-scenarios-common-say "/ctcp bob VERSION") + (funcall expect 10 "*** Version for bob is ERC") + (erc-d-t-absent-for 0.1 "*** Version for tester" (point)) + + (erc-scenarios-common-say "/me tired") + (funcall expect 5 "* tester tired") + (should (funcall check-action-face)) + (erc-d-t-absent-for 0.1 "* tester tired" (point))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: Ha! now I see")))) + +(ert-deftest erc-scenarios-v3-extended-join () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/extended-join") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `(,@erc-d-tmpl-vars + (now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "J. Random Hacker") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg= ")) + (funcall expect 5 "User modes for tester") + (erc-cmd-JOIN "#chan")) + (erc-d-t-wait-for 10 "buffer #chan ready" (get-buffer "#chan")) + (should (equal erc-autojoin-channels-alist '((ExampleOrg "#chan")))) + + (ert-info ("Chan buffer #chan populated") + (let ((inhibit-message t)) + (with-current-buffer "#chan" + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "alice (aph: [email protected]) has joined") + (should + (equal (erc-scenarios-common--nick-at-point (match-beginning 0)) + "aph: [email protected] \"Alyssa P. Hacker\"")) + (erc-scenarios-common-say "checkpoint 0") + + ;; Historical intel not available when a user leaves (without + ;; backing store). + (funcall expect 5 "alice ([email protected]) has left") + (should-not + (erc-scenarios-common--nick-at-point (match-beginning 0))) + (erc-scenarios-common-say "checkpoint 1") + + ;; Intel available again once user rejoins. + (funcall expect 5 "alice (aph: [email protected]) has joined") + (should + (equal (erc-scenarios-common--nick-at-point (match-beginning 0)) + "aph: [email protected] \"Alyssa P. Hacker\"")) + (erc-scenarios-common-say "checkpoint 2") + + (funcall expect 5 "alice ([email protected]) has quit") + (should-not + (erc-scenarios-common--nick-at-point (match-beginning 0)))))))) + +;; For now, this also demos some `account-tag' stuff +;; +;; TODO add a scenario where names aren't received and instead just a +;; 315 sans token, after a 263 error: +;; +;; :molybdenum.libera.chat 263 me WHO :This command could not be ... +;; :molybdenum.libera.chat 315 me * :End of /WHO list. + +(ert-deftest erc-scenarios-v3-whox--basic () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/whox") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "foonet")) + (funcall expect 10 "User modes for tester") + (erc-cmd-JOIN "#chan") + (erc-cmd-JOIN "#spam")) + + (ert-info ("Buffer #spam populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 5 "You have joined channel #spam") + (funcall expect 20 "<joe> mike: Excellent"))) + + (ert-info ("Bob's account is known at join time") + (with-current-buffer "foonet" + (should (equal (erc-server-user-account (erc-get-server-user "alic= e")) + "alice")) + (should (equal (erc-server-user-account (erc-get-server-user "bob"= )) + "bob")) + (should-not (erc-server-user-account (erc-get-server-user "fool"))= ))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: With him! why")))) + +(ert-deftest erc-scenarios-v3-whox--rate-limited () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/whox") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + (erc-autojoin-channels-alist + '((foonet "#chan" "#foo" "#bar" "#baz" "#spam"))) + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'rate-limited)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (erc-v3--whox-mode-hook + (list (lambda () (when erc-v3--whox + (setf (erc-v3--whox-penalty erc-v3--whox) 1))))) + (expect (erc-d-t-make-expecter)) + (gecosp (lambda (name) + (let ((inhibit-message noninteractive)) + (string-search name (erc-scenarios-common--nick-at-point + (point))))))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "User modes for tester")) + + (ert-info ("Full names not yet known") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "chan_foo") + (should-not (funcall gecosp "Chan Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 5 "foo_foo") + (should-not (funcall gecosp "Foo Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 5 "bar_foo") + (should-not (funcall gecosp "Bar Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#baz")) + (funcall expect 5 "baz_foo") + (should-not (funcall gecosp "Baz Fool")))) + + (ert-info ("Buffer #spam populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 5 "<joe> mike: Excellent"))) + + (with-current-buffer "foonet" + (funcall expect 5 "Rate limit exceeded retrieving user data")) + + ;; Full names are now known. + (dolist (chan '("chan" "foo" "bar" "baz" "spam")) + (with-current-buffer (concat "#" chan) + (goto-char (point-min)) + (search-forward (concat chan "_foo")) + (should (funcall gecosp (concat (upcase-initials chan) " Fool"))))= ))) + +(ert-deftest erc-scenarios-v3-away-notify () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/away-notify") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "User modes for tester"))) + + (ert-info ("Chan buffer #chan populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "<alice> bob: That is, hot ice"))) + + (with-current-buffer "foonet" + (let ((user-fool (erc-get-server-user "fool"))) + ;; Incidentally, fool's account was added by the WHOX response. + (should (erc-server-user-account user-fool)) + ;; AWAY messages affect user records. + (should-not (erc--server-user-away-p user-fool)) + (erc-d-t-wait-for 5 "Fool sets AWAY msg" + (equal (erc--server-user-away-p user-fool) "afk")) + (erc-d-t-wait-for 5 "Fool clears AWAY msg" + (not (erc--server-user-away-p user-fool))))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: Which the false")))) + +(ert-deftest erc-scenarios-v3-cap-notify () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/cap-notify") + (erc-server-flood-penalty 0.1) + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "pretester" + :password "changeme" + :full-name "pretester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 20 "ty for sharing") + (should erc-v3--extended-join) + (should erc-v3--away-notify)) + + (with-current-buffer "Libera.Chat" + (should-not (erc-v3--caps-timer erc-v3--caps))))) + +;;; erc-scenarios-v3.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 038217c4742..2db03b3f821 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3735,6 +3735,7 @@ erc-tests--modules track truncate unmorse + v3 xdcc)) =20 ;; Ensure that `:initialize' doesn't change the ordering of the diff --git a/test/lisp/erc/erc-v3-tests.el b/test/lisp/erc/erc-v3-tests.el new file mode 100644 index 00000000000..fe11be5b072 --- /dev/null +++ b/test/lisp/erc/erc-v3-tests.el @@ -0,0 +1,1459 @@ +;;; erc-v3-tests.el --- Tests for erc-v3 -*- lexical-binding:t -*- + +;; Copyright (C) 2021-2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + +(require 'erc-v3) + +(defvar erc-v3-tests--calls nil) + +(erc-v3--define-capability test/a) +(erc-v3--define-capability test/b) +(erc-v3--define-capability test/c) +(erc-v3--define-capability test/d) +(erc-v3--define-capability test/e) +(erc-v3--define-capability test/f) + +(erc-v3--define-capability test/m + (when erc-v3--test/m + (error "This is an enable failure"))) + +(erc-v3--define-capability test/n + (unless erc-v3--test/n + (error "This is a disable failure"))) + +(erc-v3--define-capability test/m-1 :depends '(test/m)) + +(erc-v3--define-extension test/o + (push erc-v3--test/o erc-v3-tests--calls)) + +(defvar erc-v3-tests--parser-tests + (expand-file-name "erc-d/resources/irc-parser-tests.eld" + (ert-resource-directory))) + +;; To find stray negotiation states that can be pruned from +;; `erc-v3--edges', you can do: +;; +;; (trace-function-background #'erc-v3--get-state) +;; +;; And filter the output with: +;; +;; cat test/lisp/erc/*.log | grep -E '^1 (<|-)' | \ +;; sed -e 's/[^(]\+//' -e 's/erc-v3--transition //' \ +;; -e 's/ [^)]\+//' -e 's/[()]//g' | sort | uniq | less +;; +;; Then compare it to the output of macro-expanding `erc-v3--make-edges' +;; or mapping over atoms that start with: "erc-v3--state-". + +;; These new states are only used by tests for demonstrating that +;; modifying `erc-v3--edges' to accommodate arbitrary behavior is +;; possible but unruly. +(defconst erc-v3--state-Sa-Wo-Me-Pu (make-symbol "Sa-Wo-Me-Pu")) +(defconst erc-v3--state-Sa-Wo-Mi-Pu (make-symbol "Sa-Wo-Mi-Pu")) +(defconst erc-v3--state-Sa-Wo-Mo-Py (make-symbol "Sa-Wo-Mo-Py")) +(defconst erc-v3--state-Si-We-Mo-Pa (make-symbol "Si-We-Mo-Pa")) +(defconst erc-v3--state-Si-We-Mo-Py (make-symbol "Si-We-Mo-Py")) +(defconst erc-v3--state-Si-Wo-Me-Pa (make-symbol "Si-Wo-Me-Pa")) +(defconst erc-v3--state-Si-Wo-Mo-Po (make-symbol "Si-Wo-Mo-Po")) +(defconst erc-v3--state-Si-Wo-Mo-Py (make-symbol "Si-Wo-Mo-Py")) + +(defconst erc-v3--event-wOFF (make-symbol "wOFF")) + +;; This addendum to the main table shows that user code could decide to +;; override an "UP" phase, which normally effects a local Mo -> Mi +;; component change, and still continue a well-behaved protocol flow by +;; telling the server to sync down. +;; +;; Note that this and other tests introduce a made-up "wOFF" event, +;; which means that the extension was declared unwanted externally. +(defvar erc-v3-tests--preempt-up-edges + `((,erc-v3--state-Si-Wi-Mo-Pa + (,erc-v3--event-wOFF ,erc-v3--state-Si-Wo-Mo-Py ,erc-v3--phase-QOUT)) + (,erc-v3--state-Si-Wo-Mo-Py + (,erc-v3--event-pOUT ,erc-v3--state-Si-Wo-Mo-Po ,erc-v3--phase-SEND)) + (,erc-v3--state-Si-Wo-Mo-Po + (,erc-v3--event-sACK ,erc-v3--state-Sa-Wo-Mo-Py + ,erc-v3--phase-QIN) ; queue good REQ- sync + (,erc-v3--event-sNAK ,erc-v3--state-Si-We-Mo-Py + ,erc-v3--phase-QIN) ; queue rejected REQ- log + (,erc-v3--event-pERR ,erc-v3--state-Si-Wo-Me-Pa + ,erc-v3--phase-LOG)) ; timeout REQ- + (,erc-v3--state-Sa-Wo-Mo-Py + (,erc-v3--event-pIN ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS)) ; good REQ- from wOFF + (,erc-v3--state-Si-We-Mo-Py + (,erc-v3--event-pIN ,erc-v3--state-Si-We-Mo-Pa + ,erc-v3--phase-LOG)) ; rejected REQ- for ^ + (,erc-v3--state-Sa-Wo-Mo-Pa ; unrelated to main path above + (,erc-v3--event-wON ,erc-v3--state-Sa-Wi-Mo-Py + ,erc-v3--phase-QOUT)))) ; made wanted during che= ck + +;; This simulates an ISUPPORT-based extension already enabled +;; successfully now becoming unwanted because a better offer arrives, +;; perhaps via NEW, which provides overlapping but incompatible +;; functionality. +(defvar erc-v3-tests--make-unwanted-edges + ;; Disabling of enabled non-cap extension + `((,erc-v3--state-Sa-Wi-Mi-Pu ; e.g., better offer made + (,erc-v3--event-wOFF ,erc-v3--state-Sa-Wo-Mi-Pu ,erc-v3--phase-DOWN)) + ;; Mode deactivation for non-cap extension + (,erc-v3--state-Sa-Wo-Mi-Pu + (,erc-v3--event-mOK ,erc-v3--state-Sa-Wo-Mo-Pu + ,erc-v3--phase-PASS) ; mode deactivation success + (,erc-v3--event-mERR ,erc-v3--state-Sa-Wo-Me-Pu + ,erc-v3--phase-LOG)))) ; mode deactivation failu= re + +(defun erc-v3-tests--modify-edges (additions &optional graph) + "Splice new ADDITIONS into transition GRAPH, returning a copy." + (setq graph (mapcar #'copy-sequence (or graph erc-v3--edges))) + (pcase-dolist (`(,key . ,entries) additions) + (if-let* ((existing (assq key graph))) + (dolist (entry entries) + (cl-pushnew entry (cdr existing) :test #'equal)) + (push (cons key entries) graph))) + graph) + +(defun erc-v3-tests--slots (slots &optional objects) + (mapcar (lambda (o) + (mapcar (lambda (slot) + (let ((v (cl-struct-slot-value (type-of o) slot o))) + (if (memq slot '(state event phase)) + (intern (symbol-name v)) + v))) + slots)) + (or objects (erc-v3--caps-objects erc-v3--caps)))) + +(ert-deftest erc-v3--enabled-p () + (should-not (erc-v3--enabled-p + (erc-v3--test/a :state erc-v3--state-Sa-Wo-Mo-Pa))) + (should (erc-v3--enabled-p + (erc-v3--test/a :state erc-v3--state-Si-Wi-Mi-Pa)))) + +(ert-deftest erc-v3--deps-gather-dependents () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (e (erc-v3--test/e :depends '(test/d))) + (abcd-fn (lambda (o) (memq o (list a b c d)))) + (erc-v3--session-dag (erc-v3--deps-build-dag (list a b c d e)))) + + (should (equal erc-v3--session-dag `((,d ,e) (,c ,d) (,b ,d ,c)))) + (should (equal (erc-v3--deps-gather-dependents a abcd-fn) nil)) + (should (equal (erc-v3--deps-gather-dependents b abcd-fn) (list c d))) + (should (equal (erc-v3--deps-gather-dependents c abcd-fn) (list d))) + (should (equal (erc-v3--deps-gather-dependents d abcd-fn) nil)) + (should (equal (erc-v3--deps-gather-dependents + b (lambda (o) (memq o (list b c)))) + (list c))))) + +(ert-deftest erc-v3--deps-build-dag () + (let ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (e (erc-v3--test/e :depends '(test/d)))) + ;; Only direct dependents make up the tail of each member. + (should (equal (erc-v3--deps-build-dag (list a b c d e)) + `((,d ,e) (,c ,d) (,b ,d ,c)))))) + +(ert-deftest erc-v3--deps-tsort () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (objects (list a b c d)) + (graph (erc-v3--deps-build-dag objects))) + (should (equal (erc-v3--deps-tsort objects graph) (list b c d a)))) + + (let* ((a (erc-v3--test/a :depends '(test/e test/f))) + (b (erc-v3--test/b :depends '(test/e))) + (c (erc-v3--test/c :depends '(test/f))) + (d (erc-v3--test/d :depends '(test/c))) + (e (erc-v3--test/e)) + (f (erc-v3--test/f)) + (objects (list a b c d e f)) + (graph (erc-v3--deps-build-dag objects))) + (should (equal (erc-v3--deps-tsort objects graph) (list f e c d b a)))= )) + +;; Ask for soft dependencies, which may include unknown extensions. +(ert-deftest erc-v3--deps-build-dag/soft () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :supports '(test/? test/b))) + (d (erc-v3--test/d :supports '(test/b) :depends '(test/c)))) + (dotimes (_ 8) + (let* ((objects (sort (list a b c d) (lambda (_ _) (zerop (random 2)= )))) + (graph (erc-v3--deps-build-dag objects 'softp))) + (should (member (erc-v3--deps-tsort objects graph) + (list (list a b c d) ; item `a' can go anywhere + (list b a c d) + (list b c a d) + (list b c d a))))))) + + (let* ((a (erc-v3--test/a :supports '(test/?? test/?))) + (b (erc-v3--test/b :supports '(test/? test/a))) + (c (erc-v3--test/c :supports '(test/b tests/?? test/?))) + (d (erc-v3--test/d :supports '(test/? test/c) :depends '(test/a))) + (e (erc-v3--test/e :supports '(test/a test/??) :depends '(test/c)= ))) + (dotimes (_ 10) + (let* ((objects (sort (list a b c d e) + (lambda (_ _) (zerop (random 2))))) + (graph (erc-v3--deps-build-dag objects 'softp)) + (result (erc-v3--deps-tsort objects graph))) + (should (member result (list (list a b c d e) + (list a b c e d)))))))) + +;; FIXME redo this to include error handling. +(ert-deftest erc-v3--ensure-disabled () + (erc-tests-common-make-server-buf) + (let* ((erc-v3--edges (erc-v3-tests--modify-edges + erc-v3-tests--make-unwanted-edges)) + (a (erc-v3--test/a)) + (b (erc-v3--test/b :state erc-v3--state-Sa-Wo-Mi-Pu)) + (c (erc-v3--test/c :depends '(test/b) + :state erc-v3--state-Sa-Wo-Mi-Pu)) + (d (erc-v3--test/d :depends '(test/b test/c) + :state erc-v3--state-Sa-Wo-Mi-Pu)) + (erc-v3--test/a t) + (erc-v3--test/d t) + (erc-v3--test/b t) + (erc-v3--test/c t) + (erc-v3--caps (make-erc-v3--caps :objects (list a b c d)))) + + ;; Accepts empty input. + (erc-v3--ensure-disabled ()) + + (erc-v3--ensure-disabled (list b)) + (should erc-v3--test/a) + (should-not erc-v3--test/b) + (should-not erc-v3--test/c) + (should-not erc-v3--test/d) + (should (eq (erc-v3--extension-state b) erc-v3--state-Sa-Wo-Mo-Pu)) + (should (eq (erc-v3--extension-state c) erc-v3--state-Sa-Wo-Mo-Pu)) + (should (eq (erc-v3--extension-state d) erc-v3--state-Sa-Wo-Mo-Pu)))) + +;; FIXME test error handling in both server and target buffers. +(ert-deftest erc-v3--ensure-enabled () + (erc-tests-common-make-server-buf) + (letrec + ((calls nil) + (a (erc-v3--test/a)) + (b (erc-v3--test/b :initp t)) + (c (erc-v3--test/c :depends '(test/b) :initp t)) + (d (erc-v3--test/d :depends '(test/b test/c) :initp t)) + (erc-v3--test/a-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/a) calls))) + (erc-v3--test/b-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/b) calls))) + (erc-v3--test/c-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/c) calls))) + (erc-v3--test/d-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/d) calls))) + (erc-v3--caps (make-erc-v3--caps :objects (list a b c d))) + (reset + (lambda () + (setf calls nil + erc-v3--test/b nil + erc-v3--test/c nil + erc-v3--test/d nil + (erc-v3--extension-phase b) erc-v3--phase-UP + (erc-v3--extension-phase c) erc-v3--phase-UP + (erc-v3--extension-phase d) erc-v3--phase-UP + (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mo-Pa + (erc-v3--extension-state c) erc-v3--state-Si-Wi-Mo-Pa + (erc-v3--extension-state d) erc-v3--state-Si-Wi-Mo-Pa))) + (assert-common + (lambda () + (should (eq (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mi-P= a)) + (should (eq (erc-v3--extension-state c) erc-v3--state-Si-Wi-Mi-P= a)) + (should (eq (erc-v3--extension-state d) erc-v3--state-Si-Wi-Mi-P= a)) + (should erc-v3--test/b) + (should erc-v3--test/c) + (should erc-v3--test/d)))) + + (ert-info ("All deps are not yet active") + (funcall reset) + (erc-v3--ensure-enabled (list b c d)) + (funcall assert-common) + (should (equal calls '(test/d test/c test/b)))) + + (ert-info ("Activation skipped when B already active") + (funcall reset) + (setq erc-v3--test/b b) + (setf (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mi-Pa + (erc-v3--extension-phase b) erc-v3--phase-PASS) + (erc-v3--ensure-enabled (list b c d)) + (funcall assert-common) + (should (equal calls '(test/d test/c)))))) + +;; This is meant to show that an extension's mode activation function +;; (non-interactive "mode command") does not set the variable. See the +;; `:variable' value in the expansion of the `define-minor-mode' form. +(ert-deftest erc-v3--extension () + (erc-tests-common-make-server-buf) + + ;; Calling the mode function does not set the variable, and its value + ;; remains nil and isn't set locally. + (let ((erc-v3-tests--calls ())) + (should-not erc-v3--test/o) + (erc-v3--test/o-mode +1) + (should-not erc-v3--test/o) + (should-not (local-variable-p 'erc-v3--test/o)) + (should (equal erc-v3-tests--calls '(nil)))) ; "disable body" ran + + ;; Setting the mode variable beforehand runs the "enable body". + (let ((erc-v3-tests--calls ())) + (setq erc-v3--test/o (erc-v3--test/o)) + (should (local-variable-p 'erc-v3--test/o)) + (erc-v3--test/o-mode +1) + (should (erc-v3--test/o-p erc-v3--test/o)) + (should (equal erc-v3-tests--calls (list erc-v3--test/o)))) + + ;; Running the mode activation function in a target buffer *does* set + ;; the variable as well as run the enable body. + (with-current-buffer (erc--open-target "#chan") + (let ((erc-v3-tests--calls ())) + (should-not erc-v3--test/o) + (erc-v3--test/o-mode +1) + (should (erc-v3--test/o-p erc-v3--test/o)) + (should (local-variable-p 'erc-v3--test/o)) + (should (equal erc-v3-tests--calls (list erc-v3--test/o))))) + + ;; Disabling the mode *does* set the variable to nil but doesn't kill + ;; the local binding, which is consistent with "real" minor modes. + (let ((erc-v3-tests--calls ())) + (erc-v3--test/o-mode -1) + (should-not erc-v3--test/o) + (should (equal erc-v3-tests--calls '(nil))) + (should (local-variable-p 'erc-v3--test/o))) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-v3--define-extension () + (should + (equal + (macroexpand '(erc-v3--define-extension foo)) + '(progn + + (cl-defstruct (erc-v3--foo (:include erc-v3--extension + (canon 'foo)) + (:constructor erc-v3--foo)) + "IRCv3 `foo' extension.") + + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--extension) + + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))))) + +(ert-deftest erc-v3--define-capability () + ;; Baseline, almost identical to expansion of extension, above. + (should + (equal (macroexpand '(erc-v3--define-capability foo :depends '(bar))) + '(progn + (cl-defstruct (erc-v3--foo (:include erc-v3--capability + (canon 'foo) + (depends '(bar))) + (:constructor erc-v3--foo)) + "IRCv3 `foo' capability.") + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))= )) + + ;; With doc string, slots, and aliases. + (should + (equal (macroexpand '(erc-v3--define-capability foo + "Hello World." + :slots ((somefield 1)) + :aliases '(bar baz))) + '(progn + (cl-defstruct (erc-v3--foo (:include erc-v3--capability + (canon 'foo) + (aliases '(bar baz))) + (:constructor erc-v3--foo)) + "Hello World." + (somefield 1)) + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'bar 'erc-v3--extension-class 'erc-v3--foo) + (put 'baz 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))= )) + + (should + (equal (macroexpand '(erc-v3--define-capability + (foo (:include erc-v3--cap-notify) + (:constructor erc-v3--my-foo)) + "Hello World." + :initp erc-button-mode + :keymap my-keymap + "My mode." + (always) (ignore))) + '(progn + (cl-defstruct (erc-v3--foo ( :include erc-v3--cap-notify + (canon 'foo) + (initp erc-button-mode)) + (:constructor erc-v3--my-foo) + (:constructor erc-v3--foo)) + "Hello World.") + ;; Only namesake constructor referenced. + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "My mode." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v))) + (always) (ignore)) + (setf (alist-get 'erc-v3--foo minor-mode-map-alist) my-keymap= ))))) + +(ert-deftest erc-v3--canon-from-key () + (should (eq (erc-v3--canon-from-key 'cap-notify) 'cap-notify)) + (should (eq (erc-v3--canon-from-key '-cap-notify) 'cap-notify)) + (should-not (erc-v3--canon-from-key 'whox))) + +(ert-deftest erc-v3--define-extension-subclass--minor-mode () + (ert-info ("Callable but not bound as a variable") + (should (fboundp 'erc-v3--test/a-mode)) + (should (boundp 'erc-v3--test/a-mode-hook)) + (should-not (boundp 'erc-v3--test/a-mode)) + (should (eq (get 'test/a 'erc-v3--extension-minor-mode) + 'erc-v3--test/a-mode))) + + (ert-info ("Value in target buffers") + (with-current-buffer (get-buffer-create "FooNet") + (erc-tests-common-prep-for-insertion) + (setq erc-server-process (start-process "t" (current-buffer) "true")) + (set-process-query-on-exit-flag erc-server-process nil) + (with-current-buffer (get-buffer-create "#chan") + (erc-tests-common-prep-for-insertion) + (setq erc-server-process + (with-current-buffer "FooNet" erc-server-process))) + + (ert-info ("Copies server buffer's nil value to targets") + (should-not (local-variable-p 'erc-v3--test/a)) + (should-not erc-v3--test/a) + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode +1)) + (with-current-buffer "#chan" + (should (local-variable-p 'erc-v3--test/a)) + (should-not (eq erc-v3--test/a t))) + ;; Server-buffer's copy not set because redundant + (should-not (local-variable-p 'erc-v3--test/a)) + (should-not erc-v3--test/a)) + + (ert-info ("Copies server buffer's non-nil value to targets") + (let ((v (setq erc-v3--test/a (erc-v3--test/a)))) + (should (erc-v3--test/a-p v)) + ;; Target's copy not updated automatically + (with-current-buffer "#chan" + (should-not erc-v3--test/a)) + ;; Manually call mode activation function + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode +1)) + (ert-info ("Server's value intact") + (should (eq v erc-v3--test/a))) + (with-current-buffer "#chan" + (should (erc-v3--test/a-p erc-v3--test/a)) + (should (eq v erc-v3--test/a))))) + + (ert-info ("Sets all instances to nil when mode disabled.") + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode -1)) + (should-not erc-v3--test/a) + (with-current-buffer "#chan" + (should-not erc-v3--test/a))) + + (when noninteractive + (kill-buffer "#chan") + (kill-buffer))))) + + +(define-erc-response-handler (ERCTEST) + "ERCTEST" nil (erc-display-error-notice parsed + (erc-response.contents parsed))) + +;; FIXME move this and the tag stuff to erc-tests.el or a new +;; erc-backend-tests.el. +(ert-deftest erc--response-function () + (erc-tests-common-make-server-buf) + + (let* ((calls ()) + ;; Putting this lambda inline in the setup-fn instead of as its + ;; own binding breaks removal functionality on Emacs <29! + (fn (lambda (_ parsed) + (push (erc-response.command parsed) calls))) + (setup-fn (lambda (enablep) + (erc--set-up-response-function ERCTEST enablep + :override fn)))) + + ;; Simulate a minor-mode being enabled (the most obvious intended + ;; use case). Its body overrides the default handler locally. + (funcall setup-fn t) + + ;; Simulate another connection. + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + + ;; This other server buffer is unaffected, so the default handler + ;; runs and displays its message. + (erc-tests-common-simulate-line ":irc.barnet.org ERCTEST dummy :Foun= d") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (should-not calls) + + ;; No-op because other connection still using modified handler. + (should-not (erc--tidy-response-function 'erc-server-ERCTEST))) + + ;; Back in the overridden buffer, the default handler is suppressed. + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found= ") + (should (equal calls '("ERCTEST"))) + (goto-char (point-min)) + (should-not (search-forward "Found" nil t)) + (setq calls nil) + + ;; Disabling the minor mode, restores the default handler and removes + ;; the symbol property if necessary. + (funcall setup-fn nil) + (should-not (get 'erc-server-ERCTEST 'erc--response-function)) + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found= ") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (setq calls nil)) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-get-tag () + ;; Legacy format. + (let ((ab1c-legacy '(("c") ("b" "1") ("a"))) + (ab?c-legacy '(("c") ("b" "") ("a")))) + (should (equal (erc-get-tag "a" ab1c-legacy) '("a"))) + (should (equal (erc-get-tag "b" ab1c-legacy) '("b" "1"))) + (should (equal (erc-get-tag "b" ab?c-legacy) '("b" ""))) + (should (equal (erc-get-tag "c" ab1c-legacy) '("c")))) + + ;; Native format + (let ((ab1c '((a) (b . "1") (c)))) + (should (equal (erc-get-tag 'a ab1c) '(a))) + (should (equal (erc-get-tag 'b ab1c) '(b . "1"))) + (should (equal (erc-get-tag 'c ab1c) '(c))))) + +(ert-deftest erc--tags-get () + (let ((tags (list (list "c") (list "b" "1") (list "a"))) + (erc-tags-format 'legacy)) + (should (equal (setf (erc--tags-get "c" tags) "2") "2")) + (should (equal tags '(("c" "2") ("b" "1") ("a"))))) + + (let ((erc-tags-format nil) + (r (make-erc-response :tags (list (list 'a) (cons 'b "1") (list 'c= ))))) + (should (equal (setf (erc--tags-get 'c (erc-response.tags r)) "2") "2"= )) + (should (equal (erc-response.tags r) '((a) (b . "1") (c . "2")))) + (should (equal (setf (erc--tags-get 'd (erc-response.tags r)) "3") "3"= )) + (should (equal (erc-response.tags r) + '((d . "3") (a) (b . "1") (c . "2")))))) + +(ert-deftest erc-parse-server-response () + (let* ((data (with-temp-buffer + (insert-file-contents erc-v3-tests--parser-tests) + (read (current-buffer)))) + (tests (assoc-default 'tests (assoc-default 'msg-split data))) + (erc-tags-format nil) + (erc-v3-mode t) + input atoms m ours) + + (cl-letf (((symbol-function 'erc-handle-parsed-server-response) + (lambda (_ m) m))) + (dolist (test tests) + (setq input (assoc-default 'input test) + atoms (assoc-default 'atoms test) + m (erc-parse-server-response nil input)) + + (ert-info ((format "Description: %S" + (list :input input :atoms atoms :m m))) + + (ert-info ("Parses tags correctly") + (setq ours (erc-response.tags m)) + (if-let* ((tags (assoc-default 'tags atoms))) + (pcase-dolist (`(,key . ,value) ours) + (should (string=3D (cdr (assq key tags)) (or value "")))) + (should-not ours))) + + (ert-info ("Parses verbs correctly") + (setq ours (erc-response.command m)) + (if-let* ((verbs (assoc-default 'verb atoms))) + (should (string=3D (downcase verbs) (downcase ours))) + (should (string-empty-p ours)))) + + (ert-info ("Parses sources correctly") + (setq ours (erc-response.sender m)) + (if-let* ((source (assoc-default 'source atoms))) + (should (string=3D source ours)) + (should (string-empty-p ours)))) + + (ert-info ("Parses params correctly") + (setq ours (erc-response.command-args m)) + (if-let* ((params (assoc-default 'params atoms))) + (should (equal ours params)) + (should-not ours)))))))) + +;; These cases are already covered by the preceding test. They're +;; presented here in a more minimal form for easier intuiting. +(ert-deftest erc--parse-message-tags () + (let ((erc-v3-mode t) + (erc-tags-format nil)) + (should (equal nil (erc--parse-message-tags ""))) + (should (equal '((a)) (erc--parse-message-tags "a"))) + + (should (equal '((a . "1") (b) (c)) (erc--parse-message-tags "a=3D1;b;= c"))) + (should (equal '((a) (b . "1") (c)) (erc--parse-message-tags "a;b=3D1;= c"))) + (should (equal '((a) (b) (c . "1")) (erc--parse-message-tags "a;b;c=3D= 1"))) + + (should (equal '((a . "1")) (erc--parse-message-tags "a;a=3D1"))) + (should (equal '((a . "2")) (erc--parse-message-tags "a=3D1;a=3D2"))) + (should (equal '((a)) (erc--parse-message-tags "a=3D1;a"))))) + +(cl-defun erc-v3-tests--build-message (&key tags source verb params) + "Build an outgoing message string from parts." + (pcase-let* ((`(,n . ,p) (reverse params)) + (rest `(,@(and source (list (concat ":" source))) + ,verb + ,@(nreverse p) + ,@(and n (list (concat ":" n)))))) + (concat (and tags (erc-v3--merge-client-tags tags)) + (string-join rest " ")))) + +;; Unfortunately, we can't really do the same for ERC's +;; message-building functions because they're currently scattered +;; everywhere. + +(ert-deftest erc-v3--merge-client-tags () + (should (equal "@a=3D1;b " (erc-v3--merge-client-tags '((a . "1") (b))))) + (should (equal "@a=3D1;b " (erc-v3--merge-client-tags '(("a" "1") ("b"))= ))) + + (let* ((data (with-temp-buffer + (insert-file-contents erc-v3-tests--parser-tests) + (read (current-buffer)))) + (tests (assoc-default 'tests (assoc-default 'msg-join data)))) + + (dolist (test tests) + (let ((atoms (alist-get 'atoms test)) + (desc (alist-get 'desc test)) + (want (alist-get 'matches test))) + (ert-info (desc) + (should (member (erc-v3-tests--build-message + :tags (alist-get 'tags atoms) + :source (alist-get 'source atoms) + :verb (alist-get 'verb atoms) + :params (alist-get 'params atoms)) + want))))))) + +(ert-deftest erc--server-CAP/continued-LIST () + (erc-tests-common-make-server-buf (buffer-name)) + (cl-letf* ((calls ()) + ((symbol-function 'erc-server-send) + (lambda (msg &rest _) (push msg calls)))) + + (erc-v3-mode +1) + ;; Pretend negotiation is over. + (setf (erc-v3--caps-negotiated-p erc-v3--caps) t) + + (ert-info ("Processing deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST * :test/a test/b") + (should-not calls) + (should (equal (erc-v3--caps-continued erc-v3--caps) + '("test/a test/b")))) + + (ert-info ("Processing deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST * :test/c") + (should-not calls) + (should (equal (erc-v3--caps-continued erc-v3--caps) + '("test/c" "test/a test/b")))) + + (ert-info ("Printed message includes earlier response") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST :test/d") + (should-not calls) + (should-not (erc-v3--caps-continued erc-v3--caps)) + (goto-char (point-min)) + (should (search-forward "Enabled CAPs: test/a, test/b," nil t)) + (should (search-forward "test/c," nil t)) + (should (search-forward "test/d" nil t)))) + + (erc-tests-common-kill-buffers)) + +(defun erc-v3-tests--server-CAP--no-request (test) + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/c)) + (cl-struct-erc-v3--extension-tags '(erc-v3--test/a + erc-v3--test/b + erc-v3--extension + erc-v3--capability))) + (erc-v3-mode +1) + (funcall test (lambda () calls))) + (with-current-buffer (messages-buffer) (should-not erc-v3--caps)) + (should-not (erc-v3--caps-timer erc-v3--caps)) + (erc-tests-common-kill-buffers)) + +;; This test shows that when the wanted and advertised sets don't +;; intersect, but the `negotiated-p' flag is set, ERC does *not* send a +;; "CAP END" even though the queue is empty. +(ert-deftest erc--server-CAP/no-request/post-registration () + (erc-v3-tests--server-CAP--no-request + (lambda (get-calls) + + (cl-letf (((erc-v3--caps-negotiated-p erc-v3--caps) t)) + ;; Although the subcommand is "NEW" here, the same would happen + ;; if it were "LS", though that'd be unlikely in real life. + (erc-tests-common-simulate-line + ":irc.example.org CAP * NEW :test/a test/b") + + ;; Advertised caps are shown as OFFERED. + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) + + ;; Request queue empty because no common extensions. + (should-not (funcall get-calls)))))) + +;; This is similar to the previous test, except the `negotiated-p' slot +;; is nil, meaning initial negotiation during registration is still +;; ongoing. And since the wanted and advertised sets share nothing, ERC +;; sends an early "CAP END" because the queue is empty and the +;; negotiation now effectively over. +(ert-deftest erc--server-CAP/no-request/registration () + (erc-v3-tests--server-CAP--no-request + (lambda (get-calls) + (cl-letf (((erc-v3--caps-negotiated-p erc-v3--caps) nil)) + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b") + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) + (should (equal (funcall get-calls) '(("CAP END")))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)))))) + +;; This demos basic 302 capability negotiation, including +;; post-registration. It includes some aberrant server behavior +;; regarding the NEW subcommand. +(ert-deftest erc--server-CAP/pre-and-post-registration () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/b test/d test/e)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b + erc-v3--test/c erc-v3--test/d erc-v3--test/e + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (ert-info ("Handlers inert when continuation line arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS * :test/a test/b") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a nil) (test/b INIT) + (test/c nil) (test/d INIT) (test/e INIT))))) + + (ert-info ("Handlers run when terminating line arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/c test/d") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/b test/d"))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b SEND) (test/c TRACK) + (test/d SEND) (test/e INIT)))) ; never arrives + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("All ACKs for arrive, extensions enabled, END sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/b test/d") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e INIT)))) + ;; Minor modes enabled. + (should erc-v3--test/b) + (should erc-v3--test/d) + (should (equal (pop calls) '("CAP END"))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not calls)) + + ;; XXX a server re-advertising an enabled cap in a NEW, much less + ;; changing its associated value, is unlikely. + (ert-info ("NEW offer arrives after connection registration") + (erc-tests-common-simulate-line + ":irc.example.org CAP * NEW :test/e test/b=3Dfoo") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) (test/d = RUN) + (test/e SEND)))) ; b already enabled + (should (equal (pop calls) '("CAP REQ :test/e"))) + (should-not calls) + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/e") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e RUN)))) + (should erc-v3--test/e) + (should-not calls)) + + (ert-info ("DEL arrives indicating cap b no longer supported") + (should erc-v3--test/b) ; test/b extension enabled + (should (equal "foo" (erc-v3--capability-val erc-v3--test/b))) + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/b test/a") ; no longer supported + ;; A and B marked as Su (server unknown). + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Su-Wo-Mo-Pa PASS) (test/b Su-Wi-Mo-Pa PASS) + (test/c Sa-Wo-Mo-Pa TRACK) (test/d Si-Wi-Mi-Pa RUN) + (test/e Si-Wi-Mi-Pa RUN)))) + (should-not calls) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/b))) + + (erc-tests-common-kill-buffers)) + +;; This shows that methods for subcommand handlers can influence a +;; request decision during the "check" phase by modifying the table and +;; an LS handler. +(ert-deftest erc--server-CAP/subcmd-handlers () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + (erc-v3-extensions '(test/a test/c)) + (erc-v3--edges (erc-v3-tests--modify-edges + `((,erc-v3--state-Sa-Wi-Mo-Pa + (,erc-v3--event-wOFF + ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS))))) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b erc-v3--test/c + erc-v3--extension erc-v3--capability)) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls)))) + + (erc-v3-mode +1) + + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (push (intern (format "bef-%s" + (erc-v3--extension-canon o))) + calls)) + '((name . ls-before) (depth . 10))) + + ;; Methods can inhibit a request by altering the `initp' slot. + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (pcase o + ((cl-struct erc-v3--test/a) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (push 'a calls)) + ;; Ignore test/b + ((cl-struct erc-v3--test/c) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (erc-v3--transition o erc-v3--event-wOFF) + (push 'c calls)))) + '((name . ls-ac) (depth . 20))) + + (ert-info ("Handlers deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS * :test/a test/c") + (should-not calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil) (test/c INIT))))) + + (ert-info ("Handlers run and requests sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/b") + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wi-Mo-Pi SEND) + (test/b Sa-Wo-Mo-Pa TRACK) + (test/c Sa-Wo-Mo-Pa PASS)))) ; manually disabled + ;; The LS handler for test/c effectively negates the configuration + ;; expressed by `erc-v3-extensions'. + (should (equal calls '(("CAP REQ :test/a") + bef-test/b c bef-test/c a bef-test/a))))) + + (erc-tests-common-kill-buffers)) + +;; This shows that CAP END is sent after a NAK because no unmet +;; dependencies are found that require a further negated REQ. +(ert-deftest erc--server-CAP/NAK-made-unwanted () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (subcmd-calls ()) + (erc-v3-extensions '(test/a test/b test/c)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b erc-v3--test/c + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (or (erc-v3--test/a-p o) (erc-v3--test/c-p o)) + (should (eq erc-v3--phase-UP + (erc-v3--extension-phase o))) + (should (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + (add-function :after (local 'erc-v3--subcmd-NAK-function) + (lambda (o) + (when (erc-v3--test/b-p o) + (should (eq erc-v3--phase-LOG + (erc-v3--extension-phase o))) + (should-not (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b INIT) (test/c INIT)))) + + (ert-info ("LS arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b test/c") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c SEND)))) + (should (equal (pop calls) '("CAP REQ :test/a test/b test/c"))) + (should-not calls)) + + (ert-info ("ACK 1 arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/c") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c QIN)))) + ;; Extension not activated because outstanding REQs. + (should-not erc-v3--test/c) + (should-not subcmd-calls) + (should-not calls)) + + (ert-info ("ACK 2 arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/a") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a QIN) (test/b SEND) (test/c QIN)))) + (should-not subcmd-calls) + (should-not calls) + (should-not erc-v3--test/c) ; still missing reply for test/b + (should-not subcmd-calls)) + + (ert-info ("NAK arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * NAK :test/b") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a RUN) (test/b LOG) (test/c RUN)))) + (should erc-v3--test/c) + (should (equal calls '(("CAP END")))) + (should (equal subcmd-calls '(test/c test/a test/b))))) + + (erc-tests-common-kill-buffers)) + +;; This shows that it's possible to "reconsider" an ACK and preempt or +;; overturn mode activation and finalization by forcing another REQ +;; round. For example, an extension could decide some non-IRC +;; requirement is unmet and then safely disable itself instead of +;; activating. But it would also need to try to tell the server to +;; disable the cap to maintain sync. +(ert-deftest erc--server-CAP/preempted-ACK () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3--edges (erc-v3-tests--modify-edges + erc-v3-tests--preempt-up-edges)) + (subcmd-calls ()) + (erc-v3-extensions '(test/a)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (erc-v3--test/a-p o) + (if (eq erc-v3--phase-UP (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wOFF) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + + (add-function :after (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (when (erc-v3--test/b-p o) + (if (eq erc-v3--phase-TRACK (erc-v3--extension-phase= o)) + (erc-v3--transition o erc-v3--event-wON) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil)))) + + (ert-info ("LS arrives, REQ sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/a test/b"))) + (should (equal subcmd-calls '(test/b))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND)))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("ACK arrives, handler reconsiders, preempts END") + ;; Some other extension sends REQ -test/a + (should-not erc-v3--test/a) + (should-not erc-v3--test/b) + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/a test/b") + (should (equal (pop calls) '("CAP REQ :-test/a"))) + (should-not calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b UP)))) + ;; Other ACKs for this round also deferred until no REQs remain. + (should-not erc-v3--test/a) + (should-not erc-v3--test/b) + (should (equal subcmd-calls '(test/a test/b))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("Reconsidered round answered") + ;; Simulate a reply instigated by overriding handler. + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :-test/a") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/a) ; remains disabled + (should erc-v3--test/b) ; activated + ;; Handler called a second time. + (should (equal subcmd-calls '(test/a test/a test/b))) + (should (equal (pop calls) '("CAP END"))) + (should-not calls)) + + (ert-info ("Cap offer rescinded") + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/a") + (should-not erc-v3--test/a) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not calls))) + + (erc-tests-common-kill-buffers)) + +;; This tests the error handling in `erc-v3--ensure-enabled'. +(ert-deftest erc--server-CAP/mode-activation-failure () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + (erc-v3--fatal-mode-body-failure-p nil) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/m test/m-1)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/m erc-v3--test/m-1 + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m INIT) (test/m-1 INIT)))) + + (ert-info ("LS arrives, REQ sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/m test/m-1") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/m test/m-1"))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("ACK arrives, mode activation fails, REQ- sent") + (should-not erc-v3--test/m) + (let ((debug-on-error nil)) ; for Emacs versions < 30 + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/m test/m-1")) + (should (equal (pop calls) '("CAP REQ :-test/m -test/m-1"))) + (should-not calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) + ;; Disabling the mode appears to have worked. + (should-not erc-v3--test/m) + (should-not erc-v3--test/m-1) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("Attempt to disable via REQ- granted") + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :-test/m -test/m-1") + ;; Error message is inserted when interactive. + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m LOG) (test/m-1 LOG)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/m) + (should (equal calls '(("CAP END")))))) + + (erc-tests-common-kill-buffers)) + +;; FIXME convert this test to a full scenario because it benefits from +;; interactive inspection and having a real network process. +(ert-deftest erc--server-CAP/mode-deactivation-failure () + (set-buffer (erc-tests-common-make-server-buf "foonet")) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/n)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/n erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) '((test/n INIT)))) + + (ert-info ("LS arrives, REQ sent, ACK arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/n") + (should (equal (pop calls) '("CAP REQ :test/n"))) + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/n") + (should (equal (pop calls) '("CAP END"))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should erc-v3--test/n) + (should-not calls)) + + (ert-info ("DEL arrives indicating cap test/n no longer supported") + (let ((debug-on-error nil)) ; for versions < 30 + (with-silent-modifications + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/n"))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/n Su-Wi-Me-Pa LOG)))) + (should-not calls) + (should-not erc-v3--test/b))) + + (when noninteractive (erc-tests-common-kill-buffers))) + +(ert-deftest erc-server-410 () + (let ((erc-insert-modify-hook) + (erc-server-current-nick "tester")) + (erc-tests-common-prep-for-insertion) + (erc-server-410 + nil (make-erc-response :unparsed ":irc.gnu.org 410 * FOO :Invalid" + :sender "irc.gnu.org" + :command "410" + :command-args '("*" "FOO") + :contents "Invalid")) + (goto-char (point-min)) + (should (search-forward "*** Invalid CAP subcommand: FOO" nil t)))) + + +;;;; Extension: multi-prefix + +(ert-deftest erc-v3--multi-prefix-split-flags () + (let ((erc-server-process (start-process "nil" (current-buffer) "true")) + (erc--isupport-params (make-hash-table)) + (erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))) + (set-process-query-on-exit-flag erc-server-process nil) + (should (equal (erc-v3--multi-prefix-split-flags "H~&@%+") + '(?H nil (31 . "qaohv") nil))) + (should (equal (erc-v3--multi-prefix-split-flags "H+") + '(?H nil (1 . "v") nil))) + (should (equal (erc-v3--multi-prefix-split-flags "H*!r") + '(?H t (32 . "Y") (?r)))) + (should (equal (erc-v3--multi-prefix-split-flags "H+Bs") + '(?H nil (1 . "v") (?B ?s)))) + (should (equal (erc-v3--multi-prefix-split-flags "H") + '(?H nil (0 . "") nil))) + (should-not (erc-v3--multi-prefix-split-flags "")))) + +(defun erc-v3-tests--multi-prefix (tags test) + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions ()) + (cl-struct-erc-v3--extension-tags + `( ,@tags erc-v3--extension erc-v3--capability))) + + ;; Boilerplate + (erc-v3-mode +1) + (erc-tests-common-simulate-line ":irc.example.org CAP * LS :multi-pref= ix") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :multi-pre= fix") + (should (equal calls '(("CAP END") ("CAP REQ :multi-prefix")))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should erc-v3--multi-prefix) + + (funcall test)) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-server-352 () ; WHO + (erc-v3-tests--multi-prefix + '(erc-v3--multi-prefix) + + (lambda () + (should (equal '((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+)) + (erc--parsed-prefix-alist (erc--parsed-prefix)))) + + (with-current-buffer (erc--open-target "#chan") + (erc-update-current-channel-member "hugle" "hugle" t)) + + (erc-tests-common-simulate-line + (concat ":irc.example.org 352 * #chan" + " hugle fsf/person/hugle *.fsf.org hugle H%+ :0 F. S. Hugle"= )) + + (with-current-buffer "#chan" + (let ((actual (erc-get-channel-member "hugle")) + (expect `([erc-server-user "hugle" "fsf/person/hugle" "hugle" + "F. S. Hugle" nil nil + (,(current-buffer))] + . [erc-channel-user 3 nil]))) + (should (equal actual expect))))))) + + +;;;; Extension: userhost-in-names + +(ert-deftest erc-v3--multi-prefix--partition () + (let ((s "+%@&~")) + (should (equal '(31 "~&@%+" "bob") + (erc-v3--multi-prefix--partition "~&@%+bob" s))) + (should (equal '(15 "&@%+" "bob") + (erc-v3--multi-prefix--partition "&@%+bob" s))) + (should (equal '(7 "@%+" "bob") + (erc-v3--multi-prefix--partition "@%+bob" s))) + (should (equal '(3 "%+" "bob") + (erc-v3--multi-prefix--partition "%+bob" s))) + (should (equal '(1 "+" "bob") + (erc-v3--multi-prefix--partition "+bob" s))) + (should (equal '(0 "" "bob") + (erc-v3--multi-prefix--partition "bob" s))) + (should (equal '(1 "+" "") + (erc-v3--multi-prefix--partition "+" s))))) + +(defun erc-v3-tests--channel-receive-names (input result-fn) + (erc-tests-common-make-server-buf) + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + (should (equal '((?Y . ?!) (?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v .= ?+)) + (erc--parsed-prefix-alist (erc--parsed-prefix)))) + (with-current-buffer (erc--open-target "#chan") + (let (erc-channel-members-changed-hook) + ;; Skips lone status-prefix char "+" (from orignial impl.). + (erc-channel-receive-names input) + (erc-channel-end-receiving-names) + (let ((result (funcall result-fn))) + (dolist (actual (sort (map-pairs erc-channel-users) + (lambda (a b) (string< (car a) (car b))))) + (let ((expected (pop result))) + (should (equal (car actual) (car expected))) + (should (equal actual expected)) + (should (equal (gethash (car actual) (erc-with-server-buffer + erc-server-users)) + (cadr expected)))))))) + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-channel-receive-names--baseline () + (erc-v3-tests--channel-receive-names + "@ChanServ +susnight + m hugle znebot agnesi" + ;; host login full-name info account buffers + (lambda () + (let ((rest `(nil nil nil nil nil (,(current-buffer))))) + `(("agnesi" [erc-server-user "agnesi" ,@rest] + . [erc-channel-user 0 nil]) + ("chanserv" [erc-server-user "ChanServ" ,@rest] + . [erc-channel-user 4 nil]) + ("hugle" [erc-server-user "hugle" ,@rest] + . [erc-channel-user 0 nil]) + ("m" [erc-server-user "m" ,@rest] + . [erc-channel-user 0 nil]) + ("susnight" [erc-server-user "susnight" ,@rest] + . [erc-channel-user 1 nil]) + ("znebot" [erc-server-user "znebot" ,@rest] + . [erc-channel-user 0 nil])))))) + +(ert-deftest erc-channel-receive-names--enabled () + (should-not erc-v3--userhost-in-names) + (let ((erc-v3--userhost-in-names (erc-v3--userhost-in-names)) + ;; full-name info account buffers + (rest `(nil nil nil (,(current-buffer))))) + (lambda () + (erc-v3-tests--channel-receive-names + (concat " @+susnight!~susnight@fsf/member/susnight" + " %+hugle!hugle@fsf/person/hugle" + " +" ; pathological (impossible?) case from orig + " [email protected]" ; ignored: can't index w/o nick + " ride@foo" ; ignored: same as ^ (no nick) + " lovelace!bar" ; interpret "bar" as host + " hamilton!" ; see comment re bouncers in `erc-parse-user' + " franklin@" ; allow, discarding @ + " [email protected]" + " +znebot!~znebot@user/pike/bot/znebot" + " +agnesi") + `(("agnesi" + [erc-server-user "agnesi" nil nil ,@rest] + . [erc-channel-user 1 nil]) + ("franklin" + [erc-server-user "franklin" nil nil ,@rest] + . [erc-channel-user 0 nil]) + ("hamilton" + [erc-server-user "hamilton" nil nil ,@rest] + . [erc-channel-user 0 nil]) + ("hugle" + [erc-server-user "hugle" "fsf/person/hugle" "hugle" ,@rest] + . [erc-channel-user 3 nil]) + ("lovelace" + [erc-server-user "lovelace" "bar" nil ,@rest] + . [erc-channel-user 0 nil]) + ("m" + [erc-server-user "m" "example.org" "~u" ,@rest] + . [erc-channel-user 0 nil]) + ("susnight" + [erc-server-user "susnight" "fsf/member/susnight" "~susnight" ,@= rest] + . [erc-channel-user 5 nil]) + ("znebot" + [erc-server-user "znebot" "user/pike/bot/znebot" "~znebot" ,@res= t] + . [erc-channel-user 1 nil])))))) + + +;;;; Extension WHOX + +;; This also (sort of) touches `erc-v3--whox-enqueue' and also +;; `erc-v3--whox-make-request'. +(ert-deftest erc-v3--whox-delete () + (setq erc-v3--whox (erc-v3--whox)) + (cl-letf* ((calls ()) + ((symbol-function 'erc-server-send) + (lambda (&rest r) (push r calls)))) + (erc-v3--whox-enqueue "#foo" "cuhnflar" #'ignore) + (should (equal calls '(("WHO #foo %tcuhnflar,1" nil "#foo")))) + (should (equal (erc-v3--whox-requests erc-v3--whox) + '(#s(erc-v3--whox-request 1 "#foo" "cuhnflar" ignore)))) + (erc-v3--whox-enqueue "#bar" "cuhnflar" #'ignore) + (should (equal (car (erc-v3--whox-requests erc-v3--whox)) + #s(erc-v3--whox-request 2 "#bar" "cuhnflar" ignore))) + (erc-v3--whox-delete 1) + (should (equal (car (erc-v3--whox-requests erc-v3--whox)) + #s(erc-v3--whox-request 2 "#bar" "cuhnflar" ignore))))) + +;; An earlier version recorded "idle time" as an item in +;; `erc-server-user-info'. If re-adding, use 1580601600, as in +;; +;; $ date --date @1580601600 --utc Sun Feb 2 12:00:00 AM UTC 2020 +;; +(ert-deftest erc-server-354--whox () + (erc-v3-tests--multi-prefix + '(erc-v3--multi-prefix erc-v3--whox) + + (lambda () + ;; Extension only activated once ISUPPORT token arrives after CAP END. + (should-not erc-v3--whox) + (erc-tests-common-simulate-line + ":irc.foonet.org 005 tester PREFIX=3D(qaohv)~&@%+ WHOX=3D390 :suppor= ted") + (should erc-v3--whox) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((multi-prefix RUN) (whox RUN)))) + + ;; Simulate outgoing request for members in #chan. + (push (make-erc-v3--whox-request + :token 1 + :target "#chan" + :fields "cuhnflar" + :handler #'erc-v3--whox-handle-channel-user) + (erc-v3--whox-requests erc-v3--whox)) + (cl-incf (erc-v3--whox-token erc-v3--whox)) + + (with-current-buffer (erc--open-target "#chan") + (erc-v3-mode +1) ; because not added to `erc-modules' + (should erc-v3--whox) + (should erc-v3--multi-prefix) + (erc-update-current-channel-member "hugle" "hugle" t)) + + ;; Simulate a single entry arriving for nick "hugle". + (setq erc-active-buffer (get-buffer "#chan")) ; why? + (erc-tests-common-simulate-line + (concat ":irc.example.org 354 tester 1 #chan" + " ~hugle fsf/person/hugle hugle H@+Br 90 fshugle" + " :F. S. Hugle")) + + ;; Store successfully updated. + (with-current-buffer "#chan" + (let ((actual (gethash "hugle" erc-channel-users))) + (should (equal (car actual) + `[erc-server-user "hugle" "fsf/person/hugle" "~hug= le" + "F. S. Hugle" nil "fshugle" + ,(list (current-buffer))])) + (should (eq (car actual) (erc-get-server-user "hugle"))) + (should (equal (cdr actual) [erc-channel-user 5 nil]))))))) + +;;; erc-v3-tests.el ends here diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/er= c/resources/erc-scenarios-common.el index bf529ac238f..bd17a3611a9 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -787,6 +787,31 @@ erc-scenarios-common--join-network-id (with-current-buffer chan-buf-bar (funcall expect 10 "hath an uncle here"))))) =20 +;;;; v3 + +;; A temporary stand-in for some future "contextual-hover" feature. +;; See eldoc demo. +(declare-function erc-v3--format-prefix "erc-v3" + (cuser-or-status &optional status)) +(declare-function erc-v3--assemble-server-user-info-string "erc-v3" (user)) + +(defun erc-scenarios-common--nick-at-point (point) + "Echo info as \"<account>: <login>@<host>\" for user at POINT, if any. +Show an asterisk instead of account if user is not logged in." + (interactive (list (point))) + (require 'erc-v3) + (when-let* ((nick (car (get-text-property point 'erc-data))) + (cmem (erc-get-channel-member nick)) + (user (car cmem)) + (account (or (erc-server-user-account user) "*"))) + (message "%s: %s%s" + account + (or (and-let* ((cusr (cdr cmem)) + (s (erc-v3--format-prefix cusr t))) + (concat s " ")) + "") + (erc-v3--assemble-server-user-info-string user)))) + (provide 'erc-scenarios-common) =20 ;;; erc-scenarios-common.el ends here diff --git a/test/lisp/erc/resources/v3/account-notify/chghost-no-account-t= ag.eld b/test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.e= ld new file mode 100644 index 00000000000..3e46b01fad5 --- /dev/null +++ b/test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld @@ -0,0 +1,77 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :Tester") + (0.0 ":irc.foonet.org CAP * LS * :account-notify account-tag away-notify = batch cap-notify chghost draft/channel-rename draft/chathistory draft/event= -playback draft/languages=3D17,en,~bs,~de,~el,~en-AU,~es,~fi,~fr-FR,~it,~nl= ,~no,~pl,~pt-BR,~ro,~sq-AL,~tr-TR,~zh-CN draft/multiline=3Dmax-bytes=3D4096= ,max-lines=3D100 draft/register=3Dbefore-connect draft/relaymsg=3D/ draft/r= esume-0.5 echo-message extended-join invite-notify labeled-response message= -tags multi-prefix oragono.io/nope server-time setname") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names znc.in/playback znc.in/= self-message")) +((cap-req 10 "CAP REQ :account-notify away-notify cap-notify chghost echo-= message extended-join message-tags multi-prefix server-time setname") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify chghost messa= ge-tags multi-prefix account-notify extended-join away-notify server-time e= cho-message")) +((cap-req-2 10 "CAP REQ :userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :setname userhost-in-name= s")) +((cap-end 10 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Sun, 08 Aug 2021 10:34:09 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 3= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 3 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 3 3 :Current local users= 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 3 3 :Current global user= s 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug 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.")) + +((join 10 "JOIN #chan") + (0.0 "@time=3D" now " :[email protected] JOIN #chan iamtester T= ester") + (0.0 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@alice!~u@yjg= jjtcq939u8.irc [email protected] [email protected]") + (0.0 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES list= ")) + +((~mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1628418852")) + +((who 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :tester, we= lcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :tester, = welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u yjgjjtcq939u8= .irc alice H@r 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u yjgjjtcq939u8= .irc bob Hr 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 8ch3ur22f9p4q= .irc tester Hr 39 iamtester Tester") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + + (0.0 "@time=3D" now " :[email protected] JOIN #chan * :hacker") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: The= woman falls: sure, he has kill'd his wife.") + (0.0 "@time=3D" now " :[email protected] QUIT :quit: WeeChat 3= .8") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Mad= am, I will, if suddenly I may.") + (0.0 "@time=3D" now " :[email protected] JOIN #chan * :hacker")) + +((privmsg-0 10 "PRIVMSG #chan :checkpoint 0") + (0.0 "@time=3D" now " :[email protected] JOIN #chan * fool")) + +((privmsg-1 10 "PRIVMSG #chan :checkpoint 1") + + (0.0 "@time=3D" now " :[email protected] ACCOUNT :jph") + (0.0 "@time=3D" now " :[email protected] CHGHOST ~jph gnu.org") + + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :hacker, = welcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :Changed my host= ")) + +((privmsg-2 10 "PRIVMSG #chan :checkpoint 2") + (0.0 "@time=3D" now " :[email protected] QUIT :poof") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :fool, we= lcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :fool, welc= ome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Not= hing at this time but my visitation; only, I will promise him an excellent = piece.") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: But= few of any sort, and none of name.") + + (0.0 "@time=3D" now " :[email protected] ACCOUNT fool") + + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :Just logg= ed in") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Tha= n Aquitaine, a dowry for a queen.") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Why= do they run away ? this is a knavery of them to make me afeard.")) diff --git a/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld= b/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld new file mode 100644 index 00000000000..500986a7aef --- /dev/null +++ b/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld @@ -0,0 +1,50 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org CAP * LS * :account-notify account-tag away-notify= batch cap-notify chghost draft/account-registration=3Dbefore-connect draft= /channel-rename draft/chathistory draft/event-playback draft/languages=3D17= ,en,~bs,~de,~el,~en-AU,~es,~fi,~fr-FR,~it,~nl,~no,~pl,~pt-BR,~ro,~sq-AL,~tr= -TR,~zh-CN draft/multiline=3Dmax-bytes=3D4096,max-lines=3D100 draft/persist= ence draft/read-marker draft/relaymsg=3D/ echo-message ergo.chat/nope exten= ded-monitor invite-notify labeled-response message-tags multi-prefix") + (0.00 ":irc.foonet.org CAP * LS :sasl=3DPLAIN,EXTERNAL server-time setnam= e userhost-in-names znc.in/playback znc.in/self-message")) +((cap 10 "CAP REQ :account-notify account-tag away-notify cap-notify chgho= st echo-message extended-monitor message-tags multi-prefix server-time") + (0.00 ":irc.foonet.org CAP * ACK :account-notify account-tag away-notify = cap-notify chghost echo-message extended-monitor message-tags multi-prefix"= )) +((cap 10 "CAP REQ :setname userhost-in-names") + (0.00 "@time=3D" now " :irc.foonet.org CAP * ACK :server-time setname use= rhost-in-names")) +((cap 10 "CAP END") + (0.00 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet = IRC Network tester") + (0.01 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foone= t.org, running version ergo-v2.11.1") + (0.01 "@time=3D" now " :irc.foonet.org 003 tester :This server was create= d Sun, 14 Sep 2025 20:20:42 UTC") + (0.00 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org ergo-v2.= 11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB C= ASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANN= ELLEN=3D64 CHANTYPES=3D# CHATHISTORY=3D25 ELIST=3DU EXCEPTS EXTBAN=3D,m FOR= WARD=3Df INVEX :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester KICKLEN=3D390 MAXLIST= =3DbeI:60 MAXTARGETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 = PREFIX=3D(qaohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:,WHOI= S:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8= ONLY WHOX :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D25 = :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and = 5 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online= ") + (0.00 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connect= ions") + (0.01 "@time=3D" now " :irc.foonet.org 254 tester 2 :channels formed") + (0.00 "@time=3D" now " :irc.foonet.org 255 tester :I have 5 clients and 0= servers") + (0.00 "@time=3D" now " :irc.foonet.org 265 tester 5 5 :Current local user= s 5, max 5") + (0.00 "@time=3D" now " :irc.foonet.org 266 tester 5 5 :Current global use= rs 5, max 5") + (0.01 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing") + (0.00 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.00 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in d= ebug mode and is logging all user I/O. If you do not wish for everything yo= u send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.00 "@time=3D" now " :irc.foonet.org 221 tester +i")) +((join 10 "JOIN #chan") + (0.01 "@time=3D" now ";msgid=3Df2sf9fq52kqw46db2uaasgais2 :tester!~u@ywvg= n2436ga2c.irc JOIN #chan") + (0.01 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :alice!~u@rh2= xhwpq48gfn.irc [email protected] [email protected] @fsbot!= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now ";msgid=3Duxepbgnu2nhq5yde6uffhkgu26;account=3Dalice= :[email protected] PRIVMSG #chan :tester, welcome!") + (0.00 "@time=3D" now ";account=3Dbob;msgid=3Dh9qwf69b98iurmn69kfsi9teha := [email protected] PRIVMSG #chan :tester, welcome!")) +((mode 10 "MODE #chan") + (0.00 "@time=3D" now " :irc.foonet.org 324 tester #chan +Cnt") + (0.00 "@time=3D" now " :irc.foonet.org 329 tester #chan 1757881247")) +((who 10 "WHO #chan %tcuhnflar,1") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc bob Hr 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u ywvgn2436ga2= c.irc tester H 28 0 tester") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc fsbot H@ 324 0 fsbot") + (0.00 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.05 "@time=3D" now ";account=3Dbob;msgid=3Dx6b5k6dkfugudwgtsw4amsni4e := [email protected] PRIVMSG #chan :Come, Marcus, let us go. Publius, f= ollow me.") + (0.03 "@time=3D" now ";account=3Ddummy;msgid=3Dmt3jnbrqeusir5ne38kimtcvx2= :[email protected] JOIN #chan") + (0.02 "@time=3D" now ";account=3Dalice;msgid=3Dj9tfhq2ecaef7d3gzbutcfwrpi= :[email protected] PRIVMSG #chan :dummy, welcome!") + (0.00 "@time=3D" now ";account=3Dbob;msgid=3Dbdhtn9cqnzzi7n3s4dv2t3fuw6 := [email protected] PRIVMSG #chan :dummy, welcome!")) diff --git a/test/lisp/erc/resources/v3/away-notify/basic.eld b/test/lisp/e= rc/resources/v3/away-notify/basic.eld new file mode 100644 index 00000000000..d7b304c790f --- /dev/null +++ b/test/lisp/erc/resources/v3/away-notify/basic.eld @@ -0,0 +1,63 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) + +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag away-notify batch cap-notif= y echo-message extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNA= L server-time") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names") + ;; SASL handler not triggered + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 903 * :Authentication successful")) +((cap-req 3.2 "CAP REQ :away-notify cap-notify echo-message extended-join = message-tags multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join away-notify server-time echo-m= essage")) + +((cap-end 3.21 "CAP END") + (0.00 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet = IRC Network tester") + (0.02 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foone= t.org, running version oragono-2.6.0-7481bf0385b95b16") + (0.01 "@time=3D" now " :irc.foonet.org 003 tester :This server was create= d Sat, 31 Jul 2021 07:09:01 UTC") + (0.01 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-= 2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB C= ASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANN= ELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KI= CKLEN=3D390 :are supported by this server") + (0.01 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTAR= GETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)= ~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10= ,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc82= 65 UTF8ONLY WHOX :are supported by this server") + (0.01 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100= :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and = 4 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online= ") + (0.00 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connect= ions") + (0.00 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.00 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0= servers") + (0.02 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local user= s 4, max 4") + (0.00 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global use= rs 4, max 4") + (0.00 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug 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.")) + +((join 23.39 "JOIN #chan") + (0.04 "@time=3D" now ";msgid=3Diyjsum9v7ann2chmxbczvu3hss :tester!~u@pevu= fvju5igb4.irc JOIN #chan tester tester") + (0.01 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@bob!~u@wgbc= gvmj77t7q.irc [email protected] [email protected] tester!~= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now ";msgid=3Dceyngmc9ma4sjcu8nugh32pytw :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :tester, welcome!") + (0.00 "@time=3D" now ";msgid=3Dw6d57jstir3mdedecn27vd597a :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :tester, welcome!")) + +((mode 1 "MODE #chan") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627715341") + (0.0 "@time=3D" now ";msgid=3Dpevm3qdtxtvxre8quauqiwd8ge :bob!~u@wgbcgvmj= 77t7q.irc PRIVMSG #chan :alice: Here comes Signior Claudio, led by the prov= ost to prison; and there's Madam Juliet.")) + +((who 1 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u wgbcgvmj77t7q= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u wgbcgvmj77t7q= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u pevufvju5igb4= .irc fool Hr 152 fool fool") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u pevufvju5igb4= .irc tester Hr 30 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + + (0.09 "@time=3D" now ";msgid=3Ddf5s3atpdt39izvtnfg85vwq8a :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: That is, hot ice and wonderous strange sno= w.") + (0.01 "@time=3D" now ";msgid=3Dk2czbnr6ve3ppdnxyz92xcsdq6 :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Inhuman traitors, you constrain'd and forc= 'd.") + (0.05 "@time=3D" now " :[email protected] AWAY afk") + (0.05 "@time=3D" now ";msgid=3D3wcau6b443qwswa4uu5iuwnemw :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: With baleful weeds and precious-juiced flo= wers.") + (0.01 "@time=3D" now ";msgid=3D9c456v6gauijkqpiptem9ds7ie :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: And rape, I fear, was root of thine annoy.= ") + (0.00 "@time=3D" now ";msgid=3Dswf3q7myzk6yvz6fin6k58cqxe :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: Lies my consent and fair according voice.") + (0.01 "@time=3D" now ";msgid=3Dvzprmznjewv2gm5h5zdqarppjw :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Never came trouble to my house in the like= ness of your Grace, for trouble being gone, comfort should remain; but when= you depart from me, sorrow abides and happiness takes his leave.") + (0.08 "@time=3D" now " :[email protected] AWAY") + (0.01 "@time=3D" now ";msgid=3D45mc34i8d2gk5evy9vcp448vbs :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Which the false man does easy. I'll to Eng= land.")) diff --git a/test/lisp/erc/resources/v3/cap-notify/basic.eld b/test/lisp/er= c/resources/v3/cap-notify/basic.eld new file mode 100644 index 00000000000..447cb8d6311 --- /dev/null +++ b/test/lisp/erc/resources/v3/cap-notify/basic.eld @@ -0,0 +1,67 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK pretester")) +((user 1 "USER user 0 * :pretester") + (0.02 ":irc.znc.in CAP unknown-nick LS :batch cap-notify echo-message mul= ti-prefix server-time userhost-in-names znc.in/batch znc.in/self-message zn= c.in/server-time-iso")) + +((cap-req 3.2 "CAP REQ :cap-notify echo-message multi-prefix server-time u= serhost-in-names") + (0.03 "@time=3D" now " :irc.znc.in CAP pretester ACK :cap-notify multi-pr= efix userhost-in-names server-time echo-message")) + +((~cap-req-a 4 "CAP REQ :account-notify away-notify extended-join") + (0.13 "@time=3D" now " :irc.znc.in CAP tester ACK :away-notify") + (0.02 "@time=3D" now " :irc.znc.in CAP tester ACK :extended-join") + (0.02 "@time=3D" now " :irc.znc.in CAP tester ACK :account-notify")) + +((cap-end 3.2 "CAP END") + ;; Note that this was captured from an older ZNC. + ;; Version 1.10.1 sends each NEW on a separate line. + (0.04 "@time=3D" now " :irc.znc.in CAP tester NEW :account-notify away-no= tify extended-join") + + (0.0 "@time=3D" now " :calcium.libera.chat 001 pretester :Welcome to the = Libera.Chat Internet Relay Chat Network tester") + (0.1 "@time=3D" now " :calcium.libera.chat 002 pretester :Your host is ca= lcium.libera.chat[64.86.243.186/6697], running version solanum-1.0-dev") + (0.0 "@time=3D" now " :calcium.libera.chat 003 pretester :This server was= created Sat Jun 19 2021 at 12:58:41 UTC") + (0.1 "@time=3D" now " :calcium.libera.chat 004 pretester calcium.libera.c= hat solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqj= fI") + (0.0 "@time=3D" now " :calcium.libera.chat 005 pretester ETRACE SAFELIST = ELIST=3DCTU MONITOR=3D100 FNC WHOX KNOCK CHANTYPES=3D# EXCEPTS INVEX CHANMO= DES=3DeIbq,k,flj,CFLMPQScgimnprstuz CHANLIMIT=3D#:250 :are supported by thi= s server") + (0.1 "@time=3D" now " :calcium.libera.chat 005 pretester PREFIX=3D(ov)@+ = MAXLIST=3DbqeI:100 MODES=3D4 NETWORK=3DLibera.Chat STATUSMSG=3D@+ CASEMAPPI= NG=3Drfc1459 NICKLEN=3D16 MAXNICKLEN=3D16 CHANNELLEN=3D50 TOPICLEN=3D390 DE= AF=3DD TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,M= ONITOR: :are supported by this server") + (0.0 "@time=3D" now " :calcium.libera.chat 005 pretester EXTBAN=3D$,ajrxz= CALLERID=3Dg :are supported by this server") + (0.0 "@time=3D" now " :calcium.libera.chat 251 pretester :There are 62 us= ers and 43177 invisible on 27 servers") + (0.0 "@time=3D" now " :calcium.libera.chat 252 pretester 35 :IRC Operator= s online") + (0.0 "@time=3D" now " :calcium.libera.chat 254 pretester 19494 :channels = formed") + (0.0 "@time=3D" now " :calcium.libera.chat 255 pretester :I have 2066 cli= ents and 1 servers") + (0.0 "@time=3D" now " :calcium.libera.chat 265 pretester 2066 2181 :Curre= nt local users 2066, max 2181") + (0.1 "@time=3D" now " :calcium.libera.chat 266 pretester 43239 47407 :Cur= rent global users 43239, max 47407") + (0.0 "@time=3D" now " :calcium.libera.chat 250 pretester :Highest connect= ion count: 2182 (2181 clients) (18443 connections received)") + (0.0 "@time=3D" now " :pretester!pretester@localhost NICK :tester") + (0.0 "@time=3D" now " :calcium.libera.chat 375 tester :- calcium.libera.c= hat Message of the Day - ") + (0.0 "@time=3D" now " :calcium.libera.chat 372 tester :- Welcome to Liber= a Chat, the IRC network for") + (0.0 "@time=3D" now " :calcium.libera.chat 376 tester :End of /MOTD comma= nd.")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :tester!pretester@localhost MODE tester :+Zi") + (0.0 "@time=3D" now " :irc.znc.in 306 tester :You have been marked as bei= ng away") + (0.0 "@time=3D" now " :tester!pretester@localhost JOIN #chan") + (0.0 "@time=3D" now " :calcium.libera.chat 332 tester #chan :ERC: the pow= erful, modular, and extensible IRC client | https://gnu.org/s/emacs/erc | Q= uestions welcome! | See https://gnu.org/server/irc-rules and https://gnu.or= g/p/kind-communication") + (0.0 "@time=3D" now " :calcium.libera.chat 333 tester #chan onaqnyv!~onaq= nyv@tah/onaqnyv 1621566282") + (0.0 "@time=3D" now " :calcium.libera.chat 353 tester =3D #chan :@onaqnyv= !~onaqnyv@tah/onaqnyv pbejva!fbzrbar@sbffubfg/qverpgbe/pbejva crierc!~ERC@u= ser/crierc tester!pretester@localhost") + (0.0 "@time=3D" now " :calcium.libera.chat 366 tester #chan :End of /NAME= S list.") + + (0.0 "@time=3D2021-07-30T12:59:26.172Z :crierc!~ERC@user/crierc PRIVMSG #= chan :~ \2Nzva Onaqnyv\17 ~ Fri, 30 Jul 2021 08:27:26 -0400 ~ https://lists= .gnu.org/archive/html/bug-gnu-emacs/2021-07/msg01639.html =E2=97=8F bug#467= 77: 28.0.50; ERC: NickServ identification: Prompt for password after other = sources, overall simplifications | Hi Ynef, all, Ynef Vatroevtgfra writes: = Apologies for my slow reply and absence. I haven't been well for a few...") + (0.0 "@time=3D2021-07-30T12:59:30.373Z :crierc!~ERC@user/crierc PRIVMSG #= chan :~ \2Ynef Vatroevtgfra\17 ~ Fri, 30 Jul 2021 14:43:46 +0200 ~ https://= lists.gnu.org/archive/html/bug-gnu-emacs/2021-07/msg01645.html =E2=97=8F bu= g#46777: 28.0.50; ERC: NickServ identification: Prompt for password after o= ther sources, overall simplifications | Great! (Well, not great that you h= aven't been feeling well, but that you're better. :-)) -- (domestic p...") + (0.0 "@time=3D2021-07-31T14:48:33.324Z :[email protected]= ragregry.cy PRIVMSG #chan :hi all, what is official # for gnus ?") + (0.0 "@time=3D2021-07-31T14:48:59.060Z :[email protected]= ragregry.cy PRIVMSG #chan :#gnus =C3=96D") + (0.0 "@time=3D2021-07-31T14:49:00.479Z :[email protected]= ragregry.cy PRIVMSG #chan ::D") + (0.0 "@time=3D2021-07-31T16:04:34.182Z :pbejva!fbzrbar@sbffubfg/qverpgbe/= pbejva PRIVMSG #chan ::D (wascally gnubians)")) + +((mode 1.95 "MODE #chan") + (0.0 "@time=3D" now " :calcium.libera.chat 305 tester :You are no longer = marked as being away") + (0.03 "@time=3D" now " :calcium.libera.chat 324 tester #chan +nt") + (0.02 "@time=3D" now " :calcium.libera.chat 329 tester #chan 1621432871")) + +((who 1.36 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan ~ERC user/c= rierc crierc H 0 crierc :0.0.0.0") + (0.1 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan ~onaqnyv ta= h/onaqnyv onaqnyv G@ 0 onaqnyv :Nzva Onaqnyv") + (0.8 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan pretester l= ocalhost tester H 376784 pretester :Pre Tester") + (0.0 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan fbzrbar sbf= fubfg/qverpgbe/pbejva pbejva G 0 pbejva :fbzrbar") + (0.0 "@time=3D" now " :calcium.libera.chat 315 tester #chan :End of /WHO = list.") + (0.8 "@time=3D" now " :pbejva!fbzrbar@sbffubfg/qverpgbe/pbejva PRIVMSG #c= han :noice. ty for sharing!")) diff --git a/test/lisp/erc/resources/v3/echo-message/basic.eld b/test/lisp/= erc/resources/v3/echo-message/basic.eld new file mode 100644 index 00000000000..71e59a751b1 --- /dev/null +++ b/test/lisp/erc/resources/v3/echo-message/basic.eld @@ -0,0 +1,74 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK tester")) + +((user 1 "USER user 0 * :tester") + (0.0 ":irc.znc.in CAP unknown-nick LS :batch cap-notify echo-message mult= i-prefix server-time userhost-in-names")) +((cap-req 3.2 "CAP REQ :cap-notify echo-message multi-prefix server-time u= serhost-in-names") + (0.0 "@time=3D" now " :irc.znc.in CAP tester ACK :cap-notify multi-prefix= userhost-in-names server-time echo-message")) + +((cap-end 3.2 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Sat, 24 Jul 2021 08:34:26 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 3= invisible on 1 server(s)") + (0.2 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 3 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 3 3 :Current local users= 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 3 3 :Current global user= s 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + ;; unrequited ^ + (0.0 "@time=3D" now " :irc.znc.in 306 tester :You have been marked as bei= ng away") + (0.0 "@time=3D" now " :[email protected] JOIN #chan") + (0.0 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@alice!~u@ifb= q62z6ccbj8.irc [email protected] [email protected]") + (0.0 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of /NAMES lis= t.") + (0.0 "@time=3D2021-07-24T09:26:19.211Z :[email protected] PRIVMSG = #chan :alice: Plead your deserts in peace and humbleness.") + (0.0 "@time=3D2021-07-24T09:26:21.215Z :[email protected] PRIVMS= G #chan :bob: To the rest, and I 'mongst lords be thought a fool.") + (0.0 "@time=3D2021-07-24T09:26:22.030Z :[email protected] PRIVM= SG #chan :Howdy from the past!") + (0.0 "@time=3D2021-07-24T09:26:24.220Z :[email protected] PRIVMSG = #chan :alice: You are deceived, my lord: this is Monsieur Parolles, the gal= lant militarist,that was his own phrase,that had the whole theorick of war = in the knot of his scarf, and the practice in the chape of his dagger.") + (0.0 "@time=3D2021-07-24T09:26:29.227Z :[email protected] PRIVMS= G #chan :bob: The worst fault you have is to be in love.") + (0.0 "@time=3D" now " :irc.foonet.org 305 tester :You are no longer marke= d as being away")) + +((mode 10 "MODE #chan") + (0.00 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.00 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627115669") + (0.08 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: He= re will I rest me till the break of day.") + (0.07 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Th= at lady is not now living, or this gentleman's opinion by this worn out.")) + +((privmsg-chan 10 "PRIVMSG #chan :hi from the present") + (0.03 "@time=3D" now " :[email protected] PRIVMSG #chan :hi fro= m the present") + (0.10 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Yo= u should have said, sir, before a knave thou'rt a knave; that is, before me= thou'rt a knave: this had been truth, sir.") + (0.00 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: An= d reason says you are the worthier maid.")) + +((privmsg-chan-action 10.5 "PRIVMSG #chan :\1ACTION sad\1") + (0.04 "@time=3D" now " :[email protected] PRIVMSG #chan :\1ACTI= ON sad\1") + (0.10 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: He= re will I rest me till the break of day.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Th= an all yon fiery oes and eyes of light.")) + +((privmsg-bob 10 "PRIVMSG bob :hi") + (0.04 "@time=3D" now " :[email protected] PRIVMSG bob :hi")) + +((monitor-bob 10 "MONITOR + bob") + (0.01 "@time=3D" now " :irc.foonet.org 730 tester bob") + (0.18 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: He= 's very near the truth in this.") + (0.09 "@time=3D" now " :[email protected] PRIVMSG tester :Here liv= es a caitiff wretch would sell it him.") + (0.02 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Pe= ace! you dull fool: I found them on a tree.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Wa= s I, in sooth ? and I was the first that lost thee.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: An= d therefore hath the wind-swift Cupid wings.")) + +((version 10 "PRIVMSG bob :\1VERSION\1") + (0.0 "@time=3D" now " :[email protected] PRIVMSG bob :\1VERSION= \1") + (0.0 "@time=3D" now " :[email protected] NOTICE tester :\1VERSION = \2ERC\2 5.x (IRC client for GNU Emacs) (\2https://www.gnu.org/software/emac= s/erc.html (mailing list: [email protected])\2)\1")) + +((privmsg-bob-action 10 "PRIVMSG bob :\1ACTION tired\1") + (0.01 "@time=3D" now " :[email protected] PRIVMSG bob :\1ACTION= tired\1") + (0.14 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Wh= en lion rough in wildest rage doth roar.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Ha= ! now I see thou art a fool, and fit for thy master.")) diff --git a/test/lisp/erc/resources/v3/extended-join/basic.eld b/test/lisp= /erc/resources/v3/extended-join/basic.eld new file mode 100644 index 00000000000..44072806cda --- /dev/null +++ b/test/lisp/erc/resources/v3/extended-join/basic.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :J. Random Hacker") + (0.00 ":irc.example.org CAP * LS * :cap-notify extended-join message-tags= multi-prefix") + (0.00 ":irc.example.org CAP * LS :userhost-in-names server-time") + (0.01 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.00 ":irc.example.org 903 * :Authentication successful")) + +((cap 10 "CAP REQ :cap-notify extended-join message-tags multi-prefix user= host-in-names server-time") + (0.0 "@time=3D" now " :irc.example.org CAP * ACK :cap-notify message-tags= multi-prefix userhost-in-names extended-join server-time")) + +((cap 10 "CAP END") + (0.00 "@time=3D" now " :irc.example.org 001 tester :Welcome to the Exampl= eOrg IRC Network tester") + (0.02 "@time=3D" now " :irc.example.org 002 tester :Your host is irc.exam= ple.org, running version oragono-2.6.1-937b9b02368748e5") + (0.01 "@time=3D" now " :irc.example.org 003 tester :This server was creat= ed Tue, 27 Jul 2021 23:47:08 UTC") + (0.01 "@time=3D" now " :irc.example.org 004 tester irc.example.org oragon= o-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.example.org 005 tester AWAYLEN=3D390 BOT=3DB = CASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHAN= NELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX K= ICKLEN=3D390 :are supported by this server") + (0.01 "@time=3D" now " :irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTA= RGETS=3D4 MODES MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(q= aohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHO= ST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3D= rfc8265 UTF8ONLY :are supported by this server") + (0.01 "@time=3D" now " :irc.example.org 005 tester draft/CHATHISTORY=3D10= 0 :are supported by this server") + (0.00 "@time=3D" now " :irc.example.org 251 tester :There are 0 users and= 2 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.example.org 252 tester 0 :IRC Operators onlin= e") + (0.00 "@time=3D" now " :irc.example.org 253 tester 0 :unregistered connec= tions") + (0.00 "@time=3D" now " :irc.example.org 254 tester 0 :channels formed") + (0.00 "@time=3D" now " :irc.example.org 255 tester :I have 2 clients and = 0 servers") + (0.00 "@time=3D" now " :irc.example.org 265 tester 2 2 :Current local use= rs 2, max 2") + (0.00 "@time=3D" now " :irc.example.org 266 tester 2 2 :Current global us= ers 2, max 2") + (0.00 "@time=3D" now " :irc.example.org 375 tester :- irc.example.org Mes= sage of the day - ") + (0.00 "@time=3D" now " :irc.example.org 372 tester :- This is the default= Oragono MOTD.") + (0.00 "@time=3D" now " :irc.example.org 376 tester :End of MOTD command")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.example.org 221 tester +i")) + +((join 10 "JOIN #chan") + ;; This may also be like :[email protected] JOIN #chan * tester + (0.05 "@msgid=3Dhbxvgjgbdpa9tjeyecyjajdma2;time=3D" now " :tester!~u@r7s6= xb547r7hc.irc JOIN #chan tester :J. Random Hacker")) + +((mode 10 "MODE #chan") + (0.02 "@time=3D" now " :irc.example.org 353 tester =3D #chan :@tester!~u@= r7s6xb547r7hc.irc") + (0.00 "@time=3D" now " :irc.example.org 366 tester #chan :End of NAMES li= st") + (0.00 "@time=3D" now " :irc.example.org 324 tester #chan +nt") + (0.00 "@time=3D" now " :irc.example.org 329 tester #chan 1627444487") + (0.06 "@msgid=3Dd8jc73cquhxj78x56zs49drgan;time=3D" now " :alice!~u@r7s6x= b547r7hc.irc JOIN #chan aph :Alyssa P. Hacker") + ;; Server might send account tag even though we never REQ'd + (0.04 "@time=3D" now ";account=3Daph;msgid=3Drgicm5nt9uvqr6nkrub4b6jqp6 := [email protected] PRIVMSG #chan :hi")) + +((privmsg-0 10 "PRIVMSG #chan :checkpoint 0") + (0.05 "@msgid=3Dbfifbrejgjxkysmkkzur3q3pgw;time=3D" now ";account=3Daph := [email protected] PART #chan :" quit)) + +((privmsg-1 10 "PRIVMSG #chan :checkpoint 1") + (0.09 "@msgid=3Djhqvgy9i6nasbtgy5emcewegs2;time=3D" now " :alice!~u@r7s6x= b547r7hc.irc JOIN #chan aph :Alyssa P. Hacker")) + +((privmsg-2 10 "PRIVMSG #chan :checkpoint 2") + (0.05 "@time=3D" now ";account=3Daph;msgid=3Drmzd9sp8djmwrn46e9dnauziqn := [email protected] QUIT :Quit: " quit)) diff --git a/test/lisp/erc/resources/v3/multi-prefix/basic.eld b/test/lisp/= erc/resources/v3/multi-prefix/basic.eld new file mode 100644 index 00000000000..20801111260 --- /dev/null +++ b/test/lisp/erc/resources/v3/multi-prefix/basic.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.0 ":irc.example.org CAP * LS :cap-notify multi-prefix") + (0.16 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify multi-prefix") + (0.0 ":irc.example.org CAP * ACK :cap-notify multi-prefix")) + +;; Note absence of WHOX among ISUPPORT params. +((cap-end 10 "CAP END") + (0.00 ":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 Fri, 16 Jul 2= 021 09:14:47 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios= CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.example.org 005 tester AWAYLEN=3D200 BOT=3DB CASEMAPPING=3Das= cii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNELLEN=3D64 CHAN= TYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KICKLEN=3D390 :ar= e supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTARGETS=3D4 MODES = MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(qaohv)~&@%+ STATU= SMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,= TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc8265 UTF8ONLY= :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=3D100 :are supported= by this server") + (0.00 ":irc.example.org 251 tester :There are 1 users and 0 invisible on = 1 server(s)") + (0.00 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.example.org 253 tester 0 :unregistered connections") + (0.00 ":irc.example.org 254 tester 0 :channels formed") + (0.00 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.00 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.00 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.00 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 10 "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 rea= dable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.0 ":tester!~user@localhost JOIN #chan") + (0.29 ":irc.example.org 353 tester =3D #chan :@tester ~@+fsbot alice bob = dummy") + (0.0 ":irc.example.org 366 tester #chan :End of NAMES list")) + +((mode-chan 10 "MODE #chan") + (0.0 ":irc.example.org 324 tester #chan +nt") + (0.01 ":irc.example.org 329 tester #chan 1626426898")) + +((mode-change 10 "MODE #chan +v tester") + (0.00 ":tester!~user@localhost MODE #chan +v tester")) + +((who 10 "WHO #chan") + (0.01 ":irc.example.org 352 tester #chan ~alice 4gf9njv5ccr96.irc irc.foo= net.org alice Hr :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.org 352 tester #chan ~bob 4gf9njv5ccr96.irc irc.foone= t.org bob Hr :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.org 352 tester #chan ~user localhost irc.example.org = tester H@+ :0 tester") + (0.01 ":irc.example.org 352 tester #chan ~fsbot 4gf9njv5ccr96.irc irc.foo= net.org fsbot H~@+ :0 fsbot") + (0.01 ":irc.example.org 315 tester #chan :End of WHO list")) diff --git a/test/lisp/erc/resources/v3/sasl/plain-failed.eld b/test/lisp/e= rc/resources/v3/sasl/plain-failed.eld new file mode 100644 index 00000000000..c174596d44f --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain-failed.eld @@ -0,0 +1,18 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + + (0.0 ":irc.foonet.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 10 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org AUTHENTICATE +")) + +((authenticate-gimme 10 "AUTHENTICATE AHRlc3RlcgB3cm9uZw=3D=3D") + (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")) diff --git a/test/lisp/erc/resources/v3/sasl/plain-unsupported.eld b/test/l= isp/erc/resources/v3/sasl/plain-unsupported.eld new file mode 100644 index 00000000000..dc5d2e465c2 --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain-unsupported.eld @@ -0,0 +1,7 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")) diff --git a/test/lisp/erc/resources/v3/sasl/plain.eld b/test/lisp/erc/reso= urces/v3/sasl/plain.eld new file mode 100644 index 00000000000..3bd99916855 --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain.eld @@ -0,0 +1,39 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester@school 0 * :tester") + + (0.0 ":irc.example.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0.0 ":irc.example.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 10 "AUTHENTICATE PLAIN") + (0.0 ":irc.example.org AUTHENTICATE +")) + +((authenticate-gimme 10 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw=3D=3D") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 10 "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 2= 021 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=3D200 BOT=3DB CASEMAPPING=3Dasc= ii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNELLEN=3D64 CHANT= YPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KICKLEN=3D390 :are= supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTARGETS=3D4 MODES = MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(qaohv)~&@%+ STATU= SMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,= TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc8265 UTF8ONLY= :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=3D100 :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 10 "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 rea= dable by the server owner(s), please disconnect.")) diff --git a/test/lisp/erc/resources/v3/sasl/scram-sha-1.eld b/test/lisp/er= c/resources/v3/sasl/scram-sha-1.eld new file mode 100644 index 00000000000..994163d876c --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/scram-sha-1.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0.0 ":jaguar.test CAP unknown-nick LS :cap-notify sasl=3DSCRAM-SHA-1")) + +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (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 cap-notify")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-1") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5= MEw0ZkdrS0FaMGh1akZCcw=3D=3D") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBT= cGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng=3D=3D")) + +((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRm= R2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlV= ZUFdVPQ=3D=3D") + (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles [email protected] jilles :You = are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~ji= [email protected]") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version In= spIRCd-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 ABEFHI= JLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=3D30 AWAYLEN=3D200 BOT=3DB CALLERID=3D= g CASEMAPPING=3Drfc1459 CHANLIMIT=3D#:120 CHANMODES=3DIXbeg,k,BEFHJLfjl,AMN= OQRSTcimnprstuz CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DCMNTU ESILENCE=3DCcdi= NnPpTtx EXCEPTS=3De :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=3D,ANOQRSTUacmnprz HOSTLEN=3D64 INVEX= =3DI KEYLEN=3D32 KICKLEN=3D255 LINELEN=3D512 MAXLIST=3DI:100,X:100,b:100,e:= 100,g:100 MAXTARGETS=3D20 MODES=3D20 MONITOR=3D30 NAMELEN=3D128 NAMESX NETW= ORK=3Djaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=3D31 PREFIX=3D(Yqaohv)!~&@%+ REMOVE S= AFELIST SECURELIST=3D60 SILENCE=3D32 STATUSMSG=3D!~&@%+ TOPICLEN=3D307 UHNA= MES USERIP USERLEN=3D11 USERMODES=3D,,s,BILRSWcghiorwz WATCH=3D30 :are supp= orted 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 10 "MODE jilles +i") + (0 ":[email protected] MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/v3/sasl/scram-sha-256.eld b/test/lisp/= erc/resources/v3/sasl/scram-sha-256.eld new file mode 100644 index 00000000000..8049da1de6c --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/scram-sha-256.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0.0 ":jaguar.test CAP unknown-nick LS :cap-notify sasl")) + +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (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 :cap-notify sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-256") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tB= WjBodWpGQnM=3D") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNk= YmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1k= ySTFPVE09LGk9NDA5Ng=3D=3D")) + +((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJz= ZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3B= wWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ=3D=3D") + (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJK= dFVNPQ=3D=3D")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles [email protected] jilles :You = are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~ji= [email protected]") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version In= spIRCd-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 ABEFHI= JLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=3D30 AWAYLEN=3D200 BOT=3DB CALLERID=3D= g CASEMAPPING=3Drfc1459 CHANLIMIT=3D#:120 CHANMODES=3DIXbeg,k,BEFHJLfjl,AMN= OQRSTcimnprstuz CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DCMNTU ESILENCE=3DCcdi= NnPpTtx EXCEPTS=3De :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=3D,ANOQRSTUacmnprz HOSTLEN=3D64 INVEX= =3DI KEYLEN=3D32 KICKLEN=3D255 LINELEN=3D512 MAXLIST=3DI:100,X:100,b:100,e:= 100,g:100 MAXTARGETS=3D20 MODES=3D20 MONITOR=3D30 NAMELEN=3D128 NAMESX NETW= ORK=3Djaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=3D31 PREFIX=3D(Yqaohv)!~&@%+ REMOVE S= AFELIST SECURELIST=3D60 SILENCE=3D32 STATUSMSG=3D!~&@%+ TOPICLEN=3D307 UHNA= MES USERIP USERLEN=3D11 USERMODES=3D,,s,BILRSWcghiorwz WATCH=3D30 :are supp= orted 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 10 "MODE jilles +i") + (0 ":[email protected] MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/v3/server-time/basic.eld b/test/lisp/e= rc/resources/v3/server-time/basic.eld new file mode 100644 index 00000000000..1d95cb850ef --- /dev/null +++ b/test/lisp/erc/resources/v3/server-time/basic.eld @@ -0,0 +1,57 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 9 "CAP LS 302") + (0 ":irc.example.org CAP you LS :cap-notify server-time")) + +((pass 0.2 "PASS :password123")) +((nick 0.2 "NICK tester")) +((user 0.2 "USER user 0 * :tester")) + +((cap-req 5.2 "CAP REQ :cap-notify server-time") + (0 "@time=3D" now " :irc.example.org CAP tester ACK :cap-notify server-ti= me")) + +((cap-end 5.2 "CAP END") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 001 tester :Welcome= ") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 002 tester :Your ho= st is irc.example.org, running version oragono-2.6.1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 003 tester :This se= rver was created Fri, 16 Jul 2021 09:14:47 UTC") + ;; Abnormal trailing param leads to `erc-server-announced-name' + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 004 tester :irc3d 1= .1.6") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester AWAYLEN= =3D200 BOT=3DB CASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,C= EMRUimnstu CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORW= ARD=3Df INVEX KICKLEN=3D390 :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester MAXLIST= =3DbeI:60 MAXTARGETS=3D4 MODES MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN= =3D32 PREFIX=3D(qaohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK= :1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D3= 90 UTF8MAPPING=3Drfc8265 UTF8ONLY :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester draft/CH= ATHISTORY=3D100 :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 251 tester :There a= re 1 users and 0 invisible on 1 server(s)") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 252 tester 0 :IRC O= perators online") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 253 tester 0 :unreg= istered connections") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 254 tester 0 :chann= els formed") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 255 tester :I have = 1 clients and 0 servers") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 265 tester 1 1 :Cur= rent local users 1, max 1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 266 tester 1 1 :Cur= rent global users 1, max 1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 422 tester :MOTD Fi= le is missing")) + +((mode-user 1.2 "MODE tester +i") + (0 "@time=3D" now " :irc.example.org 221 tester +Zi") + (0 "@time=3D" now " :tester JOIN :#foo") + (0 "@time=3D" now " :irc.example.org 353 tester =3D #foo :tester sneercat= ") + (0 "@time=3D" now " :irc.example.org 366 tester #foo :End of /NAMES list.= ") + (0 "@time=3D" now " :tester JOIN :#bar") + (0 "@time=3D" now " :irc.example.org 353 tester =3D #bar :tester underper= sona") + (0 "@time=3D" now " :irc.example.org 366 tester #bar :End of /NAMES list.= ") + (0 "@time=3D2020-09-23T23:50:00.324Z :[email protected] PRIVMSG = #foo :'Twas brillig, and the slithy toves") + (0 "@time=3D2020-09-23T23:51:40.118Z :[email protected] PRIVMSG = #foo :Did gyre and gimble in the wabe;") + (0 "@time=3D2020-09-24T00:00:00.167Z :[email protected] PRIVMSG #f= oo :All mimsy were the borogoves,") + (0 "@time=3D2020-09-24T00:01:40.350Z :[email protected] PRIVMSG #f= oo :And the mome raths outgrabe.") + (0 "@time=3D2020-09-24T00:05:00.284Z :[email protected] PRIVMSG = #foo :\"Beware the Jabberwock, my son!") + (0 "@time=3D2020-09-24T06:46:40.324Z :[email protected] PRIVMSG = #bar :The jaws that bite, the claws that catch!") + (0 "@time=3D2020-09-24T06:55:00.118Z :[email protected] PRIVMSG #b= ar :Beware the Jubjub bird, and shun") + (0 "@time=3D2020-09-24T06:56:40.167Z :[email protected] PRIVMSG #b= ar :The frumious Bandersnatch!\"") + (0 "@time=3D2020-09-24T07:03:20.350Z :[email protected] PRIVMSG = #bar :He took his vorpal sword in hand:") + (0 "@time=3D2020-09-24T07:03:30.841Z :[email protected] PRIVMSG = #bar :Long time the manxome foe he sought=E2=80=94") + (0 "@time=3D2020-09-24T07:20:20.697Z :[email protected] PRIVMSG #b= ar :So rested he by the Tumtum tree,") + (0 "@time=3D2020-09-24T07:20:30.385Z :[email protected] PRIVMSG #b= ar :And stood awhile in thought.")) + +((~mode-foo 3.68 "MODE #foo") + (0.0 ":irc.example.org 324 tester #foo +nt") + (0.01 ":irc.example.org 329 tester #foo 1626426898")) + +((~mode-bar 3.68 "MODE #bar") + (0.0 ":irc.example.org 324 tester #bar +nt") + (0.01 ":irc.example.org 329 tester #bar 1626426898")) diff --git a/test/lisp/erc/resources/v3/userhost-in-names/basic.eld b/test/= lisp/erc/resources/v3/userhost-in-names/basic.eld new file mode 100644 index 00000000000..9f7b97d9cdc --- /dev/null +++ b/test/lisp/erc/resources/v3/userhost-in-names/basic.eld @@ -0,0 +1,59 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0 ":irc.example.org CAP you LS :sasl=3Dfoo,plain cap-notify multi-prefix= userhost-in-names")) + +((pass 10 "PASS :password123")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester")) + +((cap-req 10 "CAP REQ :cap-notify multi-prefix userhost-in-names") + (0 ":irc.example.org CAP tester ACK :cap-notify multi-prefix userhost-in-= names")) + +((cap-end 10 "CAP END") + (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network te= ster") + (0 ":irc.example.org 002 tester :Your host is irc.example.org") + (0 ":irc.example.org 003 tester :This server was created just now") + (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv= Iabehkloqv") + (0 ":irc.example.org 005 tester MODES NETWORK=3DExampleOrg NICKLEN=3D32 P= REFIX=3D(qaohv)~&@%+ :are supported by this server") + (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 s= erver(s)") + (0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0 ":irc.example.org 253 tester 0 :unregistered connections") + (0 ":irc.example.org 254 tester 1 :channels formed") + (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.example.org 221 tester +Zi")) + +((join-chan 10 "JOIN #chan") + (0.1 ":tester!~tester@localhost JOIN #chan") + (0.0 ":irc.example.org 353 tester =3D #chan :[email protected] @%= [email protected] tester!~tester@localhost") + (0.0 ":irc.example.org 366 tester #chan :End of NAMES list")) + +((~mode-chan 10 "MODE #chan") + (0 ":irc.foonet.org 324 tester #chan +nt") + (0 ":irc.foonet.org 329 tester #chan 1619593200") + (0 ":[email protected] PRIVMSG #chan :hey")) + +((join-spam 10 "JOIN #spam") + (0.1 ":tester!~tester@localhost JOIN #spam") + (0.0 ":irc.example.org 353 tester =3D #spam :NCmRkf0fr Fureol UnbF tnpxf = Pvrpubz EbuvgF5612 Gboov s0erfg qrcrpur @Pehvpxl +SnypbaFcl CbjnOnatn @Fbep= rere ~@Q qvfp @F @T svmv Xunvqn GungYhexre bf|julm Tnabax Natrym qraavf| Fv= pnevhf sernxll85 XreilA538 +Ibebabv sbnzl pngryvln- @Fnghea +zrro @iyvrqry = [Q-Pbl]Nqnz tnmol MG +Uvqqra Qravn Fhpul ^_^ Qravn- fzbxr___ nagbvar Cvg Av= XnA fBqNtvEY_ PurrfrFbqnChapu Fgej Ybeq255 @XvyynU YnqlCrneynpr QnfOenva Fh= agbc Lbevpx_ Avxlevn JneCvtf PbzchgreGrpu") + (0.0 ":irc.example.org 353 tester =3D #spam :znm nrovna zntznhf3 ubsszna-= @D @fuebhq +fyht Sryrabi rivgn Cnenobyvn pp ZvYYvLrgPUv Qvqqy _pp Oynpx6Pe= bj xvenan Gvzbgrhf ryrzragny_ fglyr pbbyqhqr Lbevpx Xbentt _XnfmcvE_ fnoh f= gribb [OmF]5cUvAkK +Qrzc Cbeeb mollitia repellendus iusto Nihil asperiores = aliquid dolorum blanditiis excepturi magni praesentium quibusdam officiis v= eritatis facilis eaque temporibus numquam Sequi ipsum quidem pariatur liber= o architecto perferendis occaecati minus") + (0.0 ":irc.example.org 353 tester =3D #spam :harum deserunt corporis aspe= rnatur deleniti Delectus maiores omnis alias voluptate laudantium magnam do= lorem itaque dolor veniam Voluptas Neque consequatur accusantium tempora ve= lit Natus laborum ipsam necessitatibus nostrum recusandae molestiae suscipi= t dignissimos Quisquam incidunt quis dolores laboriosam Corrupti voluptatem= molestias fugit voluptatibus tempore Consequuntur aNgELO FItZWALTER keEPer= ANtENor FaNg bIOndeLlO HERmIa dUMAinE") + (0.0 ":irc.example.org 353 tester =3D #spam :FauLCONBRIDGe aPOtHeCary COB= web bOURBon BAsSiAnUs CONsTabLE hUBERT aUdREy DarDAnIuS aNtIpHOLus ESCANes = ARtHUr sLEnDER CLAUdio GuIlDeNStERn dOnalbAIN cAssAndra GaLLus GArDiNEr anG= elica BaSseT ePILOgue EroS CoRnWaLL DaVy HumpHrEy corNeliuS BrItain CapHIS = ISABeLLA BOTTOM heCatE GriFFith flOrEnCE aRChIdAmUS derceTuS GuArD ArtEmIDO= RuS BoaTswAIn AemIlius heNRY joHn CiCero demetriUS FAstOLFE CHArMIan HosTeS= s AntIGOnUS foRtInbraS GrEY bUllEN") + (0.0 ":irc.example.org 353 tester =3D #spam :HeRalD boy BAssanIO cAmilLo = brAbaNTio GUArdsmaN gARdENeR DROMIO aEdiles CaPUTiUs hoRaTIo HOrneR Iden cL= Own ARAGON dOGBeRRy BaNQUo gaOLEr huntInGDon JuNO CORin cLaUdius CuRIo Cost= ARD CoLEvILlE gErAlD bUTcHEr HERMioNe PoLYDOre dOLabellA JAILer hoRtensiuS = bErTrAm CasSiO piers GOvErNOr graNDpRE caPtAIN EdWard GLEndOwEr CHAThaM eph= eSus FatheR AGUEchEeK hUGh hYmEN JUliUs GoWER AlbANY doCtOr aNNE AufiDiUs g= onZaLO hErBert bARnarDINE ARcHbiSHop") + (0.0 ":irc.example.org 353 tester =3D #spam :BIGOt CAdE gaDshIll armADo F= LEanCe BlANchE JulieT DiOMedeS cOnstancE caRDiNal cLeRK bORAchio DUchEsS cu= RAN SiMOn FLUTE CATEsby agamEMnON HElEnA HarCoURT JOAN JAne QUEeN dIANa caT= liNg AmieNs ChAtIllIon abErGAVeNny JamES gremiO crAb CAItHneSS bUTTs bRaNDo= N GENtLEmaN dAUGHTer dEnny adaM FLAMIniUS CaMbRIDGe cUrTiS FreDERicK BErKel= EY jULia JoSePh BRaCkeNBURY fRancIscA CoUrTeSAn CarlisLE FEnTOn AUVErgne we= StMInsTer GaRgraVe Minola hEro OwEN") + (0.0 ":irc.example.org 353 tester =3D #spam :mEtELLUS aNGuS caSca HARrY k= AtHeRIne glouCEsteR ADRiAN dionYZA coUNt BouLT AutOlyCUS cASsiUs grAvEdiGge= R BUSHy arRaGon ARVIRagus cLEoMIneS FALSTAfF GobBO emMaNUel iRAS CITIZeN cA= Dwal ClituS bOUrCHIER alARbUs ChaNcELloR cAlPHuRniA eLbow franciS CAmpEIUS = derBY Jamy aLICe DOrcaS FeEBLe DOugLAs BeneDIck SICIniuS GRuMIO aMbASSAdor = EDMUND adRiAno aPeMAnTus AUMerLe grEgoRY chriSTopHER HeleNus ciMBer berOwne= ANdrew GlANSDAlE fABian ANThoNy") + (0.0 ":irc.example.org 353 tester =3D #spam :cLeon FErDinaND jaqUES FLOrI= zeL FrOTh eleanOr FlaViUs hume DOn clarEncE bagot haRRy HolOfERNes mAtthEw = GENTlEwoMAN Iago adRIaNa ChIRoN egEON BUrguNdY BaPtIsTA jEssiCA CERES ChOru= s TEArSheEt AleXAs cOrIOLanUS enobaRBUs HOSt Boyet dUKe nIck ANdRoMacHE dau= PhIn fluELLeN BolinGbrOkE eScaLUs dECiUS DEBoys girl eARL FRanCIs DORSet Ve= lUTuS stANLey bLUNT cANtERbURy EDGar DiCk CelIA AnTiOchus CoRdeliA anDronIc= US gArTer HAstinGS EGLAMOur DenniS") + (0.0 ":irc.example.org 353 tester =3D #spam :ELY DUkE hELEN GUIlDFOrd fRI= aR IRiS gURNEY cHArLes GOUgh BeLcH fRaNce AaRON erPInGHaM eXTon CAPUleT hel= icAnuS aeMeLiA EXeteR") + ;; These have logins and hostnames + (0.0 ":irc.example.org 353 tester =3D #spam :[email protected] TRUST!= ~trus@xsx/dvdovt/nzhjz ecstatic!~ecstatic@196-99-4-98 gallant!gallant@xsx/p= vtson/qzomnjm") + (0.0 ":irc.example.org 353 tester =3D #spam :tester!~tester@localhost REL= AX!~relax@unmxxzqzmhvj/jvvno/ooh/xsooh focused-ne!~focuse@dykosh/qvmjvt/otg= zndpqsY") + (0.0 ":irc.example.org 353 tester =3D #spam :@[email protected] SHA!= [email protected]") + (0.0 ":irc.example.org 366 tester #spam :End of NAMES list")) + +((mode-spam 10 "MODE #spam") + (0 ":irc.foonet.org 324 tester #spam +nt") + (0 ":irc.foonet.org 329 tester #spam 1619593200")) diff --git a/test/lisp/erc/resources/v3/whox/basic.eld b/test/lisp/erc/reso= urces/v3/whox/basic.eld new file mode 100644 index 00000000000..397bb7cccbf --- /dev/null +++ b/test/lisp/erc/resources/v3/whox/basic.eld @@ -0,0 +1,85 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag batch cap-notify echo-messa= ge extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNAL server-tim= e") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names") + ;; Ensure SASL handlers don't fire when we haven't enabled SASL + (0.1 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 903 * :Authentication successful")) + +((cap-req 3.19 "CAP REQ :cap-notify echo-message extended-join message-tag= s multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join server-time echo-message")) + +((cap-end 3.21 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Fri, 30 Jul 2021 08:19:35 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 4= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local users= 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global user= s 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug 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.")) + +((join-chan 28.07 "JOIN #chan") + (0.02 "@msgid=3Dusc2rfuyc5mvi637awz2s5s58w;time=3D" now ";account=3Dteste= r :[email protected] JOIN #chan tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] @ChanS= erv [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now " :soju.im 332 tester #chan :Chan - Some channel | i= nstall: www.example.com/install | source: www.example.com/repositories | fr= ee stickers: https://example.com/6uEMkD | help us: www.example.com/todo | m= ailing list: https://lists.example.com/mailman/listinfo") + (0.00 "@time=3D" now " :soju.im 333 tester #chan [email protected]= 1623754902")) + +((join-spam 10 "JOIN #spam") + (0.02 "@msgid=3Dusc2rfuyc5mvi637awz2s5s58w;time=3D" now ";account=3Dteste= r :[email protected] JOIN #spam tester tester") + (0.00 "@time=3D" now " :irc.foonet.org 353 tester =3D #spam :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] fool!~u= @24rqshnawe9w4.irc") + (0.00 "@time=3D" now " :irc.foonet.org 366 tester #spam :End of NAMES lis= t")) + +((mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dz9w6983p4acgcdrr4n4vaxuk4a = :[email protected] PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwgmypkcvxk2yieuuhapgq3n23a :b= [email protected] PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627633175")) + +((mode-spam 10 "MODE #spam") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3Dm9j6983c4nptpqee4a4inkhx4n :j= [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Djtzlcxpikx2lvrhhunctd3a23n := [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #spam +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #spam 1627633175") + + (0.0 "@time=3D" now " :[email protected] NOTICE teste= r :[#chan] Welcome! If you are experiencing problems with getting this to w= ork, and you are using GNU Linux, please see the following link to obtain s= ome useful troubleshooting information: https://example.com/inA0bbQf") + + (0.3 "@time=3D" now ";account=3Dbob;msgid=3Dzt3jsscdawv9am42sjmakh3tsa :b= [email protected] PRIVMSG #chan :alice: For the Lord's tokens on you = do I see.") + (0.3 "@time=3D" now ";account=3Dalice;msgid=3D66ankiwmfdmfpb8ve4npywrrhe = :[email protected] PRIVMSG #chan :bob: Or say, sweet love, what th= ou desir'st to eat.") + (0.2 "@account=3Dbob;msgid=3Ddvipjy2385ngjinb3ti5dp4m8w;time=3D" now " :b= [email protected] PRIVMSG #chan :alice: For I ne'er saw true beauty t= ill this night.") + (0.7 "@msgid=3Dyvrvi7icv4uf2n7eqybd5vm8ye;time=3D" now ";account=3Dalice = :[email protected] PRIVMSG #chan :bob: His leather skin and horns = to wear.") + (0.2 "@time=3D" now ";account=3Dbob;msgid=3Dmjbaj3d96qg62mgs57ninrk6ae :b= [email protected] PRIVMSG #chan :alice: Every letter he hath writ hat= h disvouched other.") + (0.1 "@account=3Dalice;msgid=3Duifkmta383cxfr4m35z9683rww;time=3D" now " = :[email protected] PRIVMSG #chan :bob: The more I have, for both a= re infinite.")) + +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ChanServ service= s.foonet.org ChanServ H@ 0 0 :Channel Services") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc fool H 62 0 fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dpzisncnmb34ty67wfzzrz833ye :b= [email protected] PRIVMSG #chan :alice: With him! why, 'tis not possi= ble.")) + +((who-spam 10 "WHO #spam %tcuhnflar,2") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u u89c2b39vyqt6= .irc mike H@r 0 mike :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u u89c2b39vyqt6= .irc joe Hr 0 joe :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u 24rqshnawe9w4= .irc fool H 62 0 fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #spam :End of WHO list") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Dmg3wffpqnji9nz42fwznxu3gfn := [email protected] PRIVMSG #spam :joe: All that he is hath reference= to your highness.") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3D66naxvjzsqzsco8ir4acljeeur :j= [email protected] PRIVMSG #spam :mike: Excellent workman! Thou canst = not paint a man so bad as is thyself.")) diff --git a/test/lisp/erc/resources/v3/whox/rate-limited.eld b/test/lisp/e= rc/resources/v3/whox/rate-limited.eld new file mode 100644 index 00000000000..1994c05b5db --- /dev/null +++ b/test/lisp/erc/resources/v3/whox/rate-limited.eld @@ -0,0 +1,136 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag batch cap-notify echo-messa= ge extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNAL server-tim= e") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names")) + +((cap-req 3.19 "CAP REQ :cap-notify echo-message extended-join message-tag= s multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join server-time echo-message")) + +((cap-end 3.21 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Fri, 30 Jul 2021 08:19:35 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 4= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local users= 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global user= s 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug 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.")) + +((join-chan 10 "JOIN #chan")) +((join-foo 10 "JOIN #foo")) +((join-bar 10 "JOIN #bar")) +((join-baz 10 "JOIN #baz")) + +((join-spam 10 "JOIN #spam") + (0.02 "@msgid=3Djoin-spam-1;time=3D" now ";account=3Dtester :tester!~u@24= rqshnawe9w4.irc JOIN #chan tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] chan_f= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + + (0.02 "@msgid=3Djoin-foo-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #foo tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #foo :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] foo_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #foo :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-bar-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #bar tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #bar :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] bar_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #bar :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-baz-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #baz tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #baz :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] baz_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #baz :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-spam-1;time=3D" now ";account=3Dtester :tester!~u@24= rqshnawe9w4.irc JOIN #spam tester tester") + (0.00 "@time=3D" now " :irc.foonet.org 353 tester =3D #spam :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] spam_fo= [email protected]") + (0.00 "@time=3D" now " :irc.foonet.org 366 tester #spam :End of NAMES lis= t")) + +((~mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-chan-1 :alice!~u@u89c2= b39vyqt6.irc PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-chan-2 :bob!~u@u89c2b39v= yqt6.irc PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627633175")) + +((~mode-foo 10 "MODE #foo") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-foo-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #foo :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-foo-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #foo :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #foo +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #foo 1627633175")) + +((~mode-bar 10 "MODE #bar") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-bar-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #bar :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-bar-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #bar :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #bar +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #bar 1627633175")) + +((~mode-baz 10 "MODE #baz") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-baz-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #baz :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-baz-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #baz :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #baz +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #baz 1627633175")) + +((~mode-spam 10 "MODE #spam") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3Dm9j6983c4nptpqee4a4inkhx4n :j= [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Djtzlcxpikx2lvrhhunctd3a23n := [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #spam +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #spam 1627633175")) + +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc chan_fool H 62 0 :Chan Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwho-chan-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #chan :alice: For the Lord's tokens on you do I see.") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dwho-chan-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #chan :bob: Or say, sweet love, what thou desir'st to e= at.")) + +((who-foo 10 "WHO #foo %tcuhnflar,2") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u 24rqshnawe9w4.= irc foo_fool H 62 0 :Foo Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #foo :End of WHO list") + (0.0 "@account=3Dbob;msgid=3Dwho-foo-1;time=3D" now " :bob!~u@u89c2b39vyq= t6.irc PRIVMSG #foo :alice: For I ne'er saw true beauty till this night.") + (0.0 "@msgid=3Dwho-foo-2;time=3D" now ";account=3Dalice :alice!~u@u89c2b3= 9vyqt6.irc PRIVMSG #foo :bob: His leather skin and horns to wear.")) + +((who-bar 10 "WHO #bar %tcuhnflar,3") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u 24rqshnawe9w4.= irc bar_fool H 62 0 :Bar Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #bar :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwho-bar-1 :bob!~u@u89c2b39vyq= t6.irc PRIVMSG #bar :alice: Every letter he hath writ hath disvouched other= .") + (0.0 "@account=3Dalice;msgid=3Dwho-bar-2;time=3D" now " :alice!~u@u89c2b3= 9vyqt6.irc PRIVMSG #bar :bob: The more I have, for both are infinite.")) + +;; Server rejects this request. +((who-baz 10 "WHO #baz %tcuhnflar,4") + (0.0 "@time=3D" now " :irc.foonet.org 263 neverwas WHO :This command coul= d not be completed because it has been used recently, and is rate-limited.") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester * :End of /WHO list")) + +((who-baz-again 20 "WHO #baz %tcuhnflar,4") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u 24rqshnawe9w4.= irc baz_fool H 62 0 :Baz Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #baz :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dpzisncnmb34ty67wfzzrz833ye :b= [email protected] PRIVMSG #baz :alice: With him! why, 'tis not possib= le.")) + +((who-spam 10 "WHO #spam %tcuhnflar,5") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u u89c2b39vyqt6= .irc mike H@r 0 mike :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u u89c2b39vyqt6= .irc joe Hr 0 joe :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u 24rqshnawe9w4= .irc spam_fool H 62 0 :Spam Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #spam :End of WHO list") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Dmg3wffpqnji9nz42fwznxu3gfn := [email protected] PRIVMSG #spam :joe: All that he is hath reference= to your highness.") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3D66naxvjzsqzsco8ir4acljeeur :j= [email protected] PRIVMSG #spam :mike: Excellent workman! Thou canst = not paint a man so bad as is thyself.")) --=20 2.51.0 --=-=-=--