From 9bb1ca1f792863642e2a043822303c1f03b474e1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 18 Aug 2024 22:58:11 -0700 Subject: [PATCH 4/6] [5.6.1] Fix inconsistent handling of ban lists in ERC * etc/ERC-NEWS: Mention new function `erc-sync-banlist' in new section for ERC 5.6.1. * lisp/erc/erc-backend.el (erc-server-MODE): Don't call `erc-banlist-update'. * lisp/erc/erc-fill.el (erc--determine-fill-column-function): New method for `fill' and `fill-wrap' modules. * lisp/erc/erc-pcomplete.el (pcomplete/erc-mode/BANLIST) (pcomplete/erc-mode/BL) (pcomplete/erc-mode/MASSUNBAN, pcomplete/erc-mode/MUB): New functions. * lisp/erc/erc.el (erc-channel-banlist): Deprecate practice of using the symbol-property `received-from-server' of as a state flag because it's error-prone and bleeds into other connections. (erc--channel-banlist-synchronized-p): New variable to indicate whether the ban list has been initialized. The presence of a local binding for `erc-channel-banlist' could probably be used for the same purpose but would surely require rewriting `erc-cmd-BANLIST' and `erc-cmd-MASSUNBAN'. (erc-sync-banlist): New function, announced in ERC-NEWS. (erc--wrap-banlist): New function. (erc-banlist-fill-padding): New variable. (erc--determine-fill-column-function): New generic function. (erc-cmd-BANLIST): Move forward declaration of `erc-fill-column' from top level into function body. Always reset `received-from-server' to nil. Improve column calculations. (erc-cmd-MASSUNBAN): Always reset `received-from-server' to nil. (erc-banlist-finished): Deprecate function unused since 2003. (erc--banlist-update): New function. (erc-banlist-update): Deprecate function because its logic is faulty and it doesn't handle mixed mode letters, like "MODE #foobar +mb *@127.0.0.1". See https://modern.ircdocs.horse/#mode-message. It also depends on an obsolete convention regarding the symbol property `received-from-server' of `erc-channel-banlist'. Basically, this function used to run upon receipt of any "MODE" command from the server. However, actual updates to the variable `erc-channel-banlist' only happened if `received-from-server' was t, which could only be the case after the user issued a /MASSUNBAN. And that behavior was determined to be a bug. This mode framework stuff was introduced as part of bug#67220 for ERC 5.6. (erc--handle-channel-mode): New method. * test/lisp/erc/erc-tests.el (erc--channel-modes) (erc--channel-modes/graphic-p): Assert contents of `erc-channel-banlist' updated on "MODE". (Bug#72736) --- etc/ERC-NEWS | 9 ++ lisp/erc/erc-backend.el | 4 +- lisp/erc/erc-fill.el | 6 ++ lisp/erc/erc-pcomplete.el | 8 ++ lisp/erc/erc.el | 212 +++++++++++++++++++++---------------- test/lisp/erc/erc-tests.el | 19 +++- 6 files changed, 160 insertions(+), 98 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 9803c3ff379..0b5385f0589 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,15 @@ 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.6.1 + +** Reliable library access for ban lists. +Say goodbye to continually running "/BANLIST" for programmatic +purposes. Modules can instead use the function 'erc-sync-banlist' to +guarantee that the variable 'erc-channel-banlist' remains synced for +the remainder of an IRC session. + * Changes in ERC 5.6 diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d999cf57db8..16e8cae4733 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1851,8 +1851,8 @@ erc--server-determine-join-display-context ?t tgt ?m mode) (erc-display-message parsed 'notice buf 'MODE ?n nick ?u login - ?h host ?t tgt ?m mode))) - (erc-banlist-update proc parsed)))) + ?h host ?t tgt ?m mode))))) + nil) (defun erc--wrangle-query-buffers-on-nick-change (old new) "Create or reuse a query buffer for NEW nick after considering OLD nick. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 986314822ba..fa9d2071ccd 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -896,6 +896,12 @@ erc-timestamp-offset (length (format-time-string erc-timestamp-format)) 0)) +(cl-defmethod erc--determine-fill-column-function + (&context (erc-fill-mode (eql t))) + (if erc-fill-wrap-mode + (- (window-width) erc-fill--wrap-value 1) + erc-fill-column)) + (provide 'erc-fill) ;;; erc-fill.el ends here diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 05cbaf3872f..afbe3895667 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -187,6 +187,14 @@ pcomplete/erc-mode/RECONNECT (pcomplete-here '("cancel")) (pcomplete-opt "a")) +(defun pcomplete/erc-mode/BANLIST () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/BL #'pcomplete/erc-mode/BANLIST) + +(defun pcomplete/erc-mode/MASSUNBAN () + (pcomplete-opt "f")) +(defalias 'pcomplete/erc-mode/MUB #'pcomplete/erc-mode/MASSUNBAN) + ;;; Functions that provide possible completions. (defun pcomplete-erc-commands () diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8b3eef94ee4..52ec4d23dd7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -5555,109 +5555,117 @@ erc-cmd-CLEARTOPIC (defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. - -Each ban is an alist of the form: - (WHOSET . MASK) - -The property `received-from-server' indicates whether -or not the ban list has been requested from the server.") +Entries are cons cells of the form (OP . MASK), where OP is the channel +operator who issued the ban. Modules needing such a list should call +`erc-sync-banlist' once per session in the channel before accessing the +variable. Interactive users need only issue a /BANLIST. Note that +older versions of ERC relied on a deprecated convention involving a +property of the symbol `erc-channel-banlist' to indicate whether a ban +list had been received in full; this was found to be unreliable.") (put 'erc-channel-banlist 'received-from-server nil) -(defvar erc-fill-column) - -(defun erc-cmd-BANLIST () - "Pretty-print the contents of `erc-channel-banlist'. - -The ban list is fetched from the server if necessary." - (let ((chnl (erc-default-target)) - (chnl-name (buffer-name))) - - (cond - ((not (erc-channel-p chnl)) - (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store - erc-channel-banlist nil) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl-name - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-BANLIST) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - - ((null erc-channel-banlist) - (erc-display-message nil 'notice 'active - (format "No bans for channel: %s\n" chnl)) +(defvar-local erc--channel-banlist-synchronized-p nil + "Whether the full channel ban list has been fetched since joining.") + +(defun erc-sync-banlist (&optional done-fn) + "Initialize syncing of current channel's `erc-channel-banlist'. +Arrange for it to remain synced for the rest of the IRC session. When +DONE-FN is non-nil, call it with no args once fully updated. Expect it +to return non-nil, if necessary, to inhibit further processing." + (unless (erc-channel-p (current-buffer)) + (error "Not a channel buffer")) + (let ((channel (erc-target)) + (buffer (current-buffer)) + (hook (lambda (&rest r) (apply #'erc-banlist-store r) t))) + (setq erc-channel-banlist nil) + (erc-with-server-buffer + (add-hook 'erc-server-367-functions hook -98 t) + (erc-once-with-server-event + 368 (lambda (&rest _) + (remove-hook 'erc-server-367-functions hook t) + (with-current-buffer buffer + (prog1 (if done-fn (funcall done-fn) t) + (setq erc--channel-banlist-synchronized-p t))))) + (erc-server-send (format "MODE %s b" channel))))) + +(defun erc--wrap-banlist-cmd (slashcmd) + (lambda () + (put 'erc-channel-banlist 'received-from-server t) + (unwind-protect (funcall slashcmd) (put 'erc-channel-banlist 'received-from-server nil)) + t)) - (t - (let* ((erc-fill-column (or (and (boundp 'erc-fill-column) - erc-fill-column) - (and (boundp 'fill-column) - fill-column) - (1- (window-width)))) - (separator (make-string erc-fill-column ?=)) - (fmt (concat - "%-" (number-to-string (/ erc-fill-column 2)) "s" - "%" (number-to-string (/ erc-fill-column 2)) "s"))) +(defvar erc-banlist-fill-padding 1.0 + "Scaling factor from 0 to 1 of free space between entries, if any.") - (erc-display-message - nil 'notice 'active - (format "Ban list for channel: %s\n" (erc-default-target))) - - (erc-display-line separator 'active) - (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) - (erc-display-line separator 'active) - - (mapc - (lambda (x) - (erc-display-line - (format fmt - (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) - (if (car x) - (truncate-string-to-width (car x) (/ erc-fill-column 2)) - "")) - 'active)) - erc-channel-banlist) - - (erc-display-message nil 'notice 'active "End of Ban list") - (put 'erc-channel-banlist 'received-from-server nil))))) +(cl-defgeneric erc--determine-fill-column-function () + fill-column) + +(defun erc-cmd-BANLIST (&rest args) + "Print the list of ban masks for the current channel. +When uninitialized or with option -f, resync `erc-channel-banlist'." + (cond + ((not (erc-channel-p (current-buffer))) + (erc-display-message nil 'notice 'active "You're not on a channel\n")) + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-BANLIST))) + ((null erc-channel-banlist) + (erc-display-message nil 'notice 'active + (format "No bans for channel: %s\n" (erc-target)))) + ((let ((max-width (erc--determine-fill-column-function)) + (lw 0) (rw 0) separator fmt) + (dolist (entry erc-channel-banlist) + (setq rw (max (length (car entry)) rw) + lw (max (length (cdr entry)) lw))) + (let ((maxw (* 1.0 (min max-width (+ rw lw))))) + (when (< maxw (+ rw lw)) ; scale down when capped + (cl-psetq rw (/ (* rw maxw) (* 1.0 (+ rw lw))) + lw (/ (* lw maxw) (* 1.0 (+ rw lw))))) + (when-let ((larger (max rw lw)) ; cap ratio at 3:1 + (wavg (* maxw 0.75)) + ((> larger wavg))) + (setq rw (if (eql larger rw) wavg (- maxw wavg)) + lw (- maxw rw))) + (cl-psetq rw (+ rw (* erc-banlist-fill-padding + (- (/ (* rw max-width) maxw) rw))) + lw (+ lw (* erc-banlist-fill-padding + (- (/ (* lw max-width) maxw) lw))))) + (setq rw (truncate rw) + lw (truncate lw)) + (cl-assert (<= (+ rw lw) max-width)) + (setq separator (make-string (+ rw lw 1) ?=) + fmt (concat "%-" (number-to-string lw) "s " + "%" (number-to-string rw) "s")) + (erc-display-message + nil 'notice 'active + (format "Ban list for channel: %s%s\n" (erc-target) + (if erc--channel-banlist-synchronized-p " (cached)" ""))) + (erc-display-line separator 'active) + (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) + (erc-display-line separator 'active) + (dolist (entry erc-channel-banlist) + (erc-display-line + (format fmt (truncate-string-to-width (cdr entry) lw) + (truncate-string-to-width (car entry) rw)) + 'active)) + (erc-display-message nil 'notice 'active "End of Ban list")))) + (put 'erc-channel-banlist 'received-from-server nil) t) (defalias 'erc-cmd-BL #'erc-cmd-BANLIST) -(defun erc-cmd-MASSUNBAN () - "Mass Unban. - -Unban all currently banned users in the current channel." +(defun erc-cmd-MASSUNBAN (&rest args) + "Remove all bans in the current channel." (let ((chnl (erc-default-target))) (cond - ((not (erc-channel-p chnl)) (erc-display-message nil 'notice 'active "You're not on a channel\n")) - - ((not (get 'erc-channel-banlist 'received-from-server)) - (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-MASSUNBAN) - t))) - (erc-server-send (format "MODE %s b" chnl))))) - + ((or (equal args '("-f")) + (and (not erc--channel-banlist-synchronized-p) + (not (get 'erc-channel-banlist 'received-from-server)))) + (erc-sync-banlist (erc--wrap-banlist-cmd #'erc-cmd-MASSUNBAN))) (t (let ((bans (mapcar #'cdr erc-channel-banlist))) (when bans ;; Glob the bans into groups of three, and carry out the unban. @@ -5668,8 +5676,9 @@ erc-cmd-MASSUNBAN (format "MODE %s -%s %s" (erc-default-target) (make-string (length x) ?b) (mapconcat #'identity x " ")))) - (erc-group-list bans 3)))) - t)))) + (erc-group-list bans 3)))))) + (put 'erc-channel-banlist 'received-from-server nil) + t)) (defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN) @@ -6639,17 +6648,31 @@ erc-banlist-store erc-channel-banlist)))))) nil) +;; This was a default member of `erc-server-368-functions' (nee -hook) +;; between January and June of 2003 (but not as part of any release). (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." + (declare (obsolete "uses obsolete and likely faulty logic" "31.1")) (let* ((channel (nth 1 (erc-response.command-args parsed))) (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) t) ; suppress the 'end of banlist' message +(defun erc--banlist-update (statep mask) + "Add or remove a mask from `erc-channel-banlist'." + (if statep + (let ((whoset (erc-response.sender erc--parsed-response))) + (cl-pushnew (cons whoset mask) erc-channel-banlist :test #'equal)) + (let ((upcased (upcase mask))) + (setq erc-channel-banlist + (cl-delete-if (lambda (y) (equal (upcase (cdr y)) upcased)) + erc-channel-banlist))))) + (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 + (declare (obsolete "continual syncing via `erc--banlist-update'" "31.1")) (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) @@ -7732,6 +7755,11 @@ erc--handle-channel-mode (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal) (delete (char-to-string c) erc-channel-modes)))) +;; We could specialize on type A, but that may be too brittle. +(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?b)) state arg) + "Update `erc-channel-banlist' when synchronized." + (when erc--channel-banlist-synchronized-p (erc--banlist-update state arg))) + ;; We could specialize on type C, but that may be too brittle. (cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg) "Update channel user limit, remembering ARG when STATE is non-nil." diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b11f994bce8..72ea11aeba1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -929,13 +929,19 @@ erc--channel-modes (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) (erc-tests-common-init-server-proc "sleep" "1") - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bbltk" "fool!*@*" "spam!*@*" "3" "h2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "spam!*@*") + ("chop!~u@gnu.org" . "fool!*@*"))))) (should (equal (erc--channel-modes 'string) "klt")) (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) @@ -980,11 +986,16 @@ erc--channel-modes/graphic-p (erc-tests-common-init-server-proc "sleep" "1") (setq erc--isupport-params (make-hash-table) erc--target (erc--target-from-string "#test") + erc--channel-banlist-synchronized-p t erc-server-parameters '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) - (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) - (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2")) + (cl-letf ((erc--parsed-response (make-erc-response + :sender "chop!~u@gnu.org")) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (should-not erc-channel-banlist) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2") + (should (equal erc-channel-banlist '(("chop!~u@gnu.org" . "fool!*@*"))))) ;; Truncation cache populated and used. (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) -- 2.46.0