From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#60428: 30.0.50; ERC >5.5: Make M-x erc a more welcoming entry point Date: Tue, 07 Feb 2023 07:21:33 -0800 Message-ID: <87v8kd8ps2.fsf__10573.2651938283$1675783344$gmane$org@neverwas.me> References: <87mt750ygt.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14042"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 60428@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Feb 07 16:22:18 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pPPnU-0003Sn-RQ for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 07 Feb 2023 16:22:17 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pPPnH-0003FZ-Nn; Tue, 07 Feb 2023 10:22:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pPPnF-0003Em-Vk for bug-gnu-emacs@gnu.org; Tue, 07 Feb 2023 10:22:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pPPnF-0001tq-N6 for bug-gnu-emacs@gnu.org; Tue, 07 Feb 2023 10:22:01 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pPPnF-0007Yv-Hn for bug-gnu-emacs@gnu.org; Tue, 07 Feb 2023 10:22:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 07 Feb 2023 15:22:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 60428 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 60428-submit@debbugs.gnu.org id=B60428.167578331429053 (code B ref 60428); Tue, 07 Feb 2023 15:22:01 +0000 Original-Received: (at 60428) by debbugs.gnu.org; 7 Feb 2023 15:21:54 +0000 Original-Received: from localhost ([127.0.0.1]:53771 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pPPn6-0007YV-3p for submit@debbugs.gnu.org; Tue, 07 Feb 2023 10:21:53 -0500 Original-Received: from mail-108-mta40.mxroute.com ([136.175.108.40]:38349) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pPPn2-0007YC-L3 for 60428@debbugs.gnu.org; Tue, 07 Feb 2023 10:21:50 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta40.mxroute.com (ZoneMTA) with ESMTPSA id 1862c77dd44000011e.001 for <60428@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Tue, 07 Feb 2023 15:21:38 +0000 X-Zone-Loop: 3765a7de8b2d95011927fe187d6b495eec1522321965 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=db+kZDp9akwUwYpo8PmfjUn+OEzRNvpOOPKciAYKNj4=; b=WfvLCp4fVFDpCZL8/anL08703F 9NWntKR1iL+EhkXQ1LYlsMUOpDizm5zdmRjzoI2Wds9B+/BAIBg6GQxKWYzpfsll8wYmEWdJV02Cq o2k4EuMjNJDYETHPFgeDzp6434eyk8EZM8VNLbD23sIrEPgvPmGA9ty7kl4tcvcCHgM2tJH5wbiCL TjootoUvN9/tXnUXIXStCKTm1WHG6D8GTyPCMoUsa2UQfpQZlvz7Rynuvrtq8YMMA3IiknE1Fz8sC 1ZYpyrkgU523iC/TFhk8WwjZKb5vwj9lmdBgVd78Lj+BaEuL5nJoNCx0liSCAvz6LOEa0EhLvLj6F Dn0cy2QA==; In-Reply-To: <87mt750ygt.fsf@neverwas.me> (J. P.'s message of "Fri, 30 Dec 2022 06:15:30 -0800") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:255058 Archived-At: --=-=-= Content-Type: text/plain v3. Don't shadow special vars in entry-point lambda lists. Improve tests. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From 797e9cce1ad3fc34fc59ddbadd9d28d017955b59 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 7 Feb 2023 00:02:26 -0800 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (3): [5.6] Be smarter about switching to TLS from M-x erc [5.6] Add display option for interactive ERC invocations [5.6] Optionally prompt for more ERC entry-point params doc/misc/erc.texi | 2 +- lisp/erc/erc.el | 108 ++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 146 +++++++++++++++++++++++++++++++------ 3 files changed, 199 insertions(+), 57 deletions(-) Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 691e865bfa4..6aec59e6f11 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2234,15 +2234,27 @@ erc-select-read-args (eql port erc-default-port) (y-or-n-p "Connect using TLS instead? ") (setq port erc-default-port-tls))) - #'erc-open-tls-stream))) + #'erc-open-tls-stream)) + env) + (when erc-interactive-display + (push `(erc-join-buffer . ,erc-interactive-display) env)) + (when opener + (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) (setq passwd nil)) `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) - ,@(and erc-interactive-display - `(buffer-display ,erc-interactive-display)) - ,@(and opener `(connect-function ,opener))))) - + ,@(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)) @@ -2252,10 +2264,8 @@ erc password (full-name (erc-compute-full-name)) id - ;; For interactive use - ((buffer-display erc-join-buffer) erc-join-buffer) - ((connect-function erc-server-connect-function) - erc-server-connect-function)) + ;; 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. @@ -2282,7 +2292,8 @@ erc \(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) @@ -2297,13 +2308,8 @@ erc-tls (full-name (erc-compute-full-name)) client-certificate id - ;; For interactive use - ((buffer-display erc-join-buffer) erc-join-buffer) - ((connect-function erc-server-connect-function) - (if (eq erc-server-connect-function - #'erc-open-network-stream) - #'erc-open-tls-stream - erc-server-connect-function))) + ;; 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. @@ -2352,7 +2358,12 @@ erc-tls \(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))) - (progn + (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 1029a38c726..8f44d984f09 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -999,6 +999,13 @@ 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 ("Prompts for switch to TLS by default") @@ -1007,8 +1014,9 @@ erc-select-read-args (list :server "irc.libera.chat" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when port matches default TLS port") (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" @@ -1016,8 +1024,9 @@ erc-select-read-args (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when URL is ircs://") (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" @@ -1025,8 +1034,9 @@ erc-select-read-args (list :server "irc.gnu.org" :port 6697 :nick (user-login-name) - 'buffer-display 'buffer - 'connect-function #'erc-open-tls-stream)))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (setq-local erc-interactive-display nil) ; cheat to save space @@ -1100,17 +1110,25 @@ erc-select-read-args :full-name "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-join-buffer ,erc-join-buffer) + (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-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Full") (erc-tls :server "irc.gnu.org" @@ -1123,7 +1141,10 @@ 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-join-buffer bury) + (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 @@ -1139,7 +1160,56 @@ 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-join-buffer bury) + (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-join-buffer buffer) (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-join-buffer ,erc-join-buffer) + (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-join-buffer buffer) (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-join-buffer buffer) + (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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Be-smarter-about-switching-to-TLS-from-M-x-erc.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Add-display-option-for-interactive-ERC-invocatio.patch >From 481a720ade4da70e5aeb76ade67e0ff710df15ee Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 29 Dec 2022 06:43:19 -0800 Subject: [PATCH 2/3] [5.6] Add display option for interactive ERC invocations * lisp/erc/erc.el (erc-buffer-display, erc-receive-query-display): Add aliases for `erc-join-buffer' and `erc-auto-query'. (erc-interactive-display): Add new option to control display of server buffers during interactive entry-point invocations. (erc-select-read-args): Pass `erc-interactive-display' to entry points. * test/lisp/erc/erc-tests.el (erc-select-read-args): Expect buffer-display values from `erc-interactive-display'. (erc-tls, erc--interactive): Also check `erc-join-buffer' in environment when `erc-open' called. (Bug#60428.) --- lisp/erc/erc.el | 17 ++++++++++++++++ test/lisp/erc/erc-tests.el | 41 ++++++++++++++++++++++++-------------- 2 files changed, 43 insertions(+), 15 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ba6055e1b93..05e124bc165 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1468,6 +1468,7 @@ erc-default-port-tls "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") +(defvaralias 'erc-buffer-display 'erc-join-buffer) (defcustom erc-join-buffer 'bury "Determines how to display a newly created IRC buffer. @@ -1488,6 +1489,19 @@ erc-join-buffer (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) +(defcustom erc-interactive-display 'buffer + "How and whether to display server buffers for M-x erc. +See `erc-buffer-display' and friends for a description of +possible values." + :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA + :group 'erc-buffers + :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury new and don't display existing" bury) + (const :tag "Use current buffer" buffer))) + (defcustom erc-reconnect-display nil "How (and whether) to display a channel buffer upon reconnecting. @@ -2213,6 +2227,8 @@ erc-select-read-args (setq port erc-default-port-tls))) #'erc-open-tls-stream)) env) + (when erc-interactive-display + (push `(erc-join-buffer . ,erc-interactive-display) env)) (when opener (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) @@ -4520,6 +4536,7 @@ erc-query (with-current-buffer server-buffer (erc--open-target target))) +(defvaralias 'erc-receive-query-display 'erc-auto-query) (defcustom erc-auto-query 'window-noselect "If non-nil, create a query buffer each time you receive a private message. If the buffer doesn't already exist, it is created. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5d2a023486d..91ed5c330f6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1014,8 +1014,9 @@ 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)))))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when port matches default TLS port") (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" @@ -1023,8 +1024,9 @@ 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)))))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) (ert-info ("Switches to TLS when URL is ircs://") (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" @@ -1032,8 +1034,11 @@ 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)))))) + '&interactive-env + '((erc-server-connect-function . erc-open-tls-stream) + (erc-join-buffer . buffer)))))) + + (setq-local erc-interactive-display nil) ; cheat to save space (ert-info ("Opt out of non-TLS warning manually") (should (equal (ert-simulate-keys "\r\r\r\rn\r" @@ -1099,7 +1104,8 @@ erc-tls (lambda (&optional _) "tester")) ((symbol-function 'erc-open) (lambda (&rest r) - (push `((erc-server-connect-function + (push `((erc-join-buffer ,erc-join-buffer) + (erc-server-connect-function ,erc-server-connect-function)) env) (push r calls)))) @@ -1110,7 +1116,8 @@ erc-tls '("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))))) + '((erc-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Full") (erc-tls :server "irc.gnu.org" @@ -1125,7 +1132,8 @@ erc-tls '("irc.gnu.org" 7000 "bob" "Bob's Name" t "bob:changeme" nil nil nil t "bobo" GNU.org))) (should (equal (pop env) - '((erc-server-connect-function erc-open-tls-stream))))) + '((erc-join-buffer bury) + (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 @@ -1143,7 +1151,8 @@ erc-tls '(nil 7000 nil "Bob's Name" t "bob:changeme" nil nil nil nil "bobo" nil))) (should (equal (pop env) - '((erc-server-connect-function erc-open-tls-stream))))) + '((erc-join-buffer bury) + (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Interactive") (ert-simulate-keys "nick:sesame@localhost:6667\r\r" @@ -1152,8 +1161,8 @@ erc-tls '("localhost" 6667 "nick" "unknown" t "sesame" nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-server-connect-function - erc-open-tls-stream)))))))) + '((erc-join-buffer buffer) (erc-server-connect-function + erc-open-tls-stream)))))))) ;; See `erc-select-read-args' above for argument parsing. ;; This only tests the "hidden" arguments. @@ -1164,7 +1173,8 @@ erc--interactive (lambda (&optional _) "tester")) ((symbol-function 'erc-open) (lambda (&rest r) - (push `((erc-server-connect-function + (push `((erc-join-buffer ,erc-join-buffer) + (erc-server-connect-function ,erc-server-connect-function)) env) (push r calls)))) @@ -1176,7 +1186,8 @@ erc--interactive '("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))))) + '((erc-join-buffer buffer) (erc-server-connect-function + erc-open-tls-stream))))) (ert-info ("Nick supplied, decline TLS upgrade") (ert-simulate-keys "\r\rdummy\r\rn\r" @@ -1185,7 +1196,7 @@ erc--interactive '("irc.libera.chat" 6667 "dummy" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '( + '((erc-join-buffer buffer) (erc-server-connect-function erc-open-network-stream)))))))) -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Optionally-prompt-for-more-ERC-entry-point-param.patch >From 797e9cce1ad3fc34fc59ddbadd9d28d017955b59 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 29 Dec 2022 06:43:19 -0800 Subject: [PATCH 3/3] [5.6] Optionally prompt for more ERC entry-point params * doc/misc/erc.texi: Update statement about availability of user param when entry points called interactively. * lisp/erc/erc.el (erc-select-read-args): Allow optionally calling entry points with a prefix arg to access params `user' and `:full-name'. (erc-tls): Update doc string. * test/lisp/erc/erc-tests.el (erc-select-read-args): Add test for extra args. (Bug#60428.) --- doc/misc/erc.texi | 2 +- lisp/erc/erc.el | 19 ++++++++++++++----- test/lisp/erc/erc-tests.el | 13 ++++++++++++- 3 files changed, 27 insertions(+), 7 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 8030dfa4bb7..94b98ed5e64 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -951,7 +951,7 @@ SASL your @samp{NickServ} password. To make this work, customize @code{erc-sasl-user} and @code{erc-sasl-password} or specify the @code{:user} and @code{:password} keyword arguments when invoking -@code{erc-tls}. Note that @code{:user} cannot be given interactively. +@code{erc-tls}. @item @code{external} (via Client TLS Certificate) This works in conjunction with the @code{:client-certificate} keyword diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 05e124bc165..6aec59e6f11 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2192,7 +2192,8 @@ erc--ensure-url ;;;###autoload (defun erc-select-read-args () - "Prompt the user for values of nick, server, port, and password." + "Prompt the user for values of nick, server, port, and password. +With prefix arg, also prompt for user and full name." (require 'url-parse) (let* ((input (let ((d (erc-compute-server))) (read-string (format "Server or URL (default is %S): " d) @@ -2213,6 +2214,14 @@ erc-select-read-args (let ((d (erc-compute-nick))) (read-string (format "Nickname (default is %S): " d) nil 'erc-nick-history-list d)))) + (user (and current-prefix-arg + (let ((d (erc-compute-user (url-user url)))) + (read-string (format "User (default is %S): " d) + nil nil d)))) + (full (and current-prefix-arg + (let ((d (erc-compute-full-name (url-user url)))) + (read-string (format "Full name (default is %S): " d) + nil nil d)))) (passwd (let* ((p (with-suppressed-warnings ((obsolete erc-password)) (or (url-password url) erc-password))) (m (if p @@ -2233,8 +2242,8 @@ erc-select-read-args (push `(erc-server-connect-function . ,opener) env)) (when (and passwd (string= "" passwd)) (setq passwd nil)) - `( :server ,server :port ,port :nick ,nick - ,@(and passwd `(:password ,passwd)) + `( :server ,server :port ,port :nick ,nick ,@(and user `(:user ,user)) + ,@(and passwd `(:password ,passwd)) ,@(and full `(:full-name ,full)) ,@(and env `(&interactive-env ,env))))) (defmacro erc--with-entrypoint-environment (env &rest body) @@ -2342,8 +2351,8 @@ erc-tls 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 +See info node `(erc) Network Identifier' for details. Like +CLIENT-CERTIFICATE, this parameter cannot be specified interactively. \(fn &key SERVER PORT NICK USER PASSWORD FULL-NAME CLIENT-CERTIFICATE ID)" diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 91ed5c330f6..8f44d984f09 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1096,7 +1096,18 @@ erc-select-read-args (erc-select-read-args)) (list :server "[::1]" :port 6667 - :nick "nick"))))) + :nick "nick")))) + + (ert-info ("Extra args use URL nick by default") + (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r\r\r\r" + (let ((current-prefix-arg '(4))) + (erc-select-read-args))) + (list :server "localhost" + :port 6667 + :nick "nick" + :user "nick" + :password "sesame" + :full-name "nick"))))) (ert-deftest erc-tls () (let (calls env) -- 2.39.1 --=-=-=--