]> git.eshelyaron.com Git - emacs.git/commitdiff
Improve inconsistent handling of ban lists in ERC
authorF. Jason Park <jp@neverwas.me>
Mon, 19 Aug 2024 05:58:11 +0000 (22:58 -0700)
committerEshel Yaron <me@eshelyaron.com>
Mon, 30 Sep 2024 20:33:48 +0000 (22:33 +0200)
* 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: Map ERC 5.6.1 to Emacs 31.1 in
`customize-package-emacs-version-alist'.
(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-cmd): 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 function, a method for standard
channel-mode letter "b".
* 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)

(cherry picked from commit 054602533ca08a7ab734aa3f750a03a7a8ccf25a)

etc/ERC-NEWS
lisp/erc/erc-backend.el
lisp/erc/erc-fill.el
lisp/erc/erc-pcomplete.el
lisp/erc/erc.el
test/lisp/erc/erc-tests.el

index 9803c3ff379e22ff3427550892feac8c79b931ee..0b5385f058917d8e7c802ab75449e869f7eb0926 100644 (file)
@@ -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.
 
+\f
+* 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.
+
 \f
 * Changes in ERC 5.6
 
index d999cf57db85f4aa4f1150c204c85551612a002c..16e8cae473303769a9419384a49e20817bbe8903 100644 (file)
@@ -1851,8 +1851,8 @@ add things to `%s' instead."
                                    ?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.
index 986314822bac1f5360ee9eafa2c134360de515a6..fa9d2071ccdcda284921b65e3091cb4c8868ed84 100644 (file)
@@ -896,6 +896,12 @@ decorations applied by third-party modules."
       (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
index 05cbaf3872f7dfc5a862e9f1536c2cd5f3a250be..afbe3895667bddecc0cffefa8f96c35614d20a89 100644 (file)
@@ -187,6 +187,14 @@ for use on `completion-at-point-function'."
   (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 ()
index 198a6ae5a432652dfc07ff532f6ee8bb11d0c293..60c2928e5bc7ad5c0b838839172b3277cc505bc2 100644 (file)
@@ -87,7 +87,8 @@
        ("5.4" . "28.1")
        ("5.4.1" . "29.1")
        ("5.5" . "29.1")
-       ("5.6" . "30.1")))
+       ("5.6" . "30.1")
+       ("5.6.1" . "31.1")))
 
 (defgroup erc nil
   "Emacs Internet Relay Chat client."
@@ -5555,109 +5556,117 @@ If CHANNEL is not specified, clear the topic for the default channel."
 
 (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 +5677,9 @@ Unban all currently banned users in the current channel."
                 (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)
 
@@ -6638,17 +6648,31 @@ See also: `erc-echo-notice-in-user-buffers',
                                           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))
@@ -7731,6 +7755,11 @@ Remember when STATE is non-nil and forget otherwise."
             (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."
index b11f994bce8018d0e649129fe716051b88445d39..72ea11aeba1e3654a315d347be9164976ee6bc3c 100644 (file)
 
   (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")))
   (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))