>From bb190883389de0bdcdfa39bfdbb5d8953bf115fd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 27 Apr 2022 04:33:06 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): Fix regression in erc-send-input-line Add some ERC test helpers Improve ERC's handling of multiline prompt input Optionally prevent sending multiline input in ERC lisp/erc/erc.el | 195 ++++++++++++++++++++++------ test/lisp/erc/erc-tests.el | 259 +++++++++++++++++++++++++++++++++++-- 2 files changed, 402 insertions(+), 52 deletions(-) Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 472c103ee4..8e96dd30c4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -224,6 +224,20 @@ erc-send-whitespace-lines :group 'erc :type 'boolean) +(defcustom erc-inhibit-multiline-input nil + "Conditionally disallow input consisting of multiple lines. +Issue an error when the number of input lines submitted for sending +exceeds this value." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type '(choice integer boolean)) + +(defcustom erc-ask-about-multiline-input nil + "Ask to ignore `erc-inhibit-multiline-input' when tripped." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type 'boolean) + (defcustom erc-hide-prompt nil "If non-nil, do not display the prompt for commands. @@ -1054,10 +1068,16 @@ erc-pre-send-functions :type 'hook :version "27.1") -(defcustom erc-pre-send-split-functions '(erc-discard-trailing-multiline-nulls) +;; This is being auditioned for possible exporting (as a custom +;; 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. + +(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls) "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. +The functions are called with one argument, an `erc--input-split' +struct, which they can optionally modify. The struct has five slots: @@ -1068,10 +1088,7 @@ erc-pre-send-split-functions `cmdp': Whether to interpret the 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." - :group 'erc - :type 'hook - :package-version '(ERC . "5.4.1")) +all but the first line will be discarded.") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -5573,61 +5590,77 @@ erc-accidental-paste-threshold-seconds (defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r))) -(defun erc--blank-in-multiline-input-p (string) - "Detect whether STRING contains any blank lines. -When `erc-send-whitespace-lines' is in effect, return nil if the input -is multiline or the line is non-empty. When `erc-send-whitespace-lines' -is nil, return non-nil when any line is empty or consists of one or more +(defun erc--blank-in-multiline-input-p (lines) + "Detect whether LINES contains a blank line. +When `erc-send-whitespace-lines' is in effect, return nil if LINES is +multiline or the first non-empty. When `erc-send-whitespace-lines' is +nil, return non-nil when any line is empty or consists of one or more spaces, tabs, or form-feeds." (catch 'return - (let ((lines (split-string string erc--input-line-delim-regexp))) + (let ((multilinep (cdr lines))) (dolist (line lines) (when (if erc-send-whitespace-lines - (and (string= line "") (null (cdr lines))) + (and (string-empty-p line) (not multilinep)) (string-match (rx bot (* (in " \t\f")) eot) line)) (throw 'return t)))))) -(defun erc-discard-trailing-multiline-nulls (state) +(defun erc--discard-trailing-multiline-nulls (state) "Ensure last line of `erc-input' STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil." (when erc-send-whitespace-lines (when (string-match "[\r\n]+\\'" (erc-input-string state)) - (setf (erc-input-split-lines state) + (setf (erc--input-split-lines state) (split-string (substring (erc-input-string state) 0 (match-beginning 0)) erc--input-line-delim-regexp) - (erc-input-split-cmdp state) nil)))) - -(defun erc-check-prompt-input-for-multiline-blanks (string) - "Return non-nil when multiline prompt input has blank lines." - (when (erc--blank-in-multiline-input-p string) + (erc--input-split-cmdp state) nil)))) + +(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) + 2 + erc-inhibit-multiline-input)) + (seen 0) + msg) + (while (and (pop reversed) (< (cl-incf seen) max))) + (when (= seen max) + (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (unless (and erc-ask-about-multiline-input + (y-or-n-p (concat "Send input " msg "?"))) + (concat "Too many lines " msg)))))) + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES." + (when (erc--blank-in-multiline-input-p lines) (if erc-warn-about-blank-lines "Blank line - ignoring..." 'invalid))) -(defun erc-check-prompt-input-for-point-in-bounds (_) +(defun erc--check-prompt-input-for-point-in-bounds (_ _) "Return non-nil when point is before prompt." (when (< (point) (erc-beg-of-input-line)) "Point is not in the input area")) -(defun erc-check-prompt-input-for-running-process (string) +(defun erc--check-prompt-input-for-running-process (string _) "Return non-nil unless in an active ERC server buffer." (unless (or (erc-server-buffer-live-p) (erc-command-no-process-p string)) "ERC: No process running")) -(defcustom erc-check-prompt-input-functions - '(erc-check-prompt-input-for-point-in-bounds - erc-check-prompt-input-for-multiline-blanks - erc-check-prompt-input-for-running-process) +(defvar erc--check-prompt-input-functions + '(erc--check-prompt-input-for-point-in-bounds + erc--check-prompt-input-for-multiline-blanks + erc--check-prompt-input-for-running-process + erc--check-prompt-input-for-excess-lines) "Validators for user input typed at prompt. -Called with latest input string submitted by user. If any member -returns non-nil, processing is abandoned and input is left untouched. -When the returned value is a string, pass it to `erc-error'." - :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA - :group 'erc - :type 'hook) +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'.") (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -5644,7 +5677,8 @@ erc-send-current-line (widen) (if-let* ((str (erc-user-input)) (msg (run-hook-with-args-until-success - 'erc-check-prompt-input-functions str))) + 'erc--check-prompt-input-functions str + (split-string str erc--input-line-delim-regexp)))) (when (stringp msg) (erc-error msg)) (let ((inhibit-read-only t) @@ -5688,7 +5722,7 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) -(cl-defstruct (erc-input-split (:include erc-input)) +(cl-defstruct (erc--input-split (:include erc-input)) lines cmdp) (defun erc-send-input (input &optional skip-ws-chk) @@ -5697,7 +5731,8 @@ erc-send-input Return non-nil only if we actually send anything." ;; Handle different kinds of inputs (if (and (not skip-ws-chk) - (erc-check-prompt-input-for-multiline-blanks input)) + (erc--check-prompt-input-for-multiline-blanks + input (split-string input erc--input-line-delim-regexp))) (when erc-warn-about-blank-lines (message "Blank line - ignoring...") ; compat (beep)) @@ -5720,7 +5755,7 @@ 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 + (setq state (make-erc--input-split :string (erc-input-string state) :insertp (erc-input-insertp state) :sendp (erc-input-sendp state) @@ -5728,11 +5763,11 @@ erc-send-input 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) + (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) erc-send-this) - (let ((lines (erc-input-split-lines state))) - (if (and (erc-input-split-cmdp state) (not (cdr lines))) + (let ((lines (erc--input-split-lines state))) + (if (and (erc--input-split-cmdp state) (not (cdr lines))) (erc-process-input-line (concat (car lines) "\n") t nil) (dolist (line lines) (dolist (line (or (and erc-flood-protect (erc-split-line line)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3746f4862e..fa39f4fcc6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -327,36 +327,41 @@ erc--input-line-delim-regexp (should (equal '("" "" "") (split-string "\n\r" p))))) (ert-deftest erc--blank-in-multiline-input-p () - (ert-info ("With `erc-send-whitespace-lines'") - (let ((erc-send-whitespace-lines t)) - (should (erc--blank-in-multiline-input-p "")) - (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd - (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed - (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd - (should-not (erc--blank-in-multiline-input-p " ")) - (should-not (erc--blank-in-multiline-input-p "\t")) - (should-not (erc--blank-in-multiline-input-p "a\nb")) - (should-not (erc--blank-in-multiline-input-p "a\n ")) - (should-not (erc--blank-in-multiline-input-p "a\n \t")) - (should-not (erc--blank-in-multiline-input-p "a\n \f")) - (should-not (erc--blank-in-multiline-input-p "a\n \nb")) - (should-not (erc--blank-in-multiline-input-p "a\n \t\nb")) - (should-not (erc--blank-in-multiline-input-p "a\n \f\nb")))) - - (should (erc--blank-in-multiline-input-p "")) - (should (erc--blank-in-multiline-input-p " ")) - (should (erc--blank-in-multiline-input-p "\t")) - (should (erc--blank-in-multiline-input-p "a\n\nb")) - (should (erc--blank-in-multiline-input-p "a\n\nb")) - (should (erc--blank-in-multiline-input-p "a\n ")) - (should (erc--blank-in-multiline-input-p "a\n \t")) - (should (erc--blank-in-multiline-input-p "a\n \f")) - (should (erc--blank-in-multiline-input-p "a\n \nb")) - (should (erc--blank-in-multiline-input-p "a\n \t\nb")) - - (should-not (erc--blank-in-multiline-input-p "a\rb")) - (should-not (erc--blank-in-multiline-input-p "a\nb")) - (should-not (erc--blank-in-multiline-input-p "a\r\nb"))) + (let ((check (lambda (s) + (erc--blank-in-multiline-input-p + (split-string s erc--input-line-delim-regexp))))) + + (ert-info ("With `erc-send-whitespace-lines'") + (let ((erc-send-whitespace-lines t)) + (should (funcall check "")) + (should-not (funcall check "\na")) + (should-not (funcall check "/msg a\n")) ; real /cmd + (should-not (funcall check "a\n\nb")) ; "" allowed + (should-not (funcall check "/msg a\n\nb")) ; non-/cmd + (should-not (funcall check " ")) + (should-not (funcall check "\t")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "a\n ")) + (should-not (funcall check "a\n \t")) + (should-not (funcall check "a\n \f")) + (should-not (funcall check "a\n \nb")) + (should-not (funcall check "a\n \t\nb")) + (should-not (funcall check "a\n \f\nb")))) + + (should (funcall check "")) + (should (funcall check " ")) + (should (funcall check "\t")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n ")) + (should (funcall check "a\n \t")) + (should (funcall check "a\n \f")) + (should (funcall check "a\n \nb")) + (should (funcall check "a\n \t\nb")) + + (should-not (funcall check "a\rb")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "a\r\nb")))) (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") @@ -376,7 +381,7 @@ erc-tests--with-process-input-spy (funcall test (lambda () (pop calls))))) (when noninteractive (kill-buffer)))) -(ert-deftest erc-check-prompt-input-functions () +(ert-deftest erc--check-prompt-input-functions () (erc-tests--with-process-input-spy (lambda (next) @@ -493,6 +498,31 @@ erc-send-whitespace-lines (should (equal (funcall next) '("there\n" nil t))) (should-not (funcall next)))))) +(ert-deftest erc--check-prompt-input-for-excess-lines () + (ert-info ("Without `erc-inhibit-multiline-input'") + (should-not erc-inhibit-multiline-input) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))) + + (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" ""))) + (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" "c"))))) + + (ert-info ("With `erc-ask-about-multiline-input'") + (let ((erc-inhibit-multiline-input t) + (erc-ask-about-multiline-input t)) + (ert-simulate-keys '(?n ?\r ?y ?\r) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) + (should-not erc-ask-about-multiline-input))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1