>From f70e892a5457e48871bf0b817a8f017a8492318a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 1 May 2023 20:33:33 -0700 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Don't send multiline slash commands as msgs in ERC [5.6] Redo line splitting for outgoing messages in ERC [5.6] Preprocess prompt input linewise in ERC etc/ERC-NEWS | 6 + lisp/erc/erc-backend.el | 41 ++++ lisp/erc/erc-common.el | 14 +- lisp/erc/erc-goodies.el | 5 +- lisp/erc/erc-ring.el | 4 +- lisp/erc/erc.el | 195 ++++++++++++----- .../lisp/erc/erc-scenarios-base-split-line.el | 202 ++++++++++++++++++ test/lisp/erc/erc-tests.el | 167 +++++++++++++-- test/lisp/erc/resources/base/flood/ascii.eld | 49 +++++ test/lisp/erc/resources/base/flood/koi8-r.eld | 47 ++++ test/lisp/erc/resources/base/flood/utf-8.eld | 54 +++++ test/lisp/erc/resources/erc-d/erc-d.el | 2 +- 12 files changed, 710 insertions(+), 76 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-split-line.el create mode 100644 test/lisp/erc/resources/base/flood/ascii.eld create mode 100644 test/lisp/erc/resources/base/flood/koi8-r.eld create mode 100644 test/lisp/erc/resources/base/flood/utf-8.eld Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 8f1b89f268b..e34a7ac1c78 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -170,6 +170,12 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Input splitting now happens before 'erc-pre-send-functions' runs. +Hook members are now treated to input whose lines have already been +adjusted to fall within the allowed length limit. For convenience, +third-party code can request that the final input be "re-filled" prior +to being sent. See doc string for details. + *** ERC's prompt survives the insertion of user input and messages. Previously, ERC's prompt and its input marker disappeared while running hooks during message insertion, and the position of its diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 6c015c71ff9..dd803b45d61 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -30,8 +30,10 @@ erc--casemapping-rfc1459 (defvar erc--casemapping-rfc1459-strict) (defvar erc-channel-users) (defvar erc-dbuf) +(defvar erc-insert-this) (defvar erc-log-p) (defvar erc-modules) +(defvar erc-send-this) (defvar erc-server-users) (defvar erc-session-server) @@ -45,10 +47,14 @@ erc-session-server (declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input - string insertp sendp) - -(cl-defstruct (erc--input-split (:include erc-input)) - lines cmdp) + string insertp sendp refoldp) + +(cl-defstruct (erc--input-split (:include erc-input + (string :read-only) + (insertp erc-insert-this) + (sendp erc-send-this))) + (lines nil :type (list-of string)) + (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) ;; User data diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6235de5f1c0..cc60ba0018b 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -338,8 +338,9 @@ noncommands "This mode distinguishes non-commands. Commands listed in `erc-insert-this' know how to display themselves." - ((add-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands)) - ((remove-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands))) + ((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands)) + ((remove-hook 'erc--input-review-functions + #'erc-send-distinguish-noncommands))) (defun erc-send-distinguish-noncommands (state) "If STR is an ERC non-command, set `insertp' in STATE to nil." diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 2451ac56f6f..4534e913204 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -46,10 +46,10 @@ erc-ring (define-erc-module ring nil "Stores input in a ring so that previous commands and messages can be recalled using M-p and M-n." - ((add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((add-hook 'erc--input-review-functions #'erc-add-to-input-ring 90) (define-key erc-mode-map "\M-p" #'erc-previous-command) (define-key erc-mode-map "\M-n" #'erc-next-command)) - ((remove-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((remove-hook 'erc--input-review-functions #'erc-add-to-input-ring) (define-key erc-mode-map "\M-p" #'undefined) (define-key erc-mode-map "\M-n" #'undefined))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8e3625e72f5..e80cd350c38 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -907,6 +907,9 @@ erc-flood-protect short of an interval, which may cause the server to terminate the connection. +Note that older code conflated rate limiting and line splitting. +Starting in ERC 5.6, this option no longer influences the latter. + See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters @@ -1089,34 +1092,40 @@ erc-pre-send-functions `string': The current input string. `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server." + `sendp': Whether the string should be sent to the irc server. + `refoldp': Whether the string should be re-split per protocol limits. + +This hook runs after protocol line splitting has taken place, so +the value of `string' is originally \"pre-filled\". If you need +ERC to refill the entire payload before sending it, set the +`refoldp' slot to a non-nil value. Preformatted text and encoded +subprotocols should probably be handled manually." :group 'erc :type 'hook :version "27.1") -;; This is being auditioned for possible exporting (as a custom hook -;; option). Likewise for (public versions of) `erc--input-split' and -;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just -;; run the latter on the input after `erc-pre-send-functions', and -;; remove this hook and the struct completely. IOW, if you need this, -;; please say so. - -(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls - erc--split-lines) - "Special hook for modifying individual lines in multiline prompt input. -The functions are called with one argument, an `erc--input-split' -struct, which they can optionally modify. +(define-obsolete-variable-alias 'erc--pre-send-split-functions + 'erc--input-review-functions "30.1") +(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls + erc--split-lines + erc--run-input-validation-checks) + "Special hook for reviewing and modifying prompt input. +ERC runs this before clearing the prompt and before running any +send-related hooks, such as `erc-pre-send-functions'. Thus, it's +quite \"safe\" to bail out of this hook with a `user-error', if +necessary. The hook's members are called with one argument, an +`erc--input-split' struct, which they can optionally modify. The struct has five slots: - `string': the input string delivered by `erc-pre-send-functions' - `insertp': whether to insert the lines into the buffer - `sendp': whether the lines should be sent to the IRC server + `string': the original input as a read-only reference + `insertp': same as in `erc-pre-send-functions' + `sendp': same as in `erc-pre-send-functions' + `refoldp': same as in `erc-pre-send-functions' `lines': a list of lines to be sent, each one a `string' `cmdp': whether to interpret input as a command, like /ignore -The `string' field is effectively read-only. When `cmdp' is -non-nil, all but the first line will be discarded.") +When `cmdp' is non-nil, all but the first line will be discarded.") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -1158,8 +1167,8 @@ erc-insert-done-hook (defcustom erc-send-modify-hook nil "Sending hook for functions that will change the text's appearance. -This hook is called just after `erc-send-pre-hook' when the values -of `erc-send-this' and `erc-insert-this' are both t. +ERC runs this just after `erc-pre-send-functions' if its shared +`erc-input' object's `sendp' and `insertp' slots remain non-nil. While this hook is run, narrowing is in effect and `current-buffer' is the buffer where the text got inserted. @@ -6026,16 +6035,18 @@ erc--blank-in-multiline-input-p (defun erc--check-prompt-input-for-excess-lines (_ lines) "Return non-nil when trying to send too many LINES." (when erc-inhibit-multiline-input - ;; Assume `erc--discard-trailing-multiline-nulls' is set to run - (let ((reversed (seq-drop-while #'string-empty-p (reverse lines))) - (max (if (eq erc-inhibit-multiline-input t) + (let ((max (if (eq erc-inhibit-multiline-input t) 2 erc-inhibit-multiline-input)) (seen 0) - msg) - (while (and (pop reversed) (< (cl-incf seen) max))) + last msg) + (while (and lines (setq last (pop lines)) (< (cl-incf seen) max))) (when (= seen max) - (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (push last lines) + (setq msg + (format "-- exceeded by %d (%d chars)" + (length lines) + (apply #'+ (mapcar #'length lines)))) (unless (and erc-ask-about-multiline-input (y-or-n-p (concat "Send input " msg "?"))) (concat "Too many lines " msg)))))) @@ -6075,7 +6086,17 @@ erc--check-prompt-input-functions Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns non-nil, processing is abandoned and input is left untouched. -When the returned value is a string, pass it to `erc-error'.") +When the returned value is a string, ERC passes it to `erc-error'.") + +(defun erc--run-input-validation-checks (state) + "Run input checkers from STATE, an `erc--input-split' object." + (when-let ((msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (unless (stringp msg) + (setq msg (format "Input error: %S" msg))) + (user-error msg))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6090,12 +6111,15 @@ erc-send-current-line (eolp)) (expand-abbrev)) (widen) - (if-let* ((str (erc-user-input)) - (msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions str - (split-string str erc--input-line-delim-regexp)))) - (when (stringp msg) - (erc-error msg)) + (let* ((str (erc-user-input)) + (state (make-erc--input-split + :string str + :insertp erc-insert-this + :sendp erc-send-this + :lines (split-string + str erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp str)))) + (run-hook-with-args 'erc--input-review-functions state) (let ((inhibit-read-only t) (old-buf (current-buffer))) (progn ; unprogn this during next major surgery @@ -6103,7 +6127,7 @@ erc-send-current-line ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) (unwind-protect - (erc-send-input str 'skip-ws-chk) + (erc--send-input-lines (erc--run-send-hooks state)) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf @@ -6136,11 +6160,59 @@ erc--discard-trailing-multiline-nulls (setf (erc--input-split-lines state) (nreverse reversed))))) (defun erc--split-lines (state) - "Partition input lines when flood protection is enabled." - (when (and erc-flood-protect (not (erc--input-split-cmdp state))) + "Partition non-command input into lines of protocol-compliant length." + ;; Prior to ERC 5.6, line splitting used to be predicated on + ;; `erc-flood-protect' being non-nil. + (unless (erc--input-split-cmdp state) (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) +(defun erc--run-send-hooks (lines-obj) + "Run send-related hooks that operate on the entire prompt input. +Sequester some of the back and forth involved in honoring old +interfaces, such as the reconstituting and re-splitting of +multiline input. Optionally readjust lines to protocol length +limits and pad empty ones, knowing full well that additional +processing may still corrupt messages before they reach the send +queue. Expect LINES-OBJ to be an `erc--input-split' object." + (when (or erc-send-pre-hook erc-pre-send-functions) + (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) + (defvar str) ; see note in string `erc-send-input'. + (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) + (erc-send-this (erc--input-split-sendp lines-obj)) + (erc-insert-this (erc--input-split-insertp lines-obj)) + (state (progn + ;; This may change `str' and `erc-*-this'. + (run-hook-with-args 'erc-send-pre-hook str) + (make-erc-input :string str + :insertp erc-insert-this + :sendp erc-send-this)))) + (run-hook-with-args 'erc-pre-send-functions state) + (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) + (erc--input-split-insertp lines-obj) (erc-input-insertp state) + ;; See note in test of same name re trailing newlines. + (erc--input-split-lines lines-obj) + (cl-nsubst " " "" (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :test #'equal)) + (when (erc-input-refoldp state) + (erc--split-lines lines-obj))))) + (when (and (erc--input-split-cmdp lines-obj) + (cdr (erc--input-split-lines lines-obj))) + (user-error "Multiline command detected" )) + lines-obj) + +(defun erc--send-input-lines (lines-obj) + "Send lines in `erc--input-split-lines' object LINES-OBJ." + (when (erc--input-split-sendp lines-obj) + (dolist (line (erc--input-split-lines lines-obj)) + (unless (erc--input-split-cmdp lines-obj) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line))) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj)))))) + (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. @@ -6171,26 +6243,27 @@ erc-send-input :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) - (setq state (make-erc--input-split - :string (erc-input-string state) - :insertp (erc-input-insertp state) - :sendp (erc-input-sendp state) - :lines (split-string (erc-input-string state) - erc--input-line-delim-regexp) - :cmdp (string-match erc-command-regexp - (erc-input-string state)))) - (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) erc-send-this) - (dolist (line (erc--input-split-lines state)) - (if (erc--input-split-cmdp state) - (cl-assert (not (cdr (erc--input-split-lines state)))) - (when (erc-input-insertp state) - (erc-display-msg line))) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) - (not (erc--input-split-cmdp state)))) - t)))) + (if-let* ((first (split-string (erc-input-string state) + erc--input-line-delim-regexp)) + (split (mapcan #'erc--split-line first)) + (lines (nreverse (seq-drop-while #'string-empty-p + (nreverse split)))) + ((string-match erc-command-regexp (car lines)))) + (progn + ;; Asking users what to do here might make more sense. + (cl-assert (not (cdr lines))) + ;; The `force' arg (here t) is ignored for command lines. + (erc-process-input-line (concat (car lines) "\n") t nil)) + (progn ; temporarily preserve indentation + (dolist (line lines) + (progn ; temporarily preserve indentation + (when (erc-input-insertp state) + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)))) + t))))) (defun erc-display-msg (line) "Display LINE as a message of the user to the current target at point." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index bb36adf3393..e788dd8031d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -942,8 +942,8 @@ erc-ring-previous-command (should-not (local-variable-if-set-p 'erc-send-completed-hook)) (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on - (setq-local erc-pre-send-functions nil) - (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + (setq-local erc--input-review-functions nil) + (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) (lambda (&rest _) @@ -1156,7 +1156,9 @@ erc--blank-in-multiline-input-p (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") - (let* ((erc-pre-send-functions + (let* ((erc--input-review-functions + (remove #'erc-add-to-input-ring erc--input-review-functions)) + (erc-pre-send-functions (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now (inhibit-message noninteractive) (erc-server-current-nick "tester") @@ -1223,9 +1225,9 @@ erc-send-current-line (ert-info ("Input cleared") (erc-bol) (should (eq (point) (point-max)))) - ;; The flood argument is irrelevant here because it can't + ;; The `force' argument is irrelevant here because it can't ;; influence dispatched handlers, such as `erc-cmd-MSG'. - (should (equal (funcall next) '("/msg #chan hi\n" nil nil)))) + (should (pcase (funcall next) (`("/msg #chan hi\n" ,_ nil) t)))) (ert-info ("Simple non-command") (insert "hi") @@ -1233,7 +1235,8 @@ erc-send-current-line (should (eq (point) (point-max))) (should (save-excursion (forward-line -1) (search-forward " hi"))) - ;; Non-ommands are forced only when `erc-flood-protect' is nil + ;; Non-commands are forced only when `erc-flood-protect' is + ;; nil, which conflates two orthogonal concerns. (should (equal (funcall next) '("hi\n" nil t)))) (should (consp erc-last-input-time))))) @@ -1285,12 +1288,13 @@ erc-send-whitespace-lines (erc-bol) (should (eq (point) (point-max))) (while q - (should (equal (funcall next) (list (pop q) nil nil)))) + (should (pcase (funcall next) + (`(,cmd ,_ nil) (equal cmd (pop q)))))) (should-not (funcall next)))) - (ert-info ("Multiline non-command with trailing blank errors") + (ert-info ("Multiline command with non-blanks errors") (dolist (p '("/a b\nc\n\n" "/a b\n/c\n\n" "/a b\n\nc\n\n" - "/a\n c\n" "/a \n \n")) + "/a\n c\n" "/a\nb\n" "/a\n/b\n" "/a \n \n")) (insert p) (should-error (erc-send-current-line)) (goto-char erc-input-marker) @@ -1312,13 +1316,14 @@ erc--check-prompt-input-for-excess-lines (ert-info ("With `erc-inhibit-multiline-input' as t (2)") (let ((erc-inhibit-multiline-input t)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" ""))) + ;; Does not trim trailing blanks. + (should (erc--check-prompt-input-for-excess-lines "" '("a" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (ert-info ("With `erc-inhibit-multiline-input' as 3") (let ((erc-inhibit-multiline-input 3)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "c"))))) (ert-info ("With `erc-ask-about-multiline-input'") @@ -1399,6 +1404,94 @@ erc-process-input-line (should-not calls)))))) + +;; The behavior of `erc-pre-send-functions' differs between versions +;; in how hook members see and influence a trailing newline that's +;; part of the original prompt submission: +;; +;; 5.4: both seen and sent +;; 5.5: seen but not sent* +;; 5.6: neither seen nor sent* +;; +;; * requires `erc-send-whitespace-lines' for hook to run +;; +;; Two aspects that have remained consistent are +;; +;; - a final nonempty line in any submission is always sent +;; - a trailing newline appended by a hook member is always sent +;; +;; The last bullet would seem to contradict the "not sent" behavior of +;; 5.5 and 5.6, but what's actually happening is that exactly one +;; trailing newline is culled, so anything added always goes through. +;; Also, in ERC 5.6, all empty lines are actually padded, but this is +;; merely incidental WRT the above. +;; +;; Note that this test doesn't run any input-prep hooks and thus can't +;; account for the "seen" dimension noted above. + +(ert-deftest erc--run-send-hooks () + (with-suppressed-warnings ((obsolete erc-send-this) + (obsolete erc-send-pre-hook)) + (should erc-insert-this) + (should erc-send-this) ; populates `erc--input-split-sendp' + + (let (erc-pre-send-functions erc-send-pre-hook) + + (ert-info ("String preserved, lines rewritten, empties padded") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "bar\n\nbaz\n"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("bar" " " "baz" " ")) (cmdp 'nil)) + t)))) + + (ert-info ("Multiline commands rejected") + (should-error (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)))) + + (ert-info ("Single-line commands pass") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-sendp o) nil + (erc-input-string o) "/mycmd bar"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)) + ((cl-struct erc--input-split + (string "/mycmd foo") (sendp 'nil) (insertp 't) + (lines '("/mycmd bar")) (cmdp 't)) + t)))) + + (ert-info ("Legacy hook respected, special vars confined") + (setq erc-send-pre-hook (lambda (_) (setq erc-send-this nil)) + erc-pre-send-functions (lambda (o) ; propagates + (should-not (erc-input-sendp o)))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 'nil) (insertp 't) + (lines '("foo")) (cmdp 'nil)) + t))) + (should erc-send-this)) + + (ert-info ("Request to resplit honored") + (setq erc-send-pre-hook nil + erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "foo bar baz" + (erc-input-refoldp o) t))) + (let ((erc-split-line-length 8)) + (should + (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("foo bar " "baz")) (cmdp 'nil)) + t)))))))) + ;; Note: if adding an erc-backend-tests.el, please relocate this there. (ert-deftest erc-message () -- 2.40.0