master 4ee4865ce20 07/19: Add erc-server-396 response handler

[F. Jason Park]

branch: master
commit 4ee4865ce208c423afc8c2718922272509a4c1ae
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Add erc-server-396 response handler
    
    * lisp/erc/erc-backend.el (erc-server-396, erc-server-396-functions):
    Define response handler for 396 numeric.  For now, always display the
    message in the active buffer rather than bother with something like
    `erc-once-with-server-event' to try and suss out when this is a
    response to something client-initiated, like a /VHOST.  Do this
    despite most users probably wanting the message to appear in the
    server buffer alone when the response is server-initiated.  The
    `labeled-response' extension will hopefully make dealing with such
    matters less of a crapshoot.
    * lisp/erc/erc.el (erc--parse-user-regexp-pedantic): Tweak slightly to
    allow null groups and favor host.
    (erc--parse-user-regexp-legacy, erc--parse-user-regexp): Remove the
    first variable but preserve its value as that of the second.
    (erc--parse-nuh): New function.  The behavior is nuanced and complex
    and so not easily described in a doc string.
    (erc-message-english-396): Define format template for 396 response.
    * test/lisp/erc/erc-scenarios-misc-commands.el
    (erc-scenarios-misc-commands--VHOST): New test.
    * test/lisp/erc/erc-tests.el (erc-parse-user): Move "pedantic" section
    to new test.
    (erc--parse-nuh): New test.
    * test/lisp/erc/resources/commands/vhost.eld: New test data file.
    (Bug#67677)
---
 lisp/erc/erc-backend.el                      | 20 ++++++++++++++
 lisp/erc/erc.el                              | 17 ++++++++++--
 test/lisp/erc/erc-scenarios-misc-commands.el | 32 ++++++++++++++++++++++
 test/lisp/erc/erc-tests.el                   | 41 ++++++++++++++++++----------
 test/lisp/erc/resources/commands/vhost.eld   | 40 +++++++++++++++++++++++++++
 5 files changed, 132 insertions(+), 18 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 500e025e5a1..6483192692b 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -119,6 +119,7 @@
 
 (declare-function erc--init-channel-modes "erc" (channel raw-args))
 (declare-function erc--open-target "erc" (target))
+(declare-function erc--parse-nuh "erc" (string))
 (declare-function erc--target-from-string "erc" (string))
 (declare-function erc--update-modes "erc" (raw-args))
 (declare-function erc-active-buffer "erc" nil)
@@ -2407,6 +2408,7 @@ See `erc-display-server-message'." nil
     (erc-display-message parsed 'notice (erc-get-buffer channel proc)
                          's341 ?n nick ?c channel)))
 
+;; FIXME update or add server user instead when channel is "*".
 (define-erc-response-handler (352)
   "WHO notice." nil
   (pcase-let ((`(,channel ,user ,host ,_server ,nick ,away-flag)
@@ -2472,6 +2474,24 @@ See `erc-display-server-message'." nil
    's391 ?s (cadr (erc-response.command-args parsed))
    ?t (nth 2 (erc-response.command-args parsed))))
 
+;; https://defs.ircdocs.horse/defs/numerics.html#rpl-visiblehost-396
+;; As of ERC 5.6, if the client hasn't yet joined any channels,
+;; there's a good chance a server user for the current nick simply
+;; doesn't exist (and there's not enough info in this reply to create
+;; one).  To fix this, ERC could WHO itself on 372 or similar if it
+;; hasn't yet received a 900.
+(define-erc-response-handler (396)
+  "RPL_VISIBLEHOST or RPL_YOURDISPLAYHOST or RPL_HOSTHIDDEN." nil
+  (pcase-let* ((userhost (cadr (erc-response.command-args parsed)))
+               ;; Behavior blindly copied from event_hosthidden in irssi 1.4.
+               (rejectrx (rx (| (: bot (in ?@ ?: ?-)) (in ?* ?? ?! ?# ?& ?\s)
+                                (: ?- eot))))
+               (`(,_ ,user ,host) (and (not (string-match rejectrx userhost))
+                                       (erc--parse-nuh userhost))))
+    (when host
+      (erc-update-user-nick (erc-current-nick) nil host user)
+      (erc-display-message parsed 'notice 'active 's396 ?s userhost))))
+
 (define-erc-response-handler (401)
   "No such nick/channel." nil
   (let ((nick/channel (cadr (erc-response.command-args parsed))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7982c23f4a1..7fbc6859584 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7091,9 +7091,9 @@ EmacsSpeak support."
 (defalias 'erc-list 'ensure-list)
 
 (defconst erc--parse-user-regexp-pedantic
-  (rx bot (group (* (not (any "!\r\n"))))
-      "!" (group (* nonl))
-      "@" (group (* nonl)) eot))
+  (rx bot (? (? (group (+ (not (any "!@\r\n"))))) "!")
+      (? (? (group (+ nonl))) "@")
+      (? (group (+ nonl))) eot))
 
 (defconst erc--parse-user-regexp-legacy
   "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$")
@@ -7117,6 +7117,16 @@ Return a list of the three separate tokens."
    (t
     (list string "" ""))))
 
+(defun erc--parse-nuh (string)
+  "Match STRING against `erc--parse-user-regexp-pedantic'.
+Return matching groups or nil.  Interpret a lone token or one
+with only a leading \"!\" as a host.  See associated unit test
+for precise behavior."
+  (when (string-match erc--parse-user-regexp-pedantic string)
+    (list (match-string 1 string)
+          (match-string 2 string)
+          (match-string 3 string))))
+
 (defun erc-extract-nick (string)
   "Return the nick corresponding to a user specification STRING.
 
@@ -8844,6 +8854,7 @@ SOFTP, only do so when defined as a variable."
    (s368   . "Banlist of %c ends.")
    (s379   . "%c: Forwarded to %f")
    (s391   . "The time at %s is %t")
+   (s396   . "Your visible host has changed to %s")
    (s401   . "%n: No such nick/channel")
    (s402   . "%c: No such server")
    (s403   . "%c: No such channel")
diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el 
b/test/lisp/erc/erc-scenarios-misc-commands.el
index 2a36d52b835..b96782cf29c 100644
--- a/test/lisp/erc/erc-scenarios-misc-commands.el
+++ b/test/lisp/erc/erc-scenarios-misc-commands.el
@@ -91,4 +91,36 @@
         (funcall expect -0.1 "Incorrect arguments")
         (funcall expect 10 "See also: HELP EXAMPLES")))))
 
