1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00

Improve 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: 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)
This commit is contained in:
F. Jason Park 2024-08-18 22:58:11 -07:00
parent 15545e15a3
commit 054602533c
6 changed files with 159 additions and 96 deletions

View 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.
* 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

View 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.

View 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

View 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 ()

View 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)
(defvar-local erc--channel-banlist-synchronized-p nil
"Whether the full channel ban list has been fetched since joining.")
(defun erc-cmd-BANLIST ()
"Pretty-print the contents of `erc-channel-banlist'.
(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)))))
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))
(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)))
(cl-defgeneric erc--determine-fill-column-function ()
fill-column)
(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)))))
(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)
@ -6639,17 +6649,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))
@ -7732,6 +7756,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."

View File

@ -929,13 +929,19 @@
(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-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))