>From 3b6eeb91e25da87c33a0da6a4b768cbbc60d96d8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 2/5] 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 026b34849a..1cb0876367 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -625,12 +625,18 @@ erc-open-network-stream (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 6b14cf87e2..7f25afa8c5 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 @@ erc-after-connect :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 @@ erc-message (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 -- 2.38.1