+;; Note that as of ERC 5.6, there is no actual slash-command function
+;; named `erc-cmd-vhost'.  At the moment, this test merely exists to
+;; assert that the `erc-server-396' response handler updates the rolls
+;; correctly.
+(ert-deftest erc-scenarios-misc-commands--VHOST ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "commands")
+       (erc-server-flood-penalty 0.1)
+       (dumb-server (erc-d-run "localhost" t 'vhost))
+       ;; As of ERC 5.6, we must join a channel before ERC adds itself
+       ;; to `erc-server-users'.  Without such an entry, there's
+       ;; nothing to update when the 396 arrives.
+       (erc-autojoin-channels-alist '((foonet "#chan")))
+       (port (process-contact dumb-server :service))
+       (expect (erc-d-t-make-expecter)))
+
+    (ert-info ("Connect to server")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester"
+                                :password "changeme"
+                                :full-name "tester")
+        (funcall expect 10 "debug mode")))
+
+    (ert-info ("Send VHOST")
+      (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+        (erc-scenarios-common-say "/VHOST tester changeme")
+        (funcall expect 10 "visible host")
+        (should (string= (erc-server-user-host (erc-get-server-user "tester"))
+                         "some.host.test.cc"))))))
+
 ;;; erc-scenarios-misc-commands.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index ceb5d86c19c..fb4aef00c1e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -632,8 +632,6 @@
     (should (string= "nick" (erc-lurker-maybe-trim "nick-_`")))))
 
 (ert-deftest erc-parse-user ()
-  (should (equal erc--parse-user-regexp erc--parse-user-regexp-legacy))
-
   (should (equal '("" "" "") (erc-parse-user "!@")))
   (should (equal '("" "!" "") (erc-parse-user "!!@")))
   (should (equal '("" "" "@") (erc-parse-user "!@@")))
@@ -646,23 +644,36 @@
   (should (equal '("abc" "123" "fake") (erc-parse-user "abc!123@fake")))
   (should (equal '("abc" "!123" "@xy") (erc-parse-user "abc!!123@@xy")))
 
-  (should (equal '("de" "fg" "xy") (erc-parse-user "abc\nde!fg@xy")))
+  (should (equal '("de" "fg" "xy") (erc-parse-user "abc\nde!fg@xy"))))
+
+(ert-deftest erc--parse-nuh ()
+  (should (equal '(nil nil nil) (erc--parse-nuh "!@")))
+  (should (equal '(nil nil nil) (erc--parse-nuh "@")))
+  (should (equal '(nil nil nil) (erc--parse-nuh "!")))
+  (should (equal '(nil "!" nil) (erc--parse-nuh "!!@")))
+  (should (equal '(nil "@" nil) (erc--parse-nuh "!@@")))
+  (should (equal '(nil "!@" nil) (erc--parse-nuh "!!@@")))
+
+  (should (equal '("abc" nil nil) (erc--parse-nuh "abc!")))
+  (should (equal '(nil "abc" nil) (erc--parse-nuh "abc@")))
+  (should (equal '(nil "abc" nil) (erc--parse-nuh "!abc@")))
 
-  (ert-info ("`erc--parse-user-regexp-pedantic'")
-    (let ((erc--parse-user-regexp erc--parse-user-regexp-pedantic))
-      (should (equal '("" "" "") (erc-parse-user "!@")))
-      (should (equal '("" "!" "") (erc-parse-user "!!@")))
-      (should (equal '("" "@" "") (erc-parse-user "!@@")))
-      (should (equal '("" "!@" "") (erc-parse-user "!!@@")))
+  (should (equal '("abc" "123" "fake") (erc--parse-nuh "abc!123@fake")))
+  (should (equal '("abc" "!123@" "xy") (erc--parse-nuh "abc!!123@@xy")))
 
-      (should (equal '("abc" "" "") (erc-parse-user "abc")))
-      (should (equal '("" "123" "fake") (erc-parse-user "!123@fake")))
-      (should (equal '("abc" "" "123") (erc-parse-user "abc!123")))
+  ;; Missing leading components.
+  (should (equal '(nil "abc" "123") (erc--parse-nuh "abc@123")))
+  (should (equal '(nil "123" "fake") (erc--parse-nuh "!123@fake")))
+  (should (equal '(nil nil "gnu.org") (erc--parse-nuh "@gnu.org")))
 
-      (should (equal '("abc" "123" "fake") (erc-parse-user "abc!123@fake")))
-      (should (equal '("abc" "!123@" "xy") (erc-parse-user "abc!!123@@xy")))
+  ;; Host "wins" over nick and user (sans "@").
+  (should (equal '(nil nil "abc") (erc--parse-nuh "abc")))
+  (should (equal '(nil nil "gnu.org") (erc--parse-nuh "gnu.org")))
+  (should (equal '(nil nil "gnu.org") (erc--parse-nuh "!gnu.org")))
+  (should (equal '("abc" nil "123") (erc--parse-nuh "abc!123")))
 
-      (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
+  ;; No fallback behavior.
+  (should-not (erc--parse-nuh "abc\nde!fg@xy")))
 
 (ert-deftest erc--parsed-prefix ()
   (erc-mode)
diff --git a/test/lisp/erc/resources/commands/vhost.eld 
b/test/lisp/erc/resources/commands/vhost.eld
new file mode 100644
index 00000000000..42013198fbc
--- /dev/null
+++ b/test/lisp/erc/resources/commands/vhost.eld
@@ -0,0 +1,40 @@
+;; -*- mode: lisp-data; -*-
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version 
oragono-2.6.0-7481bf0385b95b16")
+ (0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021 
05:06:18 UTC")
+ (0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16 
BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii 
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# 
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this 
server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 
NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ 
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this 
server")
+ (0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 
server(s)")
+ (0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 10 "MODE tester +i")
+ (0 ":irc.foonet.org 221 tester +i")
+ (0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is 
logging all user I/O. If you do not wish for everything you send to be readable 
by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #chan")
+ (0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
+ (0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
+ (0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
+
+((mode-chan 10 "MODE #chan")
+ (0 ":irc.foonet.org 324 tester #chan +nt")
+ (0 ":irc.foonet.org 329 tester #chan 1620104779")
+ (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!"))
+
+((vhost 10 "VHOST tester changeme")
+ (0 ":irc.foonet.org NOTICE tester :Setting your VHost: some.host.test.cc")
+ (0 ":irc.foonet.org 396 tester some.host.test.cc :is now your displayed host")
+ (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did 
violence on herself.")
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the forest 
of Arden."))