master ed5022b4ee 10/10: Improve new connections in erc-handle-irc-url

[F. Jason Park]

branch: master
commit ed5022b4eec676bd6c0509615a1f939b796b942b
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Improve new connections in erc-handle-irc-url
    
    * doc/misc/erc.texi: Add new Integrations section to the info manual
    under Advanced Usage.
    * etc/ERC-NEWS: Add new section mentioning improved UX when clicking
    on irc:// links.
    
    * lisp/erc/erc.el (erc-handle-irc-url): Add optional "scheme"
    parameter.  Fix `erc-open' invocation so that the server buffer is
    named correctly by deferring to a new customizable opener.  Arrange
    for JOINing a channel in a manner similar to ERC's autojoin module.
    (erc-url-connect-function): Add new option for creating a new ERC
    connection based on info parsed from a URL.
    (erc--url-default-connect-function): New function to serve as an
    interactive-only fallback when a user hasn't specified a URL connect
    function.
    * lisp/erc/erc-compat.el (erc-compat--29-browse-url--irc): Add new
    compatibility function for `browse-url-irc' and include it in
    `browse-url-default-handlers' on Emacs versions below 29.
    
    * test/lisp/erc/erc-tests.el (erc-tests--make-server-buf,
    erc-tests--make-client-buf): Add helpers for creating dummy ERC
    buffers.
    (erc-handle-irc-url): Add test.
    * test/lisp/erc/erc-scenarios-misc.el (erc-scenarios-handle-irc-url):
    Add new test.
    * test/lisp/erc/resources/join/legacy/foonet.eld: Relax
    timeout.  (Bug#56514.)
---
 doc/misc/erc.texi                              | 28 ++++++++
 etc/ERC-NEWS                                   |  7 ++
 lisp/erc/erc-compat.el                         | 32 ++++++++-
 lisp/erc/erc.el                                | 92 ++++++++++++++++++++-----
 test/lisp/erc/erc-scenarios-misc.el            | 28 ++++++++
 test/lisp/erc/erc-tests.el                     | 94 ++++++++++++++++++++++++++
 test/lisp/erc/resources/join/legacy/foonet.eld |  2 +-
 7 files changed, 263 insertions(+), 20 deletions(-)

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index ad35b78f0e..0d807e323e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -79,6 +79,7 @@ Advanced Usage
 
 * Connecting::                  Ways of connecting to an IRC server.
 * Sample Configuration::        An example configuration file.
+* Integrations::                Integrations available for ERC.
 * Options::                     Options that are available for ERC.
 
 @end detailmenu
@@ -526,6 +527,7 @@ Translate morse code in messages
 @menu
 * Connecting::                  Ways of connecting to an IRC server.
 * Sample Configuration::        An example configuration file.
+* Integrations::                Integrations available for ERC.
 * Options::                     Options that are available for ERC.
 @end menu
 
@@ -991,6 +993,32 @@ stuff, to the current ERC buffer."
 ;; (setq erc-kill-server-buffer-on-quit t)
 @end lisp
 
+@node Integrations
+@section Integrations
+@cindex integrations
+
+@subheading URL
+For anything to work, you'll want to set @code{url-irc-function} to
+@code{url-irc-erc}.  As a rule of thumb, libraries relying directly on
+@code{url-retrieve} should be fine out the box from Emacs 29.1 onward.
+On older versions of Emacs, you may need to @code{(require 'erc)}
+beforehand. @pxref{Retrieving URLs,,, url, URL}.
+
+For other apps and libraries, such as those relying on the
+higher-level @code{browse-url}, you'll oftentimes be asked to specify
+a pattern, sometimes paired with a function that accepts a string URL
+as a first argument.  For example, with EWW, you may need to tack
+something like @code{"\\|\\`irc6?s?:"} onto the end of
+@code{eww-use-browse-url}.  But with @code{gnus-button-alist}, you'll
+need a function as well:
+
+@lisp
+  '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 0)
+@end lisp
+
+@noindent
+Users on Emacs 28 and below may need to use @code{browse-url} instead.
+
 @node Options
 @section Options
 @cindex options
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 5cabb9b015..f638d4717a 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -77,6 +77,13 @@ blanks when 'erc-send-whitespace-lines' is active.  New 
options have
 also been added for warning when input spans multiple lines.  Although
 off by default, new users are encouraged to enable them.
 
