From 2d35563e0ac22686bb69100536692cb026fc67f2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 5/5] Improve new connections in erc-handle-irc-url * 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 add it to `browse-url-default-handlers' on Emacs versions below 29. * 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 ++++++ lisp/erc/erc-compat.el | 19 ++++ lisp/erc/erc.el | 92 ++++++++++++++---- test/lisp/erc/erc-scenarios-misc.el | 28 ++++++ test/lisp/erc/erc-tests.el | 95 +++++++++++++++++++ .../lisp/erc/resources/join/legacy/foonet.eld | 2 +- 6 files changed, 246 insertions(+), 18 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9..9742fc3c22 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -79,6 +79,7 @@ Top * 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 @@ Advanced Usage @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 @@ -990,6 +992,32 @@ Sample Configuration ;; (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/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f1352..340d90ba96 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -32,6 +32,7 @@ ;;; Code: (require 'compat nil 'noerror) +(eval-when-compile (require 'url-parse)) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode @@ -168,6 +169,24 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +(defvar url-irc-function) + +(defun erc-compat--29-browse-url-irc (string &rest _) + (cl-assert (< emacs-major-version 29)) + (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))) + +(when (< emacs-major-version 29) + (unless (assoc "\\`irc6?s?://" browse-url-default-handlers) + (push '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) + browse-url-default-handlers))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 28370d7724..cfd1c34ef0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7169,25 +7169,83 @@ erc-get-parsed-vector-type ;; 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-dcc-chat-accept (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..f83e8c8717 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1084,4 +1084,99 @@ erc-tls '(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 erc-after-connect) + (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") -- 2.38.1