master 46c765ed09 07/10: Refactor erc-select-read-args

[F. Jason Park]

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

    Refactor erc-select-read-args
    
    * lisp/erc/erc-backend.el (erc--server-connect-dumb-ipv6-regexp): Add
    liberal pattern for matching bracketed IPv6 addresses.
    (erc-server-connect): Remove brackets from IPv6 hosts before
    connecting.
    * lisp/erc/erc.el (erc--ensure-url): Add compat adapter to massage
    partial URLs given as input that may be missing the scheme:// portion.
    (erc-select-read-args): Keep bracketed IPv6 hosts
    intact.  Make this function fully URL-aware (was only partially so).
    Accept optional `input' argument.
    * lisp/erc/erc-tests.el (erc-tests--ipv6-examples,
    erc--server-connect-dumb-ipv6-regexp, erc-select-read-args): Add test
    reading user input during interactive invocations of entry points.
    (Bug#56514.)
---
 lisp/erc/erc-backend.el    |  6 ++++
 lisp/erc/erc.el            | 83 +++++++++++++++++++++---------------------
 test/lisp/erc/erc-tests.el | 89 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 136 insertions(+), 42 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index d49e6a5f1a..15fd6ac50f 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -638,12 +638,18 @@ The current buffer is given by BUFFER."
   (let ((p (plist-put parameters :nowait t)))
     (apply #'open-network-stream name buffer host service p)))
 
+(defvar erc--server-connect-dumb-ipv6-regexp
+  ;; Not for validation (gives false positives).
+  (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
+
 (defun erc-server-connect (server port buffer &optional client-certificate)
   "Perform the connection and login using the specified SERVER and PORT.
 We will store server variables in the buffer given by BUFFER.
 CLIENT-CERTIFICATE may optionally be used to specify a TLS client
 certificate to use for authentication when connecting over
 TLS (see `erc-session-client-certificate' for more details)."
