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: Sun, 19 Feb 2023 07:05:17 -0800 Message-ID: <87h6vhwv9u.fsf__20832.0856023178$1676819185$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="34014"; 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 Sun Feb 19 16:06:17 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 1pTlGb-0008fM-5U for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 19 Feb 2023 16:06:17 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pTlGO-0001vh-O8; Sun, 19 Feb 2023 10:06:04 -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 1pTlGM-0001p2-Gu for bug-gnu-emacs@gnu.org; Sun, 19 Feb 2023 10:06: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 1pTlGM-0001VV-85 for bug-gnu-emacs@gnu.org; Sun, 19 Feb 2023 10:06:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pTlGM-0001xN-3D for bug-gnu-emacs@gnu.org; Sun, 19 Feb 2023 10:06:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 19 Feb 2023 15:06:02 +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.16768191337482 (code B ref 60428); Sun, 19 Feb 2023 15:06:02 +0000 Original-Received: (at 60428) by debbugs.gnu.org; 19 Feb 2023 15:05:33 +0000 Original-Received: from localhost ([127.0.0.1]:49464 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pTlFr-0001wZ-Nf for submit@debbugs.gnu.org; Sun, 19 Feb 2023 10:05:33 -0500 Original-Received: from mail-108-mta56.mxroute.com ([136.175.108.56]:41861) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pTlFo-0001wK-D5 for 60428@debbugs.gnu.org; Sun, 19 Feb 2023 10:05:30 -0500 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta56.mxroute.com (ZoneMTA) with ESMTPSA id 1866a35435e000edb4.001 for <60428@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Sun, 19 Feb 2023 15:05:20 +0000 X-Zone-Loop: 8b64eb7fc2bee96ce186cbc39167d26e8e24fd9d756e 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=A3P6+h0QlRPFP5TbZYZ5Glx0qOQisgk5lJN8hMBJOcI=; b=L+YBHfc6e4WcGYJV9YD3AB0i77 g+7dr6jxJviH+PY03OrMbm6c1yS/Y+4Mn5z+Q3eC+xeNc/564aHwFwoVsKFwsGl5EB+SvgsLeURd0 DrQMjwsY5HWvzv9SHx3B3Da/mx846zZYRtwBejCBHv5sIeScCtwanqjzBbpksyOEk0S+T14f6gjYQ 6eP7SMmCswCQ1YWg+yxnRA/eKxyZ5Cz0aLPMpZ5/o1GSlaO5tnQyr5E56brPhjslsSDnguT9pT/RL +WK9xTpboBAcQoa0+u1eHpp2UOc0hEAIJ2lCZJ5p66DTKyBxPEcuw0Uoh/Bd/6Nn8IdsSCC376xp+ qGJfjBEA==; 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:256078 Archived-At: --=-=-= Content-Type: text/plain v4. Stop requiring `url-parse' library when compiling. Improve test. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v3-v4.diff >From c348a0162a84f97627bb7b9b613d6c88a12a03e7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 17 Feb 2023 00:03:19 -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-compat.el | 3 +- lisp/erc/erc.el | 120 ++++++++++++++++-------- test/lisp/erc/erc-tests.el | 182 ++++++++++++++++++++++++++++++++----- 4 files changed, 247 insertions(+), 60 deletions(-) Interdiff: diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 5601ede27a5..d475d9cf458 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -32,7 +32,7 @@ ;;; Code: (require 'compat nil 'noerror) -(eval-when-compile (require 'cl-lib) (require 'url-parse)) +(eval-when-compile (require 'cl-lib)) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode @@ -378,6 +378,7 @@ erc-compat--with-memoization (t `(progn ,@forms)))) (defvar url-irc-function) +(declare-function url-type "url-parse" (cl-x)) (defun erc-compat--29-browse-url-irc (string &rest _) (require 'url-irc) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 12d148d767f..f1a51341924 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -69,7 +69,7 @@ (require 'auth-source) (require 'time-date) (require 'iso8601) -(eval-when-compile (require 'subr-x) (require 'url-parse)) +(eval-when-compile (require 'subr-x)) (defconst erc-version "5.4.1" "This version of ERC.") @@ -139,6 +139,12 @@ tabbar--local-hlf (defvar motif-version-string) (defvar gtk-version-string) +(declare-function url-host "url-parse" (cl-x)) +(declare-function url-password "url-parse" (cl-x)) +(declare-function url-portspec "url-parse" (cl-x)) +(declare-function url-type "url-parse" (cl-x)) +(declare-function url-user "url-parse" (cl-x)) + ;; tunable connection and authentication parameters (defcustom erc-server nil @@ -1493,7 +1499,7 @@ erc-interactive-display "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 + :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-buffers :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) (const :tag "Split window and select" window) @@ -2194,7 +2200,6 @@ erc--ensure-url (defun erc-select-read-args () "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) nil 'erc-server-history-list d))) @@ -2358,8 +2363,11 @@ 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))) + ;; 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--) - ;; 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--)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8f44d984f09..68b4413da44 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1172,8 +1172,44 @@ erc-tls '("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)))))))) + '((erc-join-buffer buffer) + (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-join-buffer bury) + (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-join-buffer bury) + (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-join-buffer bury) + (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. -- 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 f782019a999bd94ddcb425458f114123d2e472dc 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 | 79 ++++++++++-------- test/lisp/erc/erc-tests.el | 159 +++++++++++++++++++++++++++++++------ 2 files changed, 184 insertions(+), 54 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d35907a1677..ff91378ce79 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,20 @@ 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)) + ;; 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))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 40a2d2de657..03df72d9500 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,86 @@ 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))))) + + (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) -- 2.39.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.6-Add-display-option-for-interactive-ERC-invocatio.patch >From 093763faa5282f25ac238b8433715d6912b27398 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 | 50 ++++++++++++++++++++++++-------------- 2 files changed, 49 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ff91378ce79..9dbca09bb35 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.6") ; FIXME sync on release + :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)) @@ -4523,6 +4539,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 03df72d9500..4edd72aade4 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))))) (ert-info ("Custom connect function") (let ((erc-server-connect-function 'my-connect-func)) @@ -1162,7 +1171,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 my-connect-func)))))) + '((erc-join-buffer bury) + (erc-server-connect-function my-connect-func)))))) (ert-info ("Advised default function overlooked") ; intentional (advice-add 'erc-server-connect-function :around #'ignore @@ -1172,7 +1182,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)))) (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls)) (ert-info ("Advised non-default function honored") @@ -1184,7 +1195,8 @@ 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)))) + (should (equal (pop env) `((erc-join-buffer bury) + (erc-server-connect-function ,f)))) (advice-remove 'erc-server-connect-function 'erc-tests--erc-tls))))))) @@ -1197,7 +1209,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)))) @@ -1209,7 +1222,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" @@ -1218,7 +1232,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 c348a0162a84f97627bb7b9b613d6c88a12a03e7 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/compat.el: Don't require `url-parse' when compiling. Add forward declaration for `url-type'. * lisp/erc/erc.el: Don't require `url-parse' when compiling. Add forward declarations for url accessors of url struct from url-parse library. (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-compat.el | 3 ++- lisp/erc/erc.el | 28 +++++++++++++++++++++------- test/lisp/erc/erc-tests.el | 13 ++++++++++++- 4 files changed, 36 insertions(+), 10 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index d5ec0f48e1c..d60d7fc8f2d 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -952,7 +952,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-compat.el b/lisp/erc/erc-compat.el index 5601ede27a5..d475d9cf458 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -32,7 +32,7 @@ ;;; Code: (require 'compat nil 'noerror) -(eval-when-compile (require 'cl-lib) (require 'url-parse)) +(eval-when-compile (require 'cl-lib)) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode @@ -378,6 +378,7 @@ erc-compat--with-memoization (t `(progn ,@forms)))) (defvar url-irc-function) +(declare-function url-type "url-parse" (cl-x)) (defun erc-compat--29-browse-url-irc (string &rest _) (require 'url-irc) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 9dbca09bb35..f1a51341924 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -69,7 +69,7 @@ (require 'auth-source) (require 'time-date) (require 'iso8601) -(eval-when-compile (require 'subr-x) (require 'url-parse)) +(eval-when-compile (require 'subr-x)) (defconst erc-version "5.4.1" "This version of ERC.") @@ -139,6 +139,12 @@ tabbar--local-hlf (defvar motif-version-string) (defvar gtk-version-string) +(declare-function url-host "url-parse" (cl-x)) +(declare-function url-password "url-parse" (cl-x)) +(declare-function url-portspec "url-parse" (cl-x)) +(declare-function url-type "url-parse" (cl-x)) +(declare-function url-user "url-parse" (cl-x)) + ;; tunable connection and authentication parameters (defcustom erc-server nil @@ -2192,8 +2198,8 @@ erc--ensure-url ;;;###autoload (defun erc-select-read-args () - "Prompt the user for values of nick, server, port, and password." - (require 'url-parse) + "Prompt the user for values of nick, server, port, and password. +With prefix arg, also prompt for user and full name." (let* ((input (let ((d (erc-compute-server))) (read-string (format "Server or URL (default is %S): " d) nil 'erc-server-history-list d))) @@ -2213,6 +2219,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 +2247,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 +2356,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 4edd72aade4..68b4413da44 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 --=-=-=--