bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.bugs,gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v4.
- Dropped the request-tracking POC stuff because those patches only
benefit the Org integration, which needs special attention anyway.
- Added unifying changes to url-irc and browse-url that treat ERC and
rcirc equally.
Questions (for anyone):
1. I added a couple autoloads in lisp/url/url-irc.el to avoid having
to create a url-ircs.el (or even a url-irc6{,s}.el). Is there a
better alternate means of getting `url-scheme-get-property' to
discover handlers that doesn't rely on autoloads?
2. In the function `url-irc', I bind `url-current-object' around the
call to `url-irc-function' to avoid adding another parameter to the
latter's interface (which mainly benefits ERC). Any obvious problem
with borrowing `url-current-object' for this purpose?
3. In browse-url, I basically ignore what looks like the favored
practice for adding handlers, namely, registering an internal
function with `browse-url-default-handlers' that calls a public
function assigned to a user option. An example of this pattern is:
internal: browse-url--mailto
option: browse-url-mailto-function
public: browse-url-mail
The reason for sidestepping the intervening indirection and adding
a public function directly to `browse-url-default-handlers' is that
I figure users wishing to override this can already do so via
`browse-url-handlers'. Is that misguided somehow?
4. Are any of these non-ERC changes newsworthy enough for etc/NEWS?
Thanks!
0000-v3-v4.diff
(text/x-patch, 25.6 KB)
From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 7 Nov 2022 05:13:59 -0800 Subject: [PATCH 0/6] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (6): Teach thing-at-point to recognize bracketed IPv6 URLs Accommodate ircs:// URLs in url-irc and browse-url Refactor erc-select-read-args Default to TLS port when calling erc-tls from lisp Add optional server param to erc-networks--determine Improve new connections in erc-handle-irc-url doc/misc/erc.texi | 39 +++++ lisp/erc/erc-backend.el | 6 + lisp/erc/erc-compat.el | 15 ++ lisp/erc/erc-networks.el | 9 +- lisp/erc/erc.el | 224 +++++++++++++++++++-------- lisp/net/browse-url.el | 11 ++ lisp/thingatpt.el | 2 +- lisp/url/url-irc.el | 21 ++- test/lisp/erc/erc-networks-tests.el | 17 +++ test/lisp/erc/erc-tests.el | 225 ++++++++++++++++++++++++++++ test/lisp/net/browse-url-tests.el | 9 ++ test/lisp/thingatpt-tests.el | 3 + 12 files changed, 510 insertions(+), 71 deletions(-) Interdiff: diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9..d01eab1bbb 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,43 @@ 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 that rely directly +on @code{url-retrieve} should be good to go 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 erc-browse-url-handler 0) +@end lisp + +@defun erc-browse-url-handler url &rest args +An autoloaded convenience function for use in options like those +mentioned above. @var{url} must be a string. In Emacs 29 and above, +the function @code{browse-url-irc} can be used instead. +@end defun + +@noindent +Keep in mind that when fiddling with these options, it may be easier +(and more polite) to connect to a local server or a test network, like +@samp{ircs://testnet.ergo.chat/#test}, since these generally don't +require authentication. + + @node Options @section Options @cindex options diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f1352..683d19dfc7 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -168,6 +168,21 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +(declare-function browse-url-irc "browse-url" (url &rest _)) + +(defun erc-compat--browse-url-irc (string &rest _) + "Parse STRING and call `url-irc'." + (require 'url-irc) + (if (< emacs-major-version 29) + ;; `url-irc' binds this in Emacs 29+. + (let ((url-current-object (url-generic-parse-url string))) + (url-irc url-current-object)) + (browse-url-irc string))) + +(when (< emacs-major-version 29) + (add-to-list 'browse-url-default-handlers + '("\\`irc6?s?://" . erc-compat--browse-url-irc))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index db2029580a..3c9293e28a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1534,6 +1534,15 @@ erc-reuse-buffers (make-obsolete-variable 'erc-reuse-buffers "old behavior when t now permanent" "29.1") +(defcustom erc-legacy-port-names 'legacy + "Interpret \"irc\" and \"ircs\" using IANA service mappings. +When non-nil, this yields 194 and 994 instead of 6667 and 6697. +When set to `legacy', it also emits a warning saying that the +default will change to nil in the future." + :group 'erc + :package-version '(ERC . "5.4.1") ; FIXME increment on ELPA release + :type '(choice (const nil) (const legacy) (const t))) + (defun erc-normalize-port (port) "Normalize the port specification PORT to integer form. PORT may be an integer, a string or a symbol. If it is a string or a @@ -1557,8 +1566,14 @@ erc-normalize-port port-nr) ((string-equal port "ircu") 6667) ((string-equal port "ircs-u") 6697) - ((string-equal port "irc") - 194) + ((member port '("irc" "ircs")) + (when (eq erc-legacy-port-names 'legacy) + (lwarn 'ERC 'warning + (concat "`erc-legacy-port-names' will default to nil " + "in a future version of ERC."))) + (if (string= port "irc") + (if erc-legacy-port-names 194 6667) + (if erc-legacy-port-names 994 6697))) ((string-equal port "ircs") 994) ((string-equal port "ircd") @@ -2119,29 +2134,33 @@ erc--ensure-url (defun erc-select-read-args () "Prompt the user for values of nick, server, port, and password." (require 'url-parse) - (let ((input (read-string "IRC server: " - (erc-compute-server) - 'erc-server-history-list)) - server port nick passwd) - ;; For legacy reasons, also accept a URL without a scheme. - (let* ((url (url-generic-parse-url (erc--ensure-url input))) - (sp (and (string-suffix-p "s" (url-type url)) 'ircs-u))) - (setq server (url-host url) - port (or (url-portspec url) - (erc-string-to-port - (read-string "IRC port: " (erc-port-to-string - (erc-compute-port sp))))) - nick (or (url-user url) - (if (erc-already-logged-in server port nick) - (read-string (erc-format-message 'nick-in-use ?n nick) - nick 'erc-nick-history-list) - (read-string "Nickname: " (erc-compute-nick nick) - 'erc-nick-history-list))) - passwd (or (url-password url) - (if erc-prompt-for-password - (read-passwd "Server password: ") - (with-suppressed-warnings ((obsolete erc-password)) - erc-password))))) + (let* ((input (let ((d (erc-compute-server))) + (read-string (format "Server (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))) + (server (url-host url)) + (sp (and (or (string-suffix-p "s" (url-type url)) + (and (equal server erc-default-server) + (not (string-prefix-p "irc://" input)))) + 'ircs-u)) + (port (or (url-portspec url) + (erc-compute-port + (let ((d (erc-compute-port sp))) ; may be a string + (read-string (format "Port (default is %s): " d) + nil nil d))))) + ;; Trust the user not to connect twice accidentally. We + ;; can't use `erc-already-logged-in' to check for an existing + ;; connection without modifying it to consider USER and PASS. + (nick (or (url-user url) + (let ((d (erc-compute-nick))) + (read-string (format "Nickname (default is %S): " d) + nil 'erc-nick-history-list d)))) + (passwd (or (url-password url) + (if erc-prompt-for-password + (read-passwd "Server password (optional): ") + (with-suppressed-warnings ((obsolete erc-password)) + erc-password))))) (when (and passwd (string= "" passwd)) (setq passwd nil)) (list :server server :port port :nick nick :password passwd))) @@ -6395,10 +6414,7 @@ erc-compute-port - PORT (the argument passed to this function) - The `erc-port' option - The `erc-default-port' variable" - (cond ((numberp port) port) - (erc-port (erc-normalize-port erc-port)) - (port (erc-normalize-port port)) - (t erc-default-port))) + (erc-normalize-port (or port erc-port erc-default-port))) ;; time routines @@ -7168,21 +7184,47 @@ 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 update comment above once the URL business is fully settled. -;; Also: the function `url-retrieve-internal' finds a "loader" by -;; looking for a library providing a feature named "url-<scheme>", but -;; no such file currently exists for "ircs". +(defcustom erc-url-connect-function nil + "When non-nil, a function used to connect to an IRC URL. +Called with any number of keyword arguments recognized by `erc' +and `erc-tls'. The variable `url-current-object', if non-nil, +can be used to help determine whether to connect using TLS." + :group 'erc + :package-version '(ERC . "5.4.1") ; FIXME increment on release + :type '(choice (const nil) function)) + +(defun erc--url-default-connect-function (&rest plist) + (let* ((scheme (and url-current-object (url-type url-current-object))) + (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))) + +;; The current spec, unlike the 2003 Butcher draft, doesn't explicitly +;; allow for an auth[:password]@ component (or trailing ,flags or +;; &options). +;; +;; https://www.iana.org/assignments/uri-schemes +;; https://datatracker.ietf.org/doc/html/draft-butcher-irc-url#section-6 ;;;###autoload -(defun erc-handle-irc-url (host port channel nick password - &optional connect-fn) +(defun erc-handle-irc-url (host port channel nick password) "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 NICK and /join CHANNEL. -Note that ERC no longer attempts to establish new connections -without human intervention, although opting in may eventually be -allowed." +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 @@ -7202,10 +7244,10 @@ erc-handle-irc-url port))))))))) key deferred) (unless server-buffer - (unless connect-fn - (user-error "Existing session for %s not found." host)) (setq deferred t - server-buffer (apply connect-fn :server host + server-buffer (apply (or erc-url-connect-function + #'erc--url-default-connect-function) + :server host `(,@(and port (list :port port)) ,@(and nick (list :nick nick)) ,@(and password `(:password ,password)))))) @@ -7227,75 +7269,13 @@ erc-handle-irc-url (with-current-buffer server-buffer (erc-cmd-JOIN channel key)))))) -;; XXX ERASE ME (possibly use as basis for new section in info doc) -;; -;; For now, as a demo, users must require erc and do something like: -;; -;; (add-to-list 'browse-url-default-handlers -;; '("\\`irc6?s?://" . erc--handle-ircs-url)) -;; -;; Libraries that optionally depend on browse-url, like eww, etc. need -;; an extra hand as well: -;; -;; (setq eww-use-browse-url -;; (concat eww-use-browse-url "\\|\\`irc6?s?:")) -;; -;; Those that don't use browse-url get the same handler: -;; -;; (add-to-list 'gnus-button-alist -;; '("\\birc6?s?://[][a-z0-9.,@_:+%?&/#-]+" -;; 0 t erc--handle-ircs-url 0)) -;; -;; Finally, insert something like "ircs://testnet.ergo.chat/#test" -;; where appropriate and perform a suitable action. - -;; The two variables below are contenders for exporting as user -;; options. The rationale for separate functions here instead of, -;; say, a single option granting ERC permission to connect -;; automatically is that ERC lacks a concept of configured server -;; profiles and thus has no idea what values to give for connection -;; parameters, like nick, user, etc. -;; -;; Also, the current spec was simplified from the 2003 Butcher draft -;; and doesn't explicitly allow for an auth[:password]@ component (or -;; trailing ,flags or &options, for that matter). Regardless, even -;; when provided, we shouldn't just connect and risk exposing -;; whatever's returned by `user-login-name', right? -;; -;; https://www.iana.org/assignments/uri-schemes -;; https://datatracker.ietf.org/doc/html/draft-butcher-irc-url#section-6 - -(defvar erc--url-irc-connect-function nil) -(defvar erc--url-ircs-connect-function nil) - -(defun erc--url-default-connect-function (ircs &rest plist) - (let ((erc-server (plist-get plist :server)) - (erc-port (or (plist-get plist :port) - (and ircs (erc-normalize-port 'ircs-u)) - erc-port)) - (erc-nick (or (plist-get plist :nick) erc-nick))) - (call-interactively (if ircs #'erc-tls #'erc)))) - (defvar url-irc-function) -;; FIXME rename this and autoload it -(defun erc--handle-ircs-url (&optional url &rest _) - (unless url - (setq url (pop command-line-args-left)) - (cl-assert url)) - (require 'url-parse) - (unless (url-p url) - (setq url (url-generic-parse-url url))) - (let* ((ircsp (string-suffix-p "s" (url-type url))) - (fn (or (if ircsp - erc--url-ircs-connect-function - erc--url-irc-connect-function) - (apply-partially #'erc--url-default-connect-function ircsp))) - (url-irc-function (lambda (&rest r) - (apply #'erc-handle-irc-url `(,@r ,fn))))) - ;; Amazingly, this does TRT for /&chan, /#chan, /##chan, /#&chan - (url-irc url))) - +;;;###autoload +(defun erc-browse-url-handler (url &rest _) + "Launch an ERC session when given an irc:// URL." + (let ((url-irc-function 'url-irc-erc)) + (erc-compat--browse-url-irc url))) (provide 'erc) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a..8d95c0667b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -565,6 +565,7 @@ browse-url--non-html-file-url-p (defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) + ("\\`irc6?s?://" . browse-url-irc) (browse-url--non-html-file-url-p . browse-url-emacs)) "Like `browse-url-handlers' but populated by Emacs and packages. @@ -1510,6 +1511,16 @@ browse-url-text-emacs (function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +;; --- irc --- + +;;;###autoload +(defun browse-url-irc (url &rest _) + "Call `url-irc' directly after parsing URL. +This function is a fit for options like `gnus-button-alist'." + (url-irc (url-generic-parse-url url))) + +(function-put 'browse-url-irc 'browse-url-browser-kind 'internal) + ;; --- mailto --- (autoload 'rfc6068-parse-mailto-url "rfc6068") diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 9161f7d13e..0dd25b7f49 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,7 +38,12 @@ url-irc-function PORT - the port number of the IRC server to contact CHANNEL - What channel on the server to visit right away (can be nil) USER - What username to use -PASSWORD - What password to use" +PASSWORD - What password to use. + +The variable `url-current-object' is bound to the parsed `url' +struct, but its members may not match the positional args above, +which should take precedence. For example, `:portspec' may be +nil while PORT is 6667." :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) @@ -80,7 +85,8 @@ url-irc (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (url-current-object url)) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) @@ -90,6 +96,17 @@ url-irc (funcall url-irc-function host port chan user pass) nil)) +;;;; ircs:// + +;; The function `url-scheme-get-property' tries and fails to load the +;; nonexistent url-ircs.el but falls back to using the following: + +;;;###autoload +(defconst url-ircs-default-port 6697 "Default port for IRCS connections.") + +;;;###autoload +(defalias 'url-ircs 'url-irc) + (provide 'url-irc) ;;; url-irc.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3ca36c0abb..e097090e5d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -976,26 +976,25 @@ erc--server-connect-dumb-ipv6-regexp (ert-deftest erc-select-read-args () - (ert-info ("Default") + (ert-info ("Defaults to TLS") (should (equal (ert-simulate-keys "\r\r\r\r" (erc-select-read-args)) (list :server "irc.libera.chat" - :port 6667 + :port 6697 :nick (user-login-name) :password nil)))) - (ert-info ("Default TSL") - (should (equal (ert-simulate-keys "\r\r\r\r" - (let ((erc-default-port erc-default-port-tls)) - (erc-select-read-args))) + (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 6697 + :port 6667 :nick (user-login-name) :password nil)))) (ert-info ("Address includes port") (should (equal (ert-simulate-keys - "\C-a\C-klocalhost:6667\r\C-a\C-knick\r\r" + "localhost:6667\rnick\r\r" (erc-select-read-args)) (list :server "localhost" :port 6667 @@ -1003,7 +1002,7 @@ erc-select-read-args :password nil)))) (ert-info ("Address includes nick, password skipped via option") - (should (equal (ert-simulate-keys "\C-a\C-knick@localhost:6667\r" + (should (equal (ert-simulate-keys "nick@localhost:6667\r" (let (erc-prompt-for-password) (erc-select-read-args))) (list :server "localhost" @@ -1012,7 +1011,7 @@ erc-select-read-args :password nil)))) (ert-info ("Addresss includes nick and password") - (should (equal (ert-simulate-keys "\C-a\C-knick:sesame@localhost:6667\r" + (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r" (erc-select-read-args)) (list :server "localhost" :port 6667 @@ -1020,7 +1019,7 @@ erc-select-read-args :password "sesame")))) (ert-info ("IPv6 address plain") - (should (equal (ert-simulate-keys "\C-a\C-k::1\r\r\r\r" + (should (equal (ert-simulate-keys "::1\r\r\r\r" (erc-select-read-args)) (list :server "[::1]" :port 6667 @@ -1028,7 +1027,7 @@ erc-select-read-args :password nil)))) (ert-info ("IPv6 address with port") - (should (equal (ert-simulate-keys "\C-a\C-k[::1]:6667\r\r\r" + (should (equal (ert-simulate-keys "[::1]:6667\r\r\r" (erc-select-read-args)) (list :server "[::1]" :port 6667 @@ -1036,7 +1035,7 @@ erc-select-read-args :password nil)))) (ert-info ("IPv6 address includes nick") - (should (equal (ert-simulate-keys "\C-a\C-knick@[::1]:6667\r\r" + (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r" (erc-select-read-args)) (list :server "[::1]" :port 6667 @@ -1109,14 +1108,14 @@ erc-tests--make-client-buf (current-buffer))) (ert-deftest erc-handle-irc-url () - (should-error (erc-handle-irc-url "irc.gnu.org" 6667 nil nil nil)) (let* (calls rvbuf erc-networks-alist erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook - (connect (lambda (&rest r) - (push r calls) - (if (functionp rvbuf) (funcall rvbuf) rvbuf)))) + (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)))) @@ -1127,34 +1126,34 @@ erc-handle-irc-url (erc-tests--make-server-buf "baznet") (ert-info ("Unknown network") - (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil connect) + (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil) (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 connect) + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil) (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 connect) + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil) (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 connect) + (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil) (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 connect) + (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil) (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 connect) + (erc-handle-irc-url "irc.gnu.org" nil nil nil nil) (should (equal '(:server "irc.gnu.org") (pop calls))) (should-not calls)) @@ -1162,7 +1161,7 @@ erc-handle-irc-url (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 connect) + (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil) (should (equal '(:server "irc.gnu.org") (pop calls))) (should-not calls) (with-current-buffer "gnu" diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index 1c993958b8..cf917802e0 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -56,6 +56,15 @@ browse-url-tests-select-handler-man 'browse-url--man)) (should-not (browse-url-select-handler "man:ls" 'external))) +(ert-deftest browse-url-tests-select-handler-irc () + (should (eq (browse-url-select-handler "irc://localhost" 'internal) + 'browse-url-irc)) + (should-not (browse-url-select-handler "irc://localhost" 'external)) + (should (eq (browse-url-select-handler "irc6://localhost") + 'browse-url-irc)) + (should (eq (browse-url-select-handler "ircs://[email protected]/#chan") + 'browse-url-irc))) + (ert-deftest browse-url-tests-select-handler-file () (should (eq (browse-url-select-handler "file://foo.txt") 'browse-url-emacs)) -- 2.38.1
0001-Teach-thing-at-point-to-recognize-bracketed-IPv6-URL.patch
(text/x-patch, 2 KB)
From 0d191d30b15ea2d5b6042f51c6cf421b82feb7e5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 13 Jul 2022 01:54:19 -0700 Subject: [PATCH 1/6] Teach thing-at-point to recognize bracketed IPv6 URLs * lisp/thingatpt.el (thing-at-point-bounds-of-url-at-point): Allow IPv6 addresses as hosts. Overshoots in the case of bracketed markup but is rescued by `thing-at-point--bounds-of-well-formed-url'. * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add cases for IPv6 URLs. --- lisp/thingatpt.el | 2 +- test/lisp/thingatpt-tests.el | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 462f87d3c1..9dda3e1fcb 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -441,7 +441,7 @@ thing-at-point-bounds-of-url-at-point ;; Otherwise, find the bounds within which a URI may exist. The ;; method is similar to `ffap-string-at-point'. Note that URIs ;; may contain parentheses but may not contain spaces (RFC3986). - (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'") + (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'[]") (skip-before "^[0-9a-zA-Z]") (skip-after ":;.,!?'") (pt (point)) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index b6d0b1446a..67dd00104b 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -44,6 +44,9 @@ thing-at-point-test-data ;; Non alphanumeric characters can be found in URIs ("ftp://example.net/~foo!;#bar=baz&goo=bob" 3 url "ftp://example.net/~foo!;#bar=baz&goo=bob") ("bzr+ssh://[email protected]:5/a%20d,5" 34 url "bzr+ssh://[email protected]:5/a%20d,5") + ;; IPv6 brackets enclosed in [markup] + ("[http://[::1]:8000/foo]" 10 url "http://[::1]:8000/foo") + ("[http://[fe08::7:8%eth0]]" 10 url "http://[fe08::7:8%eth0]") ;; <url:...> markup ("Url: <url:foo://1.example.com>..." 8 url "foo://1.example.com") ("Url: <url:foo://2.example.com>..." 30 url "foo://2.example.com") -- 2.38.1
0002-Accommodate-ircs-URLs-in-url-irc-and-browse-url.patch
(text/x-patch, 4.4 KB)
From 6fd2f75707f123abfbcfae2d4f2837efed5b7adc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 2/6] Accommodate ircs:// URLs in url-irc and browse-url * lisp/url/url-irc.el: (url-irc-erc, url-irc): Add necessary ingredients for `url-scheme-get-property' to recognize ircs:// URLs. Bind `url-current-object' around calls to `url-irc-function'. (url-ircs-default-port, url-ircs): Add new autoloaded constant and alias for `url-scheme-get-property' to recognize. Do this to avoid having to add another file. * lisp/net/browse-url.el (browse-url-default-handlers): Add "irc://" entry. (browse-url-irc): Add new function to serve as default hander for "irc://" URLS. * test/lisp/net/browse-url-tests.el (browse-url-tests-select-handler-irc): Add test for "irc://" URL pattern. --- lisp/net/browse-url.el | 11 +++++++++++ lisp/url/url-irc.el | 21 +++++++++++++++++++-- test/lisp/net/browse-url-tests.el | 9 +++++++++ 3 files changed, 39 insertions(+), 2 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a..8d95c0667b 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -565,6 +565,7 @@ browse-url--non-html-file-url-p (defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) + ("\\`irc6?s?://" . browse-url-irc) (browse-url--non-html-file-url-p . browse-url-emacs)) "Like `browse-url-handlers' but populated by Emacs and packages. @@ -1510,6 +1511,16 @@ browse-url-text-emacs (function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +;; --- irc --- + +;;;###autoload +(defun browse-url-irc (url &rest _) + "Call `url-irc' directly after parsing URL. +This function is a fit for options like `gnus-button-alist'." + (url-irc (url-generic-parse-url url))) + +(function-put 'browse-url-irc 'browse-url-browser-kind 'internal) + ;; --- mailto --- (autoload 'rfc6068-parse-mailto-url "rfc6068") diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 9161f7d13e..0dd25b7f49 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,7 +38,12 @@ url-irc-function PORT - the port number of the IRC server to contact CHANNEL - What channel on the server to visit right away (can be nil) USER - What username to use -PASSWORD - What password to use" +PASSWORD - What password to use. + +The variable `url-current-object' is bound to the parsed `url' +struct, but its members may not match the positional args above, +which should take precedence. For example, `:portspec' may be +nil while PORT is 6667." :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) @@ -80,7 +85,8 @@ url-irc (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (url-current-object url)) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) @@ -90,6 +96,17 @@ url-irc (funcall url-irc-function host port chan user pass) nil)) +;;;; ircs:// + +;; The function `url-scheme-get-property' tries and fails to load the +;; nonexistent url-ircs.el but falls back to using the following: + +;;;###autoload +(defconst url-ircs-default-port 6697 "Default port for IRCS connections.") + +;;;###autoload +(defalias 'url-ircs 'url-irc) + (provide 'url-irc) ;;; url-irc.el ends here diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index 1c993958b8..cf917802e0 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -56,6 +56,15 @@ browse-url-tests-select-handler-man 'browse-url--man)) (should-not (browse-url-select-handler "man:ls" 'external))) +(ert-deftest browse-url-tests-select-handler-irc () + (should (eq (browse-url-select-handler "irc://localhost" 'internal) + 'browse-url-irc)) + (should-not (browse-url-select-handler "irc://localhost" 'external)) + (should (eq (browse-url-select-handler "irc6://localhost") + 'browse-url-irc)) + (should (eq (browse-url-select-handler "ircs://[email protected]/#chan") + 'browse-url-irc))) + (ert-deftest browse-url-tests-select-handler-file () (should (eq (browse-url-select-handler "file://foo.txt") 'browse-url-emacs)) -- 2.38.1
0003-Refactor-erc-select-read-args.patch
(text/x-patch, 10.8 KB)
From e64b845f097590889109b6033f42cb5d68abf0b9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 3/6] Refactor erc-select-read-args * lisp/erc/erc-backend.el (erc--server-connect-dumb-ipv6-regexp): Add liberal pattern for matching bracketed IPv6 addresses. (erc-server-connect): Remove brackets from IPv6 hosts before connecting. * lisp/erc/erc.el (erc--ensure-url): Add compat adapter to massage partial URLs given as input that may be missing the scheme:// portion. (erc-select-read-args): Keep bracketed IPv6 hosts intact. Make this function fully URL-aware (was only partially so). Accept optional `input' argument. * lisp/erc/erc-tests.el (erc-tests--ipv6-examples, erc--server-connect-dumb-ipv6-regexp, erc-select-read-args): Add test reading user input during interactive invocations of entry points. --- lisp/erc/erc-backend.el | 6 +++ lisp/erc/erc.el | 83 ++++++++++++++++++----------------- test/lisp/erc/erc-tests.el | 89 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 136 insertions(+), 42 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 026b34849a..1cb0876367 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -625,12 +625,18 @@ erc-open-network-stream (let ((p (plist-put parameters :nowait t))) (apply #'open-network-stream name buffer host service p))) +(defvar erc--server-connect-dumb-ipv6-regexp + ;; Not for validation (gives false positives). + (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot)) + (defun erc-server-connect (server port buffer &optional client-certificate) "Perform the connection and login using the specified SERVER and PORT. We will store server variables in the buffer given by BUFFER. CLIENT-CERTIFICATE may optionally be used to specify a TLS client certificate to use for authentication when connecting over TLS (see `erc-session-client-certificate' for more details)." + (when (string-match erc--server-connect-dumb-ipv6-regexp server) + (setq server (match-string 1 server))) (let ((msg (erc-format-message 'connect ?S server ?p port)) process (args `(,(format "erc-%s-%s" server port) nil ,server ,port))) (when client-certificate diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6b14cf87e2..7f25afa8c5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -70,7 +70,7 @@ (require 'auth-source) (require 'time-date) (require 'iso8601) -(eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'subr-x) (require 'url-parse)) (defconst erc-version "5.4.1" "This version of ERC.") @@ -2094,52 +2094,51 @@ erc-after-connect :group 'erc-hooks :type '(repeat function)) +(defun erc--ensure-url (input) + (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input) + (when (and (string-match (rx (? (+ any) "@") + (or (group (* (not "[")) ":" (* any)) + (+ any)) + ":" (+ (not (any ":]"))) eot) + input) + (match-beginning 1)) + (setq input (concat "[" (substring input (match-beginning 1)) "]"))) + (setq input (concat "irc://" input))) + input) + ;;;###autoload (defun erc-select-read-args () "Prompt the user for values of nick, server, port, and password." - (let (user-input server port nick passwd) - (setq user-input (read-string - "IRC server: " - (erc-compute-server) 'erc-server-history-list)) - - (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) - (setq port (erc-string-to-port (match-string 2 user-input)) - user-input (match-string 1 user-input)) - (setq port - (erc-string-to-port (read-string - "IRC port: " (erc-port-to-string - (erc-compute-port)))))) - - (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input) - (setq nick (match-string 1 user-input) - user-input (match-string 2 user-input)) - (setq nick - (if (erc-already-logged-in server port nick) - (read-string - (erc-format-message 'nick-in-use ?n nick) - nick 'erc-nick-history-list) - (read-string - "Nickname: " (erc-compute-nick nick) - 'erc-nick-history-list)))) - - (setq server user-input) - - (setq passwd (if erc-prompt-for-password - (read-passwd "Server password: ") - (with-suppressed-warnings ((obsolete erc-password)) - erc-password))) + (require 'url-parse) + (let* ((input (let ((d (erc-compute-server))) + (read-string (format "Server (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))) + (server (url-host url)) + (sp (and (or (string-suffix-p "s" (url-type url)) + (and (equal server erc-default-server) + (not (string-prefix-p "irc://" input)))) + 'ircs-u)) + (port (or (url-portspec url) + (erc-compute-port + (let ((d (erc-compute-port sp))) ; may be a string + (read-string (format "Port (default is %s): " d) + nil nil d))))) + ;; Trust the user not to connect twice accidentally. We + ;; can't use `erc-already-logged-in' to check for an existing + ;; connection without modifying it to consider USER and PASS. + (nick (or (url-user url) + (let ((d (erc-compute-nick))) + (read-string (format "Nickname (default is %S): " d) + nil 'erc-nick-history-list d)))) + (passwd (or (url-password url) + (if erc-prompt-for-password + (read-passwd "Server password (optional): ") + (with-suppressed-warnings ((obsolete erc-password)) + erc-password))))) (when (and passwd (string= "" passwd)) (setq passwd nil)) - - (while (erc-already-logged-in server port nick) - ;; hmm, this is a problem when using multiple connections to a bnc - ;; with the same nick. Currently this code prevents using more than one - ;; bnc with the same nick. actually it would be nice to have - ;; bncs transparent, so that erc-compute-buffer-name displays - ;; the server one is connected to. - (setq nick (read-string - (erc-format-message 'nick-in-use ?n nick) - nick 'erc-nick-history-list))) (list :server server :port port :nick nick :password passwd))) ;;;###autoload diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c88dd9888d..f72db816af 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -953,4 +953,93 @@ erc-message (kill-buffer "ExampleNet") (kill-buffer "#chan"))) +(defvar erc-tests--ipv6-examples + '("1:2:3:4:5:6:7:8" + "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0" + "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255" + "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" + "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8" + "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8" + "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8" + "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8" + "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8" + "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8" + "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255" + "::ffff:255.255.255.255" "::ffff:0:255.255.255.255" + "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33")) + +(ert-deftest erc--server-connect-dumb-ipv6-regexp () + (dolist (a erc-tests--ipv6-examples) + (should-not (string-match erc--server-connect-dumb-ipv6-regexp a)) + (should (string-match erc--server-connect-dumb-ipv6-regexp + (concat "[" a "]"))))) + +(ert-deftest erc-select-read-args () + + (ert-info ("Defaults to TLS") + (should (equal (ert-simulate-keys "\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6697 + :nick (user-login-name) + :password nil)))) + + (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)))) + + (ert-info ("Address includes port") + (should (equal (ert-simulate-keys + "localhost:6667\rnick\r\r" + (erc-select-read-args)) + (list :server "localhost" + :port 6667 + :nick "nick" + :password nil)))) + + (ert-info ("Address includes nick, password skipped via option") + (should (equal (ert-simulate-keys "nick@localhost:6667\r" + (let (erc-prompt-for-password) + (erc-select-read-args))) + (list :server "localhost" + :port 6667 + :nick "nick" + :password nil)))) + + (ert-info ("Addresss includes nick and password") + (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r" + (erc-select-read-args)) + (list :server "localhost" + :port 6667 + :nick "nick" + :password "sesame")))) + + (ert-info ("IPv6 address plain") + (should (equal (ert-simulate-keys "::1\r\r\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick (user-login-name) + :password nil)))) + + (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)))) + + (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))))) + ;;; erc-tests.el ends here -- 2.38.1
0004-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch
(text/x-patch, 5.8 KB)
From a9b47f5a6079fb3030c9e1514b4cbbda86dafff8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 4/6] Default to TLS port when calling erc-tls from lisp * lisp/erc/erc.el (erc-legacy-port-names, erc-normalize-port): Add standard IANA port-name mappings for 6667 and 6697, as well as an option to opt in for saner but nonstandard behavior. (erc-open): Add note to doc string explaining that params `connect' and `channel' are mutually exclusive. (erc-tls): Call `erc-compute-port' with override. (erc-compute-port): Call `erc-normalize-port' with result'. * test/lisp/erc/erc-tests.el (erc-tls): Add simplistic test focusing on default parameters. --- lisp/erc/erc.el | 34 ++++++++++++++++++++++++++----- test/lisp/erc/erc-tests.el | 41 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7f25afa8c5..01bb6f9f45 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1534,6 +1534,15 @@ erc-reuse-buffers (make-obsolete-variable 'erc-reuse-buffers "old behavior when t now permanent" "29.1") +(defcustom erc-legacy-port-names 'legacy + "Interpret \"irc\" and \"ircs\" using IANA service mappings. +When non-nil, this yields 194 and 994 instead of 6667 and 6697. +When set to `legacy', it also emits a warning saying that the +default will change to nil in the future." + :group 'erc + :package-version '(ERC . "5.4.1") ; FIXME increment on ELPA release + :type '(choice (const nil) (const legacy) (const t))) + (defun erc-normalize-port (port) "Normalize the port specification PORT to integer form. PORT may be an integer, a string or a symbol. If it is a string or a @@ -1542,6 +1551,11 @@ erc-normalize-port * ircs -> 994 * ircd -> 6667 * ircd-dalnet -> 7000" + ;; These were updated in 2022 to reflect modern standards and + ;; practices. See also: + ;; + ;; https://datatracker.ietf.org/doc/html/rfc7194#section-1 + ;; https://www.iana.org/assignments/service-names-port-numbers (cond ((symbolp port) (erc-normalize-port (symbol-name port))) @@ -1550,8 +1564,16 @@ erc-normalize-port (cond ((> port-nr 0) port-nr) - ((string-equal port "irc") - 194) + ((string-equal port "ircu") 6667) + ((string-equal port "ircs-u") 6697) + ((member port '("irc" "ircs")) + (when (eq erc-legacy-port-names 'legacy) + (lwarn 'ERC 'warning + (concat "`erc-legacy-port-names' will default to nil " + "in a future version of ERC."))) + (if (string= port "irc") + (if erc-legacy-port-names 194 6667) + (if erc-legacy-port-names 994 6697))) ((string-equal port "ircs") 994) ((string-equal port "ircd") @@ -1924,7 +1946,9 @@ erc-open If CONNECT is non-nil, connect to the server. Otherwise assume already connected and just create a separate buffer for the new -target CHANNEL. +target given by CHANNEL, meaning these parameters are mutually +exclusive. Note that CHANNEL may also be a query; its name has +been retained for historical reasons. Use PASSWD as user password on the server. If TGT-LIST is non-nil, use it to initialize `erc-default-recipients'. @@ -2183,7 +2207,7 @@ 'erc-ssl ;;;###autoload (cl-defun erc-tls (&key (server (erc-compute-server)) - (port (erc-compute-port)) + (port (erc-compute-port 'ircs-u)) (nick (erc-compute-nick)) (user (erc-compute-user)) password @@ -6390,7 +6414,7 @@ erc-compute-port - PORT (the argument passed to this function) - The `erc-port' option - The `erc-default-port' variable" - (or port erc-port erc-default-port)) + (erc-normalize-port (or port erc-port erc-default-port))) ;; time routines diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f72db816af..348c047b73 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1042,4 +1042,45 @@ erc-select-read-args :nick "nick" :password nil))))) +(ert-deftest erc-tls () + (let (calls) + (cl-letf (((symbol-function 'user-login-name) + (lambda (&optional _) "tester")) + ((symbol-function 'erc-open) + (lambda (&rest r) (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)))) + + (ert-info ("Full") + (erc-tls :server "irc.gnu.org" + :port 7000 + :user "bobo" + :nick "bob" + :full-name "Bob's Name" + :password "bob:changeme" + :client-certificate t + :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)))) + + ;; Values are often nil when called by lisp code, which leads to + ;; null params. This is why `erc-open' recomputes everything. + (ert-info ("Fallback") + (let ((erc-nick "bob") + (erc-server "irc.gnu.org") + (erc-email-userid "bobo") + (erc-user-full-name "Bob's Name")) + (erc-tls :server nil + :port 7000 + :nick nil + :password "bob:changeme")) + (should (equal (pop calls) + '(nil 7000 nil "Bob's Name" t + "bob:changeme" nil nil nil nil "bobo" nil))))))) + ;;; erc-tests.el ends here -- 2.38.1
0005-Add-optional-server-param-to-erc-networks-determine.patch
(text/x-patch, 2.9 KB)
From 9a44991ef351274c45d300d825066dd805296454 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 5/6] Add optional server param to erc-networks--determine * lisp/erc/erc-networks.el (erc-networks--determine): Accept optional `server' argument. * test/lisp/erc/erc-networks-tests.el (erc-networks--determine): Add test. --- lisp/erc/erc-networks.el | 9 +++++---- test/lisp/erc/erc-networks-tests.el | 17 +++++++++++++++++ 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index dba6ead073..b3e5fcf1a3 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1256,14 +1256,15 @@ erc-set-network-name (defconst erc-networks--name-missing-sentinel (gensym "Unknown ") "Value to cover rare case of a literal NETWORK=nil.") -(defun erc-networks--determine () +(defun erc-networks--determine (&optional server) "Return the name of the network as a symbol. -Search `erc-networks-alist' for a known entity matching +Search `erc-networks-alist' for a known entity matching SERVER or `erc-server-announced-name'. If that fails, use the display name given by the `RPL_ISUPPORT' NETWORK parameter." (or (cl-loop for (name matcher) in erc-networks-alist - when (and matcher (string-match (concat matcher "\\'") - erc-server-announced-name)) + when (and matcher + (string-match (concat matcher "\\'") + (or server erc-server-announced-name))) return name) (and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single)) ((intern vanity)))) diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 32bdfa11ff..fc12bf7ce3 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1704,4 +1704,21 @@ erc-networks--update-server-identity--triple-new (erc-networks-tests--clean-bufs)) +(ert-deftest erc-networks--determine () + (should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat)) + (should (eq (erc-networks--determine "irc.oftc.net") 'OFTC)) + (should (eq (erc-networks--determine "irc.dal.net") 'DALnet)) + + (let ((erc-server-announced-name "zirconium.libera.chat")) + (should (eq (erc-networks--determine) 'Libera.Chat))) + (let ((erc-server-announced-name "weber.oftc.net")) + (should (eq (erc-networks--determine) 'OFTC))) + (let ((erc-server-announced-name "redemption.ix.us.dal.net")) + (should (eq (erc-networks--determine) 'DALnet))) + + ;; Failure + (let ((erc-server-announced-name "irc-us2.alphachat.net")) + (should (eq (erc-networks--determine) + erc-networks--name-missing-sentinel)))) + ;;; erc-networks-tests.el ends here -- 2.38.1
0006-Improve-new-connections-in-erc-handle-irc-url.patch
(text/x-patch, 13.9 KB)
From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 6/6] Improve new connections in erc-handle-irc-url * lisp/erc/erc.el (erc-handle-irc-url): Fix `erc-open' invocation so that the server buffer is named correctly. 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. (erc-browse-url-handler): Add autoloaded function. * lisp/erc/erc-compat.el (erc-compat--browse-url--irc): Add new compat function for `browse-url-irc'. Also 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. --- doc/misc/erc.texi | 39 ++++++++++++++ lisp/erc/erc-compat.el | 15 ++++++ lisp/erc/erc.el | 107 +++++++++++++++++++++++++++++++------ test/lisp/erc/erc-tests.el | 95 ++++++++++++++++++++++++++++++++ 4 files changed, 239 insertions(+), 17 deletions(-) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9..d01eab1bbb 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,43 @@ 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 that rely directly +on @code{url-retrieve} should be good to go 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 erc-browse-url-handler 0) +@end lisp + +@defun erc-browse-url-handler url &rest args +An autoloaded convenience function for use in options like those +mentioned above. @var{url} must be a string. In Emacs 29 and above, +the function @code{browse-url-irc} can be used instead. +@end defun + +@noindent +Keep in mind that when fiddling with these options, it may be easier +(and more polite) to connect to a local server or a test network, like +@samp{ircs://testnet.ergo.chat/#test}, since these generally don't +require authentication. + + @node Options @section Options @cindex options diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f1352..683d19dfc7 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -168,6 +168,21 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +(declare-function browse-url-irc "browse-url" (url &rest _)) + +(defun erc-compat--browse-url-irc (string &rest _) + "Parse STRING and call `url-irc'." + (require 'url-irc) + (if (< emacs-major-version 29) + ;; `url-irc' binds this in Emacs 29+. + (let ((url-current-object (url-generic-parse-url string))) + (url-irc url-current-object)) + (browse-url-irc string))) + +(when (< emacs-major-version 29) + (add-to-list 'browse-url-default-handlers + '("\\`irc6?s?://" . erc-compat--browse-url-irc))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 01bb6f9f45..3c9293e28a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7184,25 +7184,98 @@ 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 any number of keyword arguments recognized by `erc' +and `erc-tls'. The variable `url-current-object', if non-nil, +can be used to help determine whether to connect using TLS." + :group 'erc + :package-version '(ERC . "5.4.1") ; FIXME increment on release + :type '(choice (const nil) function)) + +(defun erc--url-default-connect-function (&rest plist) + (let* ((scheme (and url-current-object (url-type url-current-object))) + (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))) + +;; The current spec, unlike the 2003 Butcher draft, doesn't explicitly +;; allow for an auth[:password]@ component (or trailing ,flags or +;; &options). +;; +;; https://www.iana.org/assignments/uri-schemes +;; https://datatracker.ietf.org/doc/html/draft-butcher-irc-url#section-6 + ;;;###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) + "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) + :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)))))) + +(defvar url-irc-function) + +;;;###autoload +(defun erc-browse-url-handler (url &rest _) + "Launch an ERC session when given an irc:// URL." + (let ((url-irc-function 'url-irc-erc)) + (erc-compat--browse-url-irc url))) (provide 'erc) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 348c047b73..e097090e5d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1083,4 +1083,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) + (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) + (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) + (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) + (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) + (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) + (should (equal '(: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) + (should (equal '(: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 -- 2.38.1