summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/erc/erc-backend.el98
-rw-r--r--lisp/erc/erc-capab.el2
-rw-r--r--lisp/erc/erc.el13
-rw-r--r--test/lisp/erc/erc-tests.el93
4 files changed, 183 insertions, 23 deletions
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 5812fa41390..3534a937b80 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 8d0f40af994..c590b45fd21 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 a23ff5e0593..80fc3dfe5f1 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 061dfc2f5e0..91e7d50eacd 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
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-29 17:19:10 +0000