+  (when (string-match erc--server-connect-dumb-ipv6-regexp server)
+    (setq server (match-string 1 server)))
   (let ((msg (erc-format-message 'connect ?S server ?p port)) process
         (args `(,(format "erc-%s-%s" server port) nil ,server ,port)))
     (when client-certificate
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 303f45d177..badda3ab84 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -70,7 +70,7 @@
 (require 'auth-source)
 (require 'time-date)
 (require 'iso8601)
-(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'subr-x) (require 'url-parse))
 
 (defconst erc-version "5.4.1"
   "This version of ERC.")
@@ -2094,52 +2094,51 @@ parameters SERVER and NICK."
   :group 'erc-hooks
   :type '(repeat function))
 
+(defun erc--ensure-url (input)
+  (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input)
+    (when (and (string-match (rx (? (+ any) "@")
+                                 (or (group (* (not "[")) ":" (* any))
+                                     (+ any))
+                                 ":" (+ (not (any ":]"))) eot)
+                             input)
+               (match-beginning 1))
+      (setq input (concat "[" (substring input (match-beginning 1)) "]")))
+    (setq input (concat "irc://" input)))
+  input)
+
 ;;;###autoload
 (defun erc-select-read-args ()
   "Prompt the user for values of nick, server, port, and password."
-  (let (user-input server port nick passwd)
-    (setq user-input (read-string
-                      "IRC server: "
-                      (erc-compute-server) 'erc-server-history-list))
-
-    (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
-        (setq port (erc-string-to-port (match-string 2 user-input))
-              user-input (match-string 1 user-input))
-      (setq port
-            (erc-string-to-port (read-string
-                                 "IRC port: " (erc-port-to-string
-                                               (erc-compute-port))))))
-
-    (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
-        (setq nick (match-string 1 user-input)
-              user-input (match-string 2 user-input))
-      (setq nick
-            (if (erc-already-logged-in server port nick)
-                (read-string
-                 (erc-format-message 'nick-in-use ?n nick)
-                 nick 'erc-nick-history-list)
-              (read-string
-               "Nickname: " (erc-compute-nick nick)
-               'erc-nick-history-list))))
-
-    (setq server user-input)
-
-    (setq passwd (if erc-prompt-for-password
-                     (read-passwd "Server password: ")
-                   (with-suppressed-warnings ((obsolete erc-password))
-                     erc-password)))
+  (require 'url-parse)
+  (let* ((input (let ((d (erc-compute-server)))
+                  (read-string (format "Server (default is %S): " d)
+                               nil 'erc-server-history-list d)))
+         ;; For legacy reasons, also accept a URL without a scheme.
+         (url (url-generic-parse-url (erc--ensure-url input)))
+         (server (url-host url))
+         (sp (and (or (string-suffix-p "s" (url-type url))
+                      (and (equal server erc-default-server)
+                           (not (string-prefix-p "irc://" input))))
+                  'ircs-u))
+         (port (or (url-portspec url)
+                   (erc-compute-port
+                    (let ((d (erc-compute-port sp))) ; may be a string
+                      (read-string (format "Port (default is %s): " d)
+                                   nil nil d)))))
+         ;; Trust the user not to connect twice accidentally.  We
+         ;; can't use `erc-already-logged-in' to check for an existing
+         ;; connection without modifying it to consider USER and PASS.
+         (nick (or (url-user url)
+                   (let ((d (erc-compute-nick)))
+                     (read-string (format "Nickname (default is %S): " d)
+                                  nil 'erc-nick-history-list d))))
+         (passwd (or (url-password url)
+                     (if erc-prompt-for-password
+                         (read-passwd "Server password (optional): ")
+                       (with-suppressed-warnings ((obsolete erc-password))
+                         erc-password)))))
     (when (and passwd (string= "" passwd))
       (setq passwd nil))
-
-    (while (erc-already-logged-in server port nick)
-      ;; hmm, this is a problem when using multiple connections to a bnc
-      ;; with the same nick. Currently this code prevents using more than one
-      ;; bnc with the same nick. actually it would be nice to have
-      ;; bncs transparent, so that erc-compute-buffer-name displays
-      ;; the server one is connected to.
-      (setq nick (read-string
-                  (erc-format-message 'nick-in-use ?n nick)
-                  nick 'erc-nick-history-list)))
     (list :server server :port port :nick nick :password passwd)))
 
 ;;;###autoload
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index c88dd9888d..f72db816af 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -953,4 +953,93 @@
     (kill-buffer "ExampleNet")
     (kill-buffer "#chan")))
 
+(defvar erc-tests--ipv6-examples
+  '("1:2:3:4:5:6:7:8"
+    "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
+    "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255"
+    "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
+    "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8"
+    "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8"
+    "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8"
+    "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8"
+    "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8"
+    "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8"
+    "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255"
+    "::ffff:255.255.255.255" "::ffff:0:255.255.255.255"
+    "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33"))
+
+(ert-deftest erc--server-connect-dumb-ipv6-regexp ()
+  (dolist (a erc-tests--ipv6-examples)
+    (should-not (string-match erc--server-connect-dumb-ipv6-regexp a))
+    (should (string-match erc--server-connect-dumb-ipv6-regexp
+                          (concat "[" a "]")))))
+
+(ert-deftest erc-select-read-args ()
+
+  (ert-info ("Defaults to TLS")
+    (should (equal (ert-simulate-keys "\r\r\r\r"
+                     (erc-select-read-args))
+                   (list :server "irc.libera.chat"
+                         :port 6697
+                         :nick (user-login-name)
+                         :password nil))))
+
+  (ert-info ("Override default TLS")
+    (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
+                     (erc-select-read-args))
+                   (list :server "irc.libera.chat"
+                         :port 6667
+                         :nick (user-login-name)
+                         :password nil))))
+
+  (ert-info ("Address includes port")
+    (should (equal (ert-simulate-keys
+                       "localhost:6667\rnick\r\r"
+                     (erc-select-read-args))
+                   (list :server "localhost"
+                         :port 6667
+                         :nick "nick"
+                         :password nil))))
+
+  (ert-info ("Address includes nick, password skipped via option")
+    (should (equal (ert-simulate-keys "nick@localhost:6667\r"
+                     (let (erc-prompt-for-password)
+                       (erc-select-read-args)))
+                   (list :server "localhost"
+                         :port 6667
+                         :nick "nick"
+                         :password nil))))
+
+  (ert-info ("Addresss includes nick and password")
+    (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r"
+                     (erc-select-read-args))
+                   (list :server "localhost"
+                         :port 6667
+                         :nick "nick"
+                         :password "sesame"))))
+
+  (ert-info ("IPv6 address plain")
+    (should (equal (ert-simulate-keys "::1\r\r\r\r"
+                     (erc-select-read-args))
+                   (list :server "[::1]"
+                         :port 6667
+                         :nick (user-login-name)
+                         :password nil))))
+
+  (ert-info ("IPv6 address with port")
+    (should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
+                     (erc-select-read-args))
+                   (list :server "[::1]"
+                         :port 6667
+                         :nick (user-login-name)
+                         :password nil))))
+
+  (ert-info ("IPv6 address includes nick")
+    (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r"
+                     (erc-select-read-args))
+                   (list :server "[::1]"
+                         :port 6667
+                         :nick "nick"
+                         :password nil)))))
+
 ;;; erc-tests.el ends here