mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-23 13:27:36 +00:00
Be smarter about switching to TLS from M-x erc
* lisp/erc/erc.el (erc--warn-unencrypted): Remove 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 for empowering an entry point's interactive form to bind special variables in their command's body without shadowing them in the lambda list. (erc, erc-tls): Add internal keyword argument for interactive use, but don't make it `keywordp' or advertise its presence. Also use new helper macro, `erc--with-entrypoint-environment', to temporarily bind special vars given 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.)
This commit is contained in:
F. Jason Park
parent
8dd209eea4
commit
0f7fc5cfdf
2 changed files with 184 additions and 54 deletions
|
|
@ -2241,29 +2241,12 @@ parameters SERVER and NICK."
|
|||
(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)))
|
||||
|
|
@ -2286,15 +2269,32 @@ parameters SERVER and NICK."
|
|||
(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))
|
||||
|
|
@ -2303,7 +2303,9 @@ parameters SERVER and NICK."
|
|||
(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.
|
||||
|
||||
|
|
@ -2326,9 +2328,12 @@ then the server and full-name will be set to those values,
|
|||
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)
|
||||
|
|
@ -2342,7 +2347,9 @@ See `erc-tls' for the meaning of ID."
|
|||
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.
|
||||
|
||||
|
|
@ -2386,10 +2393,20 @@ When present, ID should be a symbol or a string to use for naming
|
|||
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))
|
||||
;; Bind `erc-server-connect-function' to `erc-open-tls-stream'
|
||||
;; around `erc-open' when a non-default value hasn't been specified
|
||||
;; by the user or the interactive form. And don't bother checking
|
||||
;; for advice, indirect functions, autoloads, etc.
|
||||
(unless (or (assq 'erc-server-connect-function --interactive-env--)
|
||||
(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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1064,32 +1064,62 @@
|
|||
(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 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)
|
||||
'&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)
|
||||
:password nil))))
|
||||
: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"
|
||||
|
|
@ -1097,8 +1127,7 @@
|
|||
(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"
|
||||
|
|
@ -1113,37 +1142,40 @@
|
|||
(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"
|
||||
|
|
@ -1156,7 +1188,9 @@
|
|||
: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
|
||||
|
|
@ -1172,7 +1206,86 @@
|
|||
: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)))))
|
||||
|
||||
(ert-info ("Custom connect function")
|
||||
(let ((erc-server-connect-function 'my-connect-func))
|
||||
(erc-tls)
|
||||
(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 my-connect-func))))))
|
||||
|
||||
(ert-info ("Advised default function overlooked") ; intentional
|
||||
(advice-add 'erc-server-connect-function :around #'ignore
|
||||
'((name . erc-tests--erc-tls)))
|
||||
(erc-tls)
|
||||
(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))))
|
||||
(advice-remove 'erc-server-connect-function 'erc-tests--erc-tls))
|
||||
|
||||
(ert-info ("Advised non-default function honored")
|
||||
(let ((f (lambda (&rest r) (ignore r))))
|
||||
(cl-letf (((symbol-value 'erc-server-connect-function) f))
|
||||
(advice-add 'erc-server-connect-function :around #'ignore
|
||||
'((name . erc-tests--erc-tls)))
|
||||
(erc-tls)
|
||||
(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 ,f))))
|
||||
(advice-remove 'erc-server-connect-function
|
||||
'erc-tests--erc-tls)))))))
|
||||
|
||||
;; 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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue