From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 12 Aug 2021 03:10:31 -0700 Subject: [PATCH 04/28] Update ISUPPORT handling in ERC * lisp/erc/erc-backend (erc-server-parameters, erc-isupport-parameters): Add new variable to hold an alist of parsed erc-server-parameters in a more useful format. Deprecate erc-server-parameters. (erc-parse-isupport-value): Add helper function that parses an ISUPPORT value and returns the component parts with backslash-x hex escapes removed. (erc-server-005): Treat erc-server-response "command args" field as read-only. Prior to this, 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. * test/lisp/erc/erc-tests.el: Add tests for the above mentioned changes in erc-backend.el. --- lisp/erc/erc-backend.el | 76 +++++++++++++++++++++++++++++++------- lisp/erc/erc-capab.el | 2 +- lisp/erc/erc.el | 12 +++--- test/lisp/erc/erc-tests.el | 68 ++++++++++++++++++++++++++++++++++ 4 files changed, 137 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 69f63dfbc4..dedc041f51 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -178,6 +178,15 @@ erc-server-parameters TOPICLEN=160 - maximum allowed topic length WALLCHOPS - supports sending messages to all operators in a channel") +(make-obsolete-variable 'erc-server-parameters + 'erc-isupport-parameters "28.0.50") + +(defvar-local erc-isupport-parameters nil + "Alist of server ISUPPORT params with processed values. +Similar to the obsolete `erc-server-parameters', this is an alist of +key/value pairs. Except here, keys are symbols, and values are lists of +zero or more strings with hex escapes removed.") + ;;; Server and connection state (defvar erc-server-ping-timer-alist nil @@ -1581,6 +1590,38 @@ define-erc-response-handler ?U (nth 3 (erc-response.command-args parsed)) ?C (nth 4 (erc-response.command-args parsed))))) +(define-inline 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. However, if this becomes + ;; CHARSET-aware, we'll have to accommodate UTF-8 encoded bytes. + `(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 (string-search "," ,value) + (split-string ,value ",") + (list ,value))))) + (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. @@ -1592,21 +1633,28 @@ define-erc-response-handler 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]+\\)$" + (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) '-)) + (with-suppressed-warnings ((obsolete erc-server-parameters)) + (setf (alist-get key erc-server-parameters '- 'remove #'equal) + (or value negated) + ;; Since CHARSET is ignored, this can be populated during + ;; the initial burst (as well as updated later) + (alist-get (intern key) erc-isupport-parameters '- 'rem) + (or negated (and value + (erc-parse-isupport-value value)))))))) + (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 19bc2dbb8e..33a5c75662 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -137,7 +137,7 @@ erc-capab-identify-send-messages ;; 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)) + (assq 'CAPAB erc-isupport-parameters)) (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 a06166b565..c4392211c5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3523,8 +3523,8 @@ erc-cmd-SQUERY (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 (cadr (assq 'NICKLEN (erc-with-server-buffer + erc-isupport-parameters))))) (and nicklen (> (length nick) (string-to-number nicklen)) (erc-display-message nil 'notice 'active 'nick-too-long @@ -4397,9 +4397,9 @@ erc-nickname-in-use (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" + (nicklen (cadr (assq 'NICKLEN (erc-with-server-buffer - erc-server-parameters))))) + erc-isupport-parameters))))) (setq erc-bad-nick t) ;; try to use a different nick (if erc-default-nicks @@ -5002,8 +5002,8 @@ erc-channel-end-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 (cadr (assq 'PREFIX (erc-with-server-buffer + erc-isupport-parameters))) ;; provide a sane default "(qaohv)~&@%+")) types chars) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b2dbc1012d..4173e6df20 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -127,6 +127,74 @@ erc-lurker-maybe-trim (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-server-005 () + (with-suppressed-warnings ((obsolete erc-server-parameters)) + (let* ((erc-server-005-functions (copy-sequence erc-server-005-functions)) + (hooked 0) + (verify #'ignore) + (hook (lambda (_ _) (funcall verify) (cl-incf hooked))) + erc-server-parameters + erc-isupport-parameters + erc-timer-hook + calls + args + parsed) + (add-hook 'erc-server-005-functions hook 90) + (should (eq (cadr erc-server-005-functions) hook)) + (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 (equal erc-isupport-parameters + '((PREFIX "(ov)@+") (EXCEPTS) (BOT "B")))) + (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" "PREFIX=(ohv)@%+" "are supported") + parsed (make-erc-response :command-args args :command "005")) + + (setq verify + (lambda () + (should (equal erc-server-parameters + '(("PREFIX" . "(ohv)@%+") ("BOT" . "B")))) + (should (equal erc-isupport-parameters + '((PREFIX "(ohv)@%+") (BOT "B")))) + (should (string= (pop calls) + "-EXCEPTS PREFIX=(ohv)@%+ are supported")) + (should (equal args (erc-response.command-args parsed))))) + + (erc-call-hooks nil parsed)) + (should (= hooked 2))))) + (should-not (cadr erc-server-005-functions))) + (ert-deftest erc-ring-previous-command-base-case () (ert-info ("Create ring when nonexistent and do nothing") (let (erc-input-ring -- 2.31.1