+** URL handling has improved.
+Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does
+the right thing most of the time.  However, for security reasons,
+users are now prompted to confirm connection parameters prior to lift
+off.  See the new '(erc) Integrations' section in the Info manual to
+override this.
+
 ** Miscellaneous behavioral changes impacting the user experience.
 A bug has been fixed that saw prompts being mangled, doubled, or
 erased in server buffers upon disconnection.  Instead, input prompts
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 5b54a0587a..d23703394b 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,8 +32,7 @@
 ;;; Code:
 
 (require 'compat nil 'noerror)
-(eval-when-compile (require 'cl-lib))
-
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
 
 ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
 (define-obsolete-function-alias 'erc-define-minor-mode
@@ -285,6 +284,35 @@ If START or END is negative, it counts from the end."
     `(cl--generic-with-memoization ,table ,@forms))
    (t `(progn ,@forms))))
 
+(defvar url-irc-function)
+
+(defun erc-compat--29-browse-url-irc (string &rest _)
+  (require 'url-irc)
+  (let* ((url (url-generic-parse-url string))
+         (url-irc-function
+          (if (function-equal url-irc-function 'url-irc-erc)
+              (lambda (host port chan user pass)
+                (erc-handle-irc-url host port chan user pass (url-type url)))
+            url-irc-function)))
+    (url-irc url)))
+
+(cond ((fboundp 'browse-url-irc)) ; 29
+      ((boundp 'browse-url-default-handlers) ; 28
+       (cl-pushnew '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+                   browse-url-default-handlers))
+      ((boundp 'browse-url-browser-function) ; 27
+       (require 'browse-url)
+       (let ((existing browse-url-browser-function))
+         (setq browse-url-browser-function
+               (if (functionp existing)
+                   (lambda (u &rest r)
+                     (apply (if (string-match-p "\\`irc6?s?://" u)
+                                #'erc-compat--29-browse-url-irc
+                              existing)
+                            u r))
+                 (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+                       existing))))))
+
 (provide 'erc-compat)
 
 ;;; erc-compat.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 897357e16b..2312246e3e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7186,25 +7186,83 @@ This function should be on `erc-kill-channel-hook'."
 ;; Teach url.el how to open irc:// URLs with ERC.
 ;; To activate, customize `url-irc-function' to `url-irc-erc'.
 
-;; FIXME change user to nick, and use API to find server buffer
+(defcustom erc-url-connect-function nil
+  "When non-nil, a function used to connect to an IRC URL.
+Called with a string meant to represent a URL scheme, like
+\"ircs\", followed by any number of keyword arguments recognized
+by `erc' and `erc-tls'."
+  :group 'erc
+  :package-version '(ERC . "5.4.1") ; FIXME increment on release
+  :type '(choice (const nil) function))
+
+(defun erc--url-default-connect-function (scheme &rest plist)
+  (let* ((ircsp (if scheme
+                    (string-suffix-p "s" scheme)
+                  (or (eql 6697 (plist-get plist :port))
+                      (yes-or-no-p "Connect using TLS? "))))
+         (erc-server (plist-get plist :server))
+         (erc-port (or (plist-get plist :port)
+                       (and ircsp (erc-normalize-port 'ircs-u))
+                       erc-port))
+         (erc-nick (or (plist-get plist :nick) erc-nick))
+         (erc-password (plist-get plist :password))
+         (args (erc-select-read-args)))
+    (unless ircsp
+      (setq ircsp (eql 6697 erc-port)))
+    (apply (if ircsp #'erc-tls #'erc) args)))
+
 ;;;###autoload
-(defun erc-handle-irc-url (host port channel user password)
-  "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
+(defun erc-handle-irc-url (host port channel nick password &optional scheme)
+  "Use ERC to IRC on HOST:PORT in CHANNEL.
 If ERC is already connected to HOST:PORT, simply /join CHANNEL.
-Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
-  (let ((server-buffer
-         (car (erc-buffer-filter
-               (lambda ()
-                 (and (string-equal erc-session-server host)
-                      (= erc-session-port port)
-                      (erc-open-server-buffer-p)))))))
-    (with-current-buffer (or server-buffer (current-buffer))
-      (if (and server-buffer channel)
-          (erc-cmd-JOIN channel)
-        (erc-open host port (or user (erc-compute-nick)) 
(erc-compute-full-name)
-                  (not server-buffer) password nil channel
-                  (when server-buffer
-                    (get-buffer-process server-buffer)))))))
+Otherwise, connect to HOST:PORT as NICK and /join CHANNEL.
+
+Beginning with ERC 5.5, new connections require human intervention.
+Customize `erc-url-connect-function' to override this."
+  (when (eql port 0) (setq port nil))
+  (let* ((net (erc-networks--determine host))
+         (server-buffer
+          ;; Viable matches may slip through the cracks for unknown
+          ;; networks.  Additional passes could likely improve things.
+          (car (erc-buffer-filter
+                (lambda ()
+                  (and (not erc--target)
+                       (erc-server-process-alive)
+                       ;; Always trust a matched network.
+                       (or (and net (eq net (erc-network)))
+                           (and (string-equal erc-session-server host)
+                                ;; Ports only matter when dialed hosts
+                                ;; match and we have sufficient info.
+                                (or (not port)
+                                    (= (erc-normalize-port erc-session-port)
+                                       port)))))))))
+         key deferred)
+    (unless server-buffer
+      (setq deferred t
+            server-buffer (apply (or erc-url-connect-function
+                                     #'erc--url-default-connect-function)
+                                 scheme
+                                 :server host
+                                 `(,@(and port (list :port port))
+                                   ,@(and nick (list :nick nick))
+                                   ,@(and password `(:password ,password))))))
+    (when channel
+      ;; These aren't percent-decoded by default
+      (when (string-prefix-p "%" channel)
+        (setq channel (url-unhex-string channel)))
+      (cl-multiple-value-setq (channel key) (split-string channel "[?]"))
+      (if deferred
+          ;; Alternatively, we could make this a defmethod, so when
+          ;; autojoin is loaded, it can do its own thing.  Also, as
+          ;; with `erc-once-with-server-event', it's fine to set local
+          ;; hooks here because they're killed when reconnecting.
+          (with-current-buffer server-buffer
+            (letrec ((f (lambda (&rest _)
+                          (remove-hook 'erc-after-connect f t)
+                          (erc-cmd-JOIN channel key))))
+              (add-hook 'erc-after-connect f nil t)))
+        (with-current-buffer server-buffer
+          (erc-cmd-JOIN channel key))))))
 
 (provide 'erc)
 
diff --git a/test/lisp/erc/erc-scenarios-misc.el 
b/test/lisp/erc/erc-scenarios-misc.el
index ded620ccc1..8557a77906 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -177,4 +177,32 @@
         (erc-scenarios-common-say "Hi")
         (funcall expect 10 "Hola")))))
 
+(defvar url-irc-function)
+
+(ert-deftest erc-scenarios-handle-irc-url ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "join/legacy")
+       (dumb-server (erc-d-run "localhost" t 'foonet))
+       (port (process-contact dumb-server :service))
+       (expect (erc-d-t-make-expecter))
+       (url-irc-function 'url-irc-erc)
+       (erc-url-connect-function
+        (lambda (scheme &rest r)
+          (ert-info ("Connect to foonet")
+            (should (equal scheme "irc"))
+            (with-current-buffer (apply #'erc `(:full-name "tester" ,@r))
+              (should (string= (buffer-name)
+                               (format "127.0.0.1:%d" port)))
+              (current-buffer))))))
+
+    (with-temp-buffer
+      (insert (format ";; irc://tester:changeme@127.0.0.1:%d/#chan" port))
+      (goto-char 10)
+      (browse-url-at-point))
+
+    (ert-info ("Connected")
+      (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+        (funcall expect 10 "welcome")))))
+
 ;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index db54cb4889..a5100ec155 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1084,4 +1084,98 @@
                        '(nil 7000 nil "Bob's Name" t
                              "bob:changeme" nil nil nil nil "bobo" nil)))))))
 
+(defun erc-tests--make-server-buf (name)
+  (with-current-buffer (get-buffer-create name)
+    (erc-mode)
+    (setq erc-server-process (start-process "sleep" (current-buffer)
+                                            "sleep" "1")
+          erc-session-server (concat "irc." name ".org")
+          erc-session-port 6667
+          erc-network (intern name))
+    (set-process-query-on-exit-flag erc-server-process nil)
+    (current-buffer)))
+
+(defun erc-tests--make-client-buf (server name)
+  (unless (bufferp server)
+    (setq server (get-buffer server)))
+  (with-current-buffer (get-buffer-create name)
+    (erc-mode)
+    (setq erc--target (erc--target-from-string name))
+    (dolist (v '(erc-server-process
+                 erc-session-server
+                 erc-session-port
+                 erc-network))
+      (set v (buffer-local-value v server)))
+    (current-buffer)))
+
+(ert-deftest erc-handle-irc-url ()
+  (let* (calls
+         rvbuf
+         erc-networks-alist
+         erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
+         (erc-url-connect-function
+          (lambda (&rest r)
+            (push r calls)
+            (if (functionp rvbuf) (funcall rvbuf) rvbuf))))
+
+    (cl-letf (((symbol-function 'erc-cmd-JOIN)
+               (lambda (&rest r) (push r calls))))
+
+      (with-current-buffer (erc-tests--make-server-buf "foonet")
+        (setq rvbuf (current-buffer)))
+      (erc-tests--make-server-buf "barnet")
+      (erc-tests--make-server-buf "baznet")
+
+      (ert-info ("Unknown network")
+        (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc")
+        (should (equal '("#chan" nil) (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Unknown network, no port")
+        (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+        (should (equal '("#chan" nil) (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Known network, no port")
+        (setq erc-networks-alist '((foonet "irc.foonet.org")))
+        (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+        (should (equal '("#chan" nil) (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Known network, different port")
+        (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil "irc")
+        (should (equal '("#chan" nil) (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Known network, existing chan with key")
+        (erc-tests--make-client-buf "foonet" "#chan")
+        (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc")
+        (should (equal '("#chan" "sec") (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Unknown network, connect, no chan")
+        (erc-handle-irc-url "irc.gnu.org" nil nil nil nil "irc")
+        (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+        (should-not calls))
+
+      (ert-info ("Unknown network, connect, chan")
+        (with-current-buffer "foonet"
+          (should-not (local-variable-p 'erc-after-connect)))
+        (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu")))
+        (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc")
+        (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+        (should-not calls)
+        (with-current-buffer "gnu"
+          (should (local-variable-p 'erc-after-connect))
+          (funcall (car erc-after-connect))
+          (should (equal '("#spam" nil) (pop calls)))
+          (should-not (local-variable-p 'erc-after-connect)))
+        (should-not calls))))
+
+  (when noninteractive
+    (kill-buffer "foonet")
+    (kill-buffer "barnet")
+    (kill-buffer "baznet")
+    (kill-buffer "#chan")))
+
 ;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/join/legacy/foonet.eld 
b/test/lisp/erc/resources/join/legacy/foonet.eld
index 344ba7c1da..4025094a59 100644
--- a/test/lisp/erc/resources/join/legacy/foonet.eld
+++ b/test/lisp/erc/resources/join/legacy/foonet.eld
@@ -1,5 +1,5 @@
 ;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
 ((nick 1 "NICK tester"))
 ((user 1 "USER user 0 * :tester")
  (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")