[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master c356f86b51 09/25: Update ISUPPORT handling in ERC
From: |
F. Jason Park |
Subject: |
master c356f86b51 09/25: Update ISUPPORT handling in ERC |
Date: |
Thu, 30 Jun 2022 18:29:52 -0400 (EDT) |
branch: master
commit c356f86b51f0e0adc85a9162816cb853b2583a5f
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
Update ISUPPORT handling in ERC
* lisp/erc/erc-backend (erc--isupport-params): Add new variable to
hold a hashmap of parsed `erc-server-parameters' in a more useful
format. But keep `erc-server-parameters' around for public use. We
currently lack dedicated local variables for certain discovered IRC
session properties, such as what prefix characters are supported for
channels, etc. And the truth of this needs querying many times per
second at various points. As such, caching here seems justified but
can be easily removed if deemed otherwise because all ingredients are
internal.
(erc--parse-isupport-value): Add helper function that parses an
ISUPPORT value and returns the component parts with backslash-x hex
escapes removed. This can probably use some streamlining.
(erc--with-memoization): Add compat alias for use in internal ISUPPORT
getter. Should be moved to `erc-compat.el' when that library is fully
reincorporated.
(erc--get-isupport-entry): Add internal getter to look up ISUPPORT
items.
(erc-server-005): Treat `erc-server-response' "command args" field as
read-only. Previously, this field was set to nil after processing,
which was unhelpful to other parts of the library. Also call above
mentioned helper to parse values. And add some bookkeeping to handle
negation.
* lisp/erc/erc-capab.el (erc-capab-identify-send-messages): Use
internal ISUPPORT getter.
* lisp/erc/erc.el (erc-cmd-NICK, erc-parse-prefix,
erc-nickname-in-use): Use internal ISUPPORT getter.
* test/lisp/erc/erc-tests.el: Add tests for the above mentioned
changes in erc-backend.el.
---
lisp/erc/erc-backend.el | 98 +++++++++++++++++++++++++++++++++++++++-------
lisp/erc/erc-capab.el | 2 +-
lisp/erc/erc.el | 13 +++---
test/lisp/erc/erc-tests.el | 93 +++++++++++++++++++++++++++++++++++++++++++
4 files changed, 183 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 5812fa4139..3534a937b8 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -185,6 +185,11 @@ SILENCE=10 - supports the SILENCE command, maximum allowed
number of entries
TOPICLEN=160 - maximum allowed topic length
WALLCHOPS - supports sending messages to all operators in a channel")
+(defvar-local erc--isupport-params nil
+ "Hash map of \"ISUPPORT\" params.
+Keys are symbols. Values are lists of zero or more strings with hex
+escapes removed.")
+
;;; Server and connection state
(defvar erc-server-ping-timer-alist nil
@@ -1625,6 +1630,67 @@ Then display the welcome message."
?U (nth 3 (erc-response.command-args parsed))
?C (nth 4 (erc-response.command-args parsed)))))
+(defun erc--parse-isupport-value (value)
+ "Return list of unescaped components from an \"ISUPPORT\" VALUE."
+ ;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2
+ ;;
+ ;; > The server SHOULD send "X", not "X="; this is the normalised form.
+ ;;
+ ;; Note: for now, assume the server will only send non-empty values,
+ ;; possibly with printable ASCII escapes. Though in practice, the
+ ;; only two escapes we're likely to see are backslash and space,
+ ;; meaning the pattern is too liberal.
+ (let (case-fold-search)
+ (mapcar
+ (lambda (v)
+ (let ((start 0)
+ m
+ c)
+ (while (and (< start (length v))
+ (string-match "[\\]x[0-9A-F][0-9A-F]" v start))
+ (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
+ c (string-to-number m 16))
+ (if (<= ?\ c ?~)
+ (setq v (concat (substring v 0 (match-beginning 0))
+ (string c)
+ (substring v (match-end 0)))
+ start (- (match-end 0) 3))
+ (setq start (match-end 0))))
+ v))
+ (if (if (>= emacs-major-version 28)
+ (string-search "," value)
+ (string-match-p "," value))
+ (split-string value ",")
+ (list value)))))
+
+;; FIXME move to erc-compat (once we decide how to load it)
+(defalias 'erc--with-memoization
+ (cond
+ ((fboundp 'with-memoization) #'with-memoization) ; 29.1
+ ((fboundp 'cl--generic-with-memoization) #'cl--generic-with-memoization)
+ (t (lambda (_ v) v))))
+
+(defun erc--get-isupport-entry (key &optional single)
+ "Return an item for \"ISUPPORT\" token KEY, a symbol.
+When a lookup fails return nil. Otherwise return a list whose
+CAR is KEY and whose CDR is zero or more strings. With SINGLE,
+just return the first value, if any. The latter is potentially
+ambiguous and only useful for tokens supporting a single
+primitive value."
+ (if-let* ((table (or erc--isupport-params
+ (erc-with-server-buffer erc--isupport-params)))
+ (value (erc--with-memoization (gethash key table)
+ (when-let ((v (assoc (symbol-name key)
+ erc-server-parameters)))
+ (if (cdr v)
+ (erc--parse-isupport-value (cdr v))
+ '--empty--)))))
+ (pcase value
+ ('--empty-- (unless single (list key)))
+ (`(,head . ,_) (if single head (cons key value))))
+ (when table
+ (remhash key table))))
+
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
@@ -1636,21 +1702,25 @@ certain commands are accepted and more. See
documentation for
A server may send more than one 005 message."
nil
- (let ((line (mapconcat #'identity
- (setf (erc-response.command-args parsed)
- (cdr (erc-response.command-args parsed)))
- " ")))
- (while (erc-response.command-args parsed)
- (let ((section (pop (erc-response.command-args parsed))))
- ;; fill erc-server-parameters
- (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$"
+ (unless erc--isupport-params
+ (setq erc--isupport-params (make-hash-table)))
+ (let* ((args (cdr (erc-response.command-args parsed)))
+ (line (string-join args " ")))
+ (while args
+ (let ((section (pop args))
+ key
+ value
+ negated)
+ (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$"
section)
- (add-to-list 'erc-server-parameters
- `(,(or (match-string 1 section)
- (match-string 3 section))
- .
- ,(match-string 2 section))))))
- (erc-display-message parsed 'notice proc line)))
+ (setq key (or (match-string 1 section) (match-string 4 section))
+ value (match-string 2 section)
+ negated (and (match-string 3 section) '-))
+ (setf (alist-get key erc-server-parameters '- 'remove #'equal)
+ (or value negated))
+ (remhash (intern key) erc--isupport-params))))
+ (erc-display-message parsed 'notice proc line)
+ nil))
(define-erc-response-handler (221)
"Display the current user modes." nil
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 8d0f40af99..c590b45fd2 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -137,7 +137,7 @@ These arguments are sent to this function when called as a
hook in
;; could possibly check for '("IRCD" . "dancer") in
;; `erc-server-parameters' instead of looking for a specific name
;; in `erc-server-version'
- (assoc "CAPAB" erc-server-parameters))
+ (erc--get-isupport-entry 'CAPAB))
(erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
(erc-server-send "CAPAB IDENTIFY-MSG")
(erc-server-send "CAPAB IDENTIFY-CTCP")
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a23ff5e059..80fc3dfe5f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -141,7 +141,6 @@
(defvar erc-server-current-nick)
(defvar erc-server-lag)
(defvar erc-server-last-sent-time)
-(defvar erc-server-parameters)
(defvar erc-server-process)
(defvar erc-server-quitting)
(defvar erc-server-reconnect-count)
@@ -3566,8 +3565,8 @@ The rest of LINE is the message to send."
(defun erc-cmd-NICK (nick)
"Change current nickname to NICK."
(erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
- (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
- erc-server-parameters)))))
+ (let ((nicklen (erc-with-server-buffer
+ (erc--get-isupport-entry 'NICKLEN 'single))))
(and nicklen (> (length nick) (string-to-number nicklen))
(erc-display-message
nil 'notice 'active 'nick-too-long
@@ -4436,9 +4435,8 @@ See also `erc-display-error-notice'."
(format "Nickname %s is %s, try another." nick reason))
(setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
(let ((newnick (nth 1 erc-default-nicks))
- (nicklen (cdr (assoc "NICKLEN"
- (erc-with-server-buffer
- erc-server-parameters)))))
+ (nicklen (erc-with-server-buffer
+ (erc--get-isupport-entry 'NICKLEN 'single))))
(setq erc-bad-nick t)
;; try to use a different nick
(if erc-default-nicks
@@ -5049,8 +5047,7 @@ See also `erc-channel-begin-receiving-names'."
(defun erc-parse-prefix ()
"Return an alist of valid prefix character types and their representations.
Example: (operator) o => @, (voiced) v => +."
- (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
- erc-server-parameters)))
+ (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t))
;; provide a sane default
"(qaohv)~&@%+"))
types chars)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 061dfc2f5e..91e7d50eac 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -349,6 +349,99 @@
(setq erc-lurker-ignore-chars "_-`") ; set of chars, not character alts
(should (string= "nick" (erc-lurker-maybe-trim "nick-_`")))))
+(ert-deftest erc--parse-isupport-value ()
+ (should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
+ (should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))
+
+ (should (equal (erc--parse-isupport-value "abc") '("abc")))
+ (should (equal (erc--parse-isupport-value "\\x20foo") '(" foo")))
+ (should (equal (erc--parse-isupport-value "foo\\x20") '("foo ")))
+ (should (equal (erc--parse-isupport-value "a\\x20b\\x20c") '("a b c")))
+ (should (equal (erc--parse-isupport-value "a\\x20b\\x20c\\x20") '("a b c ")))
+ (should (equal (erc--parse-isupport-value "\\x20a\\x20b\\x20c") '(" a b c")))
+ (should (equal (erc--parse-isupport-value "a\\x20\\x20c") '("a c")))
+ (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '(" ")))
+ (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/")))
+ (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19")))
+ (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c"))))
+
+(ert-deftest erc--get-isupport-entry ()
+ (let ((erc--isupport-params (make-hash-table))
+ (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
+ (items (lambda ()
+ (cl-loop for k being the hash-keys of erc--isupport-params
+ using (hash-values v) collect (cons k v)))))
+
+ (should-not (erc--get-isupport-entry 'FAKE))
+ (should-not (erc--get-isupport-entry 'FAKE 'single))
+ (should (zerop (hash-table-count erc--isupport-params)))
+
+ (should (equal (erc--get-isupport-entry 'BAR) '(BAR)))
+ (should-not (erc--get-isupport-entry 'BAR 'single))
+ (should (= 1 (hash-table-count erc--isupport-params)))
+
+ (should (equal (erc--get-isupport-entry 'BAZ) '(BAZ "A" "B" "C")))
+ (should (equal (erc--get-isupport-entry 'BAZ 'single) "A"))
+ (should (= 2 (hash-table-count erc--isupport-params)))
+
+ (should (equal (erc--get-isupport-entry 'FOO 'single) "1"))
+ (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
+
+ (should (equal (funcall items)
+ '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
+
+(ert-deftest erc-server-005 ()
+ (let* ((hooked 0)
+ (verify #'ignore)
+ (hook (lambda (_ _) (funcall verify) (cl-incf hooked)))
+ (erc-server-005-functions (list #'erc-server-005 hook #'ignore))
+ erc-server-parameters
+ erc--isupport-params
+ erc-timer-hook
+ calls
+ args
+ parsed)
+
+ (cl-letf (((symbol-function 'erc-display-message)
+ (lambda (_ _ _ line) (push line calls))))
+
+ (ert-info ("Baseline")
+ (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
+ parsed (make-erc-response :command-args args :command "005"))
+
+ (setq verify
+ (lambda ()
+ (should (equal erc-server-parameters
+ '(("PREFIX" . "(ov)@+") ("EXCEPTS")
+ ("BOT" . "B"))))
+ (should (zerop (hash-table-count erc--isupport-params)))
+ (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
+ (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
+ (should (equal "B" (erc--get-isupport-entry 'BOT t)))
+ (should (string= (pop calls)
+ "BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
+ (should (equal args (erc-response.command-args parsed)))))
+
+ (erc-call-hooks nil parsed))
+
+ (ert-info ("Negated, updated")
+ (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
+ parsed (make-erc-response :command-args args :command "005"))
+
+ (setq verify
+ (lambda ()
+ (should (equal erc-server-parameters
+ '(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
+ (should (string= (pop calls)
+ "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
+ (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
+ (should (equal "B" (erc--get-isupport-entry 'BOT t)))
+ (should-not (erc--get-isupport-entry 'EXCEPTS))
+ (should (equal args (erc-response.command-args parsed)))))
+
+ (erc-call-hooks nil parsed))
+ (should (= hooked 2)))))
+
(ert-deftest erc-ring-previous-command-base-case ()
(ert-info ("Create ring when nonexistent and do nothing")
(let (erc-input-ring
- master 4ae0707704 03/25: Accept user keyword arg in ERC entry-point commands, (continued)
- master 4ae0707704 03/25: Accept user keyword arg in ERC entry-point commands, F. Jason Park, 2022/06/30
- master a63ed6f78a 04/25: Remove duplicate ERC prompt on reconnect, F. Jason Park, 2022/06/30
- master de53d18a4d 07/25: Don't set erc-server-announced-name unless known, F. Jason Park, 2022/06/30
- master 873499ce06 06/25: Allow exemption from flood penalty in erc-backend, F. Jason Park, 2022/06/30
- master ecafe1cbb5 10/25: Recognize ASCII and strict CASEMAPPINGs in ERC, F. Jason Park, 2022/06/30
- master 752e860db4 16/25: Address long-standing ERC buffer-naming issues, F. Jason Park, 2022/06/30
- master 85c2f3bc3e 25/25: Update ERC's Info doc with network-ID related changes, F. Jason Park, 2022/06/30
- master 54414ec846 02/25: Initialize erc-server-filter-data in erc-backend, F. Jason Park, 2022/06/30
- master 4e312c07f7 11/25: Make ERC respect spaces in server passwords, F. Jason Park, 2022/06/30
- master 485b84cb7c 08/25: Require erc-networks in erc.el, F. Jason Park, 2022/06/30
- master c356f86b51 09/25: Update ISUPPORT handling in ERC,
F. Jason Park <=
- master 1c24af0fcb 12/25: Add helper to determine local channels in ERC, F. Jason Park, 2022/06/30
- master 529e46f128 13/25: Add eventual replacement for erc-default-recipients, F. Jason Park, 2022/06/30
- master 1767b0bd7e 19/25: Don't call erc-auto-query twice on PRIVMSG, F. Jason Park, 2022/06/30
- master 7c47d6c52d 18/25: Register erc-kill-buffer-function locally, F. Jason Park, 2022/06/30
- master 10237840d0 24/25: Optionally prevent sending multiline input in ERC, F. Jason Park, 2022/06/30
- master 9be08ceb31 15/25: Add ERC test server and related resources, F. Jason Park, 2022/06/30
- master 922ad23840 17/25: Add user-oriented test scenarios for ERC, F. Jason Park, 2022/06/30
- master e958a2b726 14/25: Discourage ill-defined use of buffer targets in ERC, F. Jason Park, 2022/06/30
- master 959fbcf34b 20/25: Favor network identities in erc-join, F. Jason Park, 2022/06/30
- master a9d89d083a 22/25: Fix regression in erc-send-input-line, F. Jason Park, 2022/06/30