From 929ad7b2412e45a8c3a0cd3dab00b35a7e8644c2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 29 Dec 2022 06:43:19 -0800 Subject: [PATCH 1/3] [5.6] Be smarter about switching to TLS from M-x erc * lisp/erc/erc.el (erc--warn-unencrypted): Remove newly unused internal function. (erc-select-read-args): Offer to use TLS when user runs M-x erc and opts for default server and port or provides the well-known IANA TLS port or enters an ircs:// URL at the server prompt. For the last two, do this immediately instead of calling `erc-tls' interactively and imposing a review of just-chosen values. Also remove error warnings and ensure `erc-tls' still works by setting `erc-server-connect-function' to `erc-open-tls-stream' when appropriate. Include the word "URL" in server prompt. (erc--with-entrypoint-environment): Add new macro to allow interactive form to bind special variables in associated commands' body without shadowing them in the lambda list. (erc, erc-tls): Add internal keyword argument for interactive use, but don't make it colon-prefixed, i.e., `keywordp'. Also use new helper macro, `erc--with-entrypoint-environment' to temporarily bind special vars specified by interactive helper `erc-select-read-args'. * test/lisp/erc/erc-tests.el (erc--with-entrypoint-environment): Add new test. (erc-select-read-args): Modify return values to expect additional internal keyword argument where appropriate. (erc-tls): Make assertions about environment. (erc--interactive): New test. (Bug#60428.) --- lisp/erc/erc.el | 76 +++++++++++++--------- test/lisp/erc/erc-tests.el | 126 ++++++++++++++++++++++++++++++------- 2 files changed, 148 insertions(+), 54 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ff1820cfaf2..ba6055e1b93 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2176,29 +2176,12 @@ erc--ensure-url (setq input (concat "irc://" input))) input) -;; A temporary means of addressing the problem of ERC's namesake entry -;; point defaulting to a non-TLS connection with its default server -;; (bug#60428). -(defun erc--warn-unencrypted () - ;; Remove unconditionally to avoid wrong context due to races from - ;; simultaneous dialing or aborting (e.g., via `keybaord-quit'). - (remove-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted) - (when (and (process-contact erc-server-process :nowait) - (equal erc-session-server erc-default-server) - (eql erc-session-port erc-default-port)) - ;; FIXME use the autoloaded `info' instead of `Info-goto-node' in - ;; `erc-button-alist'. - (require 'info nil t) - (erc-display-error-notice - nil (concat "This connection is unencrypted. Please use `erc-tls'" - " from now on. See Info:\"(erc) connecting\" for more.")))) - ;;;###autoload (defun erc-select-read-args () "Prompt the user for values of nick, server, port, and password." (require 'url-parse) (let* ((input (let ((d (erc-compute-server))) - (read-string (format "Server (default is %S): " d) + (read-string (format "Server or URL (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))) @@ -2221,15 +2204,32 @@ erc-select-read-args (m (if p (format "Server password (default is %S): " p) "Server password (optional): "))) - (if erc-prompt-for-password (read-passwd m nil p) p)))) + (if erc-prompt-for-password (read-passwd m nil p) p))) + (opener (and (or sp (eql port erc-default-port-tls) + (and (equal server erc-default-server) + (not (string-prefix-p "irc://" input)) + (eql port erc-default-port) + (y-or-n-p "Connect using TLS instead? ") + (setq port erc-default-port-tls))) + #'erc-open-tls-stream)) + env) + (when opener + (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) (setq passwd nil)) - (when (and (equal server erc-default-server) - (eql port erc-default-port) - (not (eql port erc-default-port-tls)) ; not `erc-tls' - (not (string-prefix-p "irc://" input))) ; not yanked URL - (add-hook 'erc--server-post-connect-hook #'erc--warn-unencrypted)) - (list :server server :port port :nick nick :password passwd))) + `( :server ,server :port ,port :nick ,nick + ,@(and passwd `(:password ,passwd)) + ,@(and env `(&interactive-env ,env))))) + +(defmacro erc--with-entrypoint-environment (env &rest body) + "Run BODY with bindings from ENV alist." + (declare (indent 1)) + (let ((syms (make-symbol "syms")) + (vals (make-symbol "vals"))) + `(let (,syms ,vals) + (pcase-dolist (`(,k . ,v) ,env) (push k ,syms) (push v ,vals)) + (cl-progv ,syms ,vals + ,@body)))) ;;;###autoload (cl-defun erc (&key (server (erc-compute-server)) @@ -2238,7 +2238,9 @@ erc (user (erc-compute-user)) password (full-name (erc-compute-full-name)) - id) + id + ;; Used by interactive form + ((&interactive-env --interactive-env--))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC. @@ -2261,9 +2263,12 @@ erc whereas `erc-compute-port' and `erc-compute-nick' will be invoked for the values of the other parameters. -See `erc-tls' for the meaning of ID." +See `erc-tls' for the meaning of ID. + +\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME ID)" (interactive (erc-select-read-args)) - (erc-open server port nick full-name t password nil nil nil nil user id)) + (erc--with-entrypoint-environment --interactive-env-- + (erc-open server port nick full-name t password nil nil nil nil user id))) ;;;###autoload (defalias 'erc-select #'erc) @@ -2277,7 +2282,9 @@ erc-tls password (full-name (erc-compute-full-name)) client-certificate - id) + id + ;; Used by interactive form + ((&interactive-env --interactive-env--))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC over TLS. @@ -2321,10 +2328,17 @@ erc-tls the server buffer and identifying the connection unequivocally. See info node `(erc) Network Identifier' for details. Like USER and CLIENT-CERTIFICATE, this parameter cannot be specified -interactively." +interactively. + +\(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" (interactive (let ((erc-default-port erc-default-port-tls)) (erc-select-read-args))) - (let ((erc-server-connect-function 'erc-open-tls-stream)) + (unless (or (assq 'erc-server-connect-function --interactive-env--) + ;; Fails when advice is present, but assume user can cope. + (not (eq erc-server-connect-function #'erc-open-network-stream))) + (push '(erc-server-connect-function . erc-open-tls-stream) + --interactive-env--)) + (erc--with-entrypoint-environment --interactive-env-- (erc-open server port nick full-name t password nil nil nil client-certificate user id))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 40a2d2de657..5d2a023486d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -999,32 +999,62 @@ erc--server-connect-dumb-ipv6-regexp (should (string-match erc--server-connect-dumb-ipv6-regexp (concat "[" a "]"))))) +(ert-deftest erc--with-entrypoint-environment () + (let ((env '((erc-join-buffer . foo) + (erc-server-connect-function . bar)))) + (erc--with-entrypoint-environment env + (should (eq erc-join-buffer 'foo)) + (should (eq erc-server-connect-function 'bar))))) + (ert-deftest erc-select-read-args () - (ert-info ("Does not default to TLS") - (should (equal (ert-simulate-keys "\r\r\r\r" + (ert-info ("Prompts for switch to TLS by default") + (should (equal (ert-simulate-keys "\r\r\r\ry\r" (erc-select-read-args)) (list :server "irc.libera.chat" - :port 6667 + :port 6697 + :nick (user-login-name) + '&interactive-env '((erc-server-connect-function + . erc-open-tls-stream)))))) + + (ert-info ("Switches to TLS when port matches default TLS port") + (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" + (erc-select-read-args)) + (list :server "irc.gnu.org" + :port 6697 + :nick (user-login-name) + '&interactive-env '((erc-server-connect-function + . erc-open-tls-stream)))))) + + (ert-info ("Switches to TLS when URL is ircs://") + (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.gnu.org" + :port 6697 :nick (user-login-name) - :password nil)))) + '&interactive-env '((erc-server-connect-function + . erc-open-tls-stream)))))) + + (ert-info ("Opt out of non-TLS warning manually") + (should (equal (ert-simulate-keys "\r\r\r\rn\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6667 + :nick (user-login-name))))) (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)))) + :nick (user-login-name))))) (ert-info ("Address includes port") - (should (equal (ert-simulate-keys - "localhost:6667\rnick\r\r" + (should (equal (ert-simulate-keys "localhost:6667\rnick\r\r" (erc-select-read-args)) (list :server "localhost" :port 6667 - :nick "nick" - :password nil)))) + :nick "nick")))) (ert-info ("Address includes nick, password skipped via option") (should (equal (ert-simulate-keys "nick@localhost:6667\r" @@ -1032,8 +1062,7 @@ erc-select-read-args (erc-select-read-args))) (list :server "localhost" :port 6667 - :nick "nick" - :password nil)))) + :nick "nick")))) (ert-info ("Address includes nick and password") (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r" @@ -1048,37 +1077,40 @@ erc-select-read-args (erc-select-read-args)) (list :server "[::1]" :port 6667 - :nick (user-login-name) - :password nil)))) + :nick (user-login-name))))) (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)))) + :nick (user-login-name))))) (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))))) + :nick "nick"))))) (ert-deftest erc-tls () - (let (calls) + (let (calls env) (cl-letf (((symbol-function 'user-login-name) (lambda (&optional _) "tester")) ((symbol-function 'erc-open) - (lambda (&rest r) (push r calls)))) + (lambda (&rest r) + (push `((erc-server-connect-function + ,erc-server-connect-function)) + env) + (push r calls)))) (ert-info ("Defaults") (erc-tls) (should (equal (pop calls) '("irc.libera.chat" 6697 "tester" "unknown" t - nil nil nil nil nil "user" nil)))) + nil nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Full") (erc-tls :server "irc.gnu.org" @@ -1091,7 +1123,9 @@ erc-tls :id 'GNU.org) (should (equal (pop calls) '("irc.gnu.org" 7000 "bob" "Bob's Name" t - "bob:changeme" nil nil nil t "bobo" GNU.org)))) + "bob:changeme" nil nil nil t "bobo" GNU.org))) + (should (equal (pop env) + '((erc-server-connect-function erc-open-tls-stream))))) ;; Values are often nil when called by lisp code, which leads to ;; null params. This is why `erc-open' recomputes almost @@ -1107,7 +1141,53 @@ erc-tls :password "bob:changeme")) (should (equal (pop calls) '(nil 7000 nil "Bob's Name" t - "bob:changeme" nil nil nil nil "bobo" nil))))))) + "bob:changeme" nil nil nil nil "bobo" nil))) + (should (equal (pop env) + '((erc-server-connect-function erc-open-tls-stream))))) + + (ert-info ("Interactive") + (ert-simulate-keys "nick:sesame@localhost:6667\r\r" + (call-interactively #'erc-tls)) + (should (equal (pop calls) + '("localhost" 6667 "nick" "unknown" t "sesame" + nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-server-connect-function + erc-open-tls-stream)))))))) + +;; See `erc-select-read-args' above for argument parsing. +;; This only tests the "hidden" arguments. + +(ert-deftest erc--interactive () + (let (calls env) + (cl-letf (((symbol-function 'user-login-name) + (lambda (&optional _) "tester")) + ((symbol-function 'erc-open) + (lambda (&rest r) + (push `((erc-server-connect-function + ,erc-server-connect-function)) + env) + (push r calls)))) + + (ert-info ("Default click-through accept TLS upgrade") + (ert-simulate-keys "\r\r\r\ry\r" + (call-interactively #'erc)) + (should (equal (pop calls) + '("irc.libera.chat" 6697 "tester" "unknown" t nil + nil nil nil nil "user" nil))) + (should (equal (pop env) + '((erc-server-connect-function erc-open-tls-stream))))) + + (ert-info ("Nick supplied, decline TLS upgrade") + (ert-simulate-keys "\r\rdummy\r\rn\r" + (call-interactively #'erc)) + (should (equal (pop calls) + '("irc.libera.chat" 6667 "dummy" "unknown" t nil + nil nil nil nil "user" nil))) + (should (equal (pop env) + '( + (erc-server-connect-function + erc-open-network-stream)))))))) (defun erc-tests--make-server-buf (name) (with-current-buffer (get-buffer-create name) -- 2.39.1