* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] <87pmiabvd5.fsf@neverwas.me> @ 2022-07-12 12:49 ` Lars Ingebrigtsen [not found] ` <87edyqzeag.fsf@gnus.org> ` (6 subsequent siblings) 7 siblings, 0 replies; 14+ messages in thread From: Lars Ingebrigtsen @ 2022-07-12 12:49 UTC (permalink / raw) To: J.P.; +Cc: 56514, emacs-erc "J.P." <jp@neverwas.me> writes: > (Note that nothing's yet autoloaded for the snippets above, so you'll > have to require all the players beforehand if trying them out with > a real endpoint, such as "ircs://testnet.ergo.chat/#test".) Sounds nice to me. > In the end, I'm hoping other folks will step forward who may be more > familiar with the libraries mentioned so that nicer renditions can > emerge. It's a large patch series -- perhaps asking questions about specific libraries would be more productive. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 14+ messages in thread
[parent not found: <87edyqzeag.fsf@gnus.org>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <87edyqzeag.fsf@gnus.org> @ 2022-07-13 14:44 ` J.P. [not found] ` <874jzl2hsv.fsf@neverwas.me> 1 sibling, 0 replies; 14+ messages in thread From: J.P. @ 2022-07-13 14:44 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: 56514, emacs-erc [-- Attachment #1: Type: text/plain, Size: 4470 bytes --] Lars Ingebrigtsen <larsi@gnus.org> writes: > "J.P." <jp@neverwas.me> writes: > >> In the end, I'm hoping other folks will step forward who may be more >> familiar with the libraries mentioned so that nicer renditions can >> emerge. > > It's a large patch series -- perhaps asking questions about specific > libraries would be more productive. Hm, right. Seems I'll have to take my entitled prima dona act elsewhere. Questions, then (TIA, people): 1. The first patch strays outside ERC's turf. Should I open a separate bug report for it? [1]. 2. With how I have things now, we'd use `browse-url-default-handlers' to sidestep url.el's loader-finding logic, as performed by `url-scheme-get-property'. But that feels a little hacky since my new, generalized handler is just a wrapper that calls `url-irc' (the loader), which massages the arguments and then calls our original (somewhat revamped) handler. A cleaner way might be to perhaps make url-irc.el aware of the new handler. But for that we'd need `url-scheme-get-property' to map all the scheme variants we're interested in, like ircs, irc6, etc., to that same loader. OTOH, that file's pretty ancient, so perhaps it's better to just leave it be? 3. Should I include the actual setup code for the integrations? If so, where would that go? My initial plan was to just have it all live in the docs, perhaps under a new Info node. BTW (re integrations), I also threw in a .desktop file [2], knowing full well that folks may just perceive that as more clutter polluting the Emacs tree. Should I drop it? People wanting one can just make their own. 4. I'll approach the Org people separately for this stuff, but just as a preview: my main question for them deals with their nonstandard "/user" variant of the URI syntax. Specifically, I'd like to know how it's supposed to work when a "?key" or multiple comma-separated channels (also nonstandard) are present in the URL. I'd also like to know how important it is we preserve this feature and how amenable they'd be to it (rapidly) going extinct [3]. Other, minor questions remain, some internal to ERC [4], but I'll spare everyone the trouble for now. Thanks! [1] On a system for which `browse-url-can-use-xdg-open' returns non-nil, and with point somewhere over some text like "http://[::1]", do M-x browse-url-at-point RET What happens is that `browse-url-url-at-point' returns "http://http://" because `thing-at-point-url-at-point' doesn't seem to like IPv6 URLs. This ultimately leads to a (call-process "xdg-open" nil 0 nil "http://http://") which exits nonzero. [2] For anyone interested, if your OS supports XDG desktop stuff, you can try the included etc/emacs-irc.desktop by doing something like a. Change the Exec directive to launch a local emacs -Q -Exec=emacs -l erc -f erc--handle-ircs-url %u +Exec=/home/me/emacs/master/src/emacs -Q -l erc -f ... b. $ desktop-file-install --rebuild-mime-info-cache \ --dir=~/.local/share/applications etc/emacs-irc.desktop c. $ gtk-launch emacs-irc 'ircs://testnet.ergo.chat/#test' [3] Not that it matters, but it took a fair bit of surgery across four patches to make "/user" behave as originally intended (according to my possibly warped impression). However, I'm pretty convinced it can only ever work reliably in conjunction with an IRC extension that's not (yet) widely adopted by servers and that ERC doesn't yet implement (although bug#49860 has something coming down the pike). [4] There's also the matter of duplicate functionality WRT the autojoin module and URL-triggered channel joining. It'd be nice to find a way to defer to existing code when a URL specifies a channel. Obviously, when a connection already exists or autojoin is already enabled, this won't be an issue. But when that's not the case, what's the right move? (Disabling autojoin seems mighty popular.) One option is just to refuse to open a new connection without autojoin. Or, we could prompt the user for permission to enable it. Somewhat complicating this is the fact that autojoin (like all modules) is only designed to be enabled globally. (I have a patch to address this, but it's only aimed at defining new modules as local to a network context.) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v1-v2.diff --] [-- Type: text/x-patch, Size: 9882 bytes --] From 1ef37c2aeff57b5d81a6ebd64a5a0d505203d923 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 05:50:50 -0700 Subject: [PATCH 00/10] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (10): Teach thing-at-point to recognize bracketed IPv6 URLs Accept bracketed IPv6 hosts in ERC Default to TLS port when calling erc-tls in lisp code Add optional server param to erc-networks--determine Improve new connections in erc-handle-irc-url [POC] Make erc-once-with-server-event more nimble [POC] Support one-off JOIN handlers in ERC [POC] Use erc--join-with-callback in URL handler [POC] Demo improved ol-irc integration [POC] * etc/emacs-irc.desktop: New file. etc/emacs-irc.desktop | 13 ++ lisp/erc/erc-backend.el | 8 + lisp/erc/erc-networks.el | 9 +- lisp/erc/erc.el | 268 ++++++++++++++++++++++++---- lisp/thingatpt.el | 2 +- test/lisp/erc/erc-networks-tests.el | 17 ++ test/lisp/erc/erc-tests.el | 136 ++++++++++++++ test/lisp/thingatpt-tests.el | 1 + 8 files changed, 415 insertions(+), 39 deletions(-) create mode 100644 etc/emacs-irc.desktop Interdiff: diff --git a/etc/emacs-irc.desktop b/etc/emacs-irc.desktop index ed13e918d2..ebdcda3a07 100644 --- a/etc/emacs-irc.desktop +++ b/etc/emacs-irc.desktop @@ -5,7 +5,6 @@ Keywords=ERC;extensible;chat;IRC;client; Categories=Network;Chat;IRCClient; Comment=GNU Emacs is an extensible, customizable text editor - ERC is a powerful, modular, and extensible IRC client for Emacs # FIXME update command line and name once autoloaded -# Also check if shell-quoting %u is needed, since it likely includes a # Exec=emacs -l erc -f erc--handle-ircs-url %u Icon=emacs MimeType=x-scheme-handler/irc;x-scheme-handler/ircs; diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc7a7d14dc..2ead0c9ba5 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -532,12 +532,20 @@ 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 + ;; Likely gives false positives and false negatives + (rx bot "[" + (group (+ (or (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 efa88bfff5..7137a7b401 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2364,8 +2364,11 @@ erc-select-read-args (setq user-input (read-string "IRC server: " (erc-compute-server) 'erc-server-history-list)) - - (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) + (if (and (string-match (rx (or (: (* (not "[")) ":" (* any)) + (group (+ any))) + ":" (group (+ (not (any ":]")))) eot) + user-input) + (match-string 1 user-input)) (setq port (erc-string-to-port (match-string 2 user-input)) user-input (match-string 1 user-input)) (setq port @@ -7481,10 +7484,9 @@ erc-handle-irc-url If ERC is already connected to HOST:PORT, simply /join CHANNEL. Otherwise, connect to HOST:PORT as NICK and /join CHANNEL. -Note: calling this function with NICK and/or PASSWORD is -deprecated and results in a warning. Moreover, ERC no longer -attempts to establish new connections without human intervention, -although opting in may eventually be allowed." +Note that ERC no longer attempts to establish new connections +without human intervention, although opting in may eventually be +allowed." (when (eql port 0) (setq port nil)) (let* ((net (erc-networks--determine host)) (server-buffer @@ -7503,9 +7505,6 @@ erc-handle-irc-url (= (erc-normalize-port erc-session-port) port))))))))) key deferred) - (when (or nick password) - (display-warning 'erc (concat "Calling `erc-handle-irc-url' with a nick " - "or a password argument is deprecated."))) (unless server-buffer (unless connect-fn (user-error "Existing session for %s not found." host)) @@ -7518,7 +7517,7 @@ erc-handle-irc-url ;; 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 "?")) + (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 @@ -7532,37 +7531,44 @@ erc-handle-irc-url (with-current-buffer server-buffer (erc--join-with-callback channel key on-join)))))) -;; XXX ERASE ME -;; -;; The final spec was simplified from the 2003 Butcher draft and -;; doesn't allow an auth@ component or trailing ,flags or &options. -;; Because of this, we shouldn't just connect and risk exposing -;; whatever's returned by `user-login-name'. +;; 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 -;; '("\\`ircs?://" . erc--handle-ircs-url)) +;; '("\\`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 "\\|\\`ircs?:")) +;; (concat eww-use-browse-url "\\|\\`irc6?s?:")) ;; ;; Those that don't use browse-url get the same handler: ;; -;; (push '("\\bircs?://[a-z.@_+0-9%=?&/#-]+" -;; 0 t erc--handle-ircs-url 0) -;; gnus-button-alist) +;; (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, since ERC doesn't lacks any concept of +;; configured server profiles, it 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 -;; Contenders for exporting as user options. (defvar erc--url-irc-connect-function nil) (defvar erc--url-ircs-connect-function nil) @@ -7586,7 +7592,7 @@ erc--handle-ircs-url (require 'url-parse) (unless (url-p url) (setq url (url-generic-parse-url url))) - (let* ((ircsp (string-match "ircs" (url-type url))) + (let* ((ircsp (string-suffix-p "s" (url-type url))) (fn (or (if ircsp erc--url-ircs-connect-function erc--url-irc-connect-function) @@ -7637,6 +7643,7 @@ erc--handle-url-org-follow-ircs ;; present. The following is only for demo purposes. (defun erc--org-init () + ;; TODO also add irc6 and irc6s (possibly nonstandard) (require 'ol-irc) (org-link-set-parameters "irc" diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b3dca5890f..5e597df6ff 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -430,7 +430,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..b5f4ea8cdc 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -44,6 +44,7 @@ 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://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net:5/a%20d,5") + ("http://[::1]:8000/foo" 10 url "http://[::1]:8000/foo") ;; <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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Teach-thing-at-point-to-recognize-bracketed-IPv6-URL.patch --] [-- Type: text/x-patch, Size: 1850 bytes --] From 1467585c21d1bebbb3823d4c71b9265c358e1b46 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 01:54:19 -0700 Subject: [PATCH 01/10] Teach thing-at-point to recognize bracketed IPv6 URLs * lisp/thingatpt.el (thing-at-point-bounds-of-url-at-point): Allow brackets. * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Add case for IPv6 URL. --- lisp/thingatpt.el | 2 +- test/lisp/thingatpt-tests.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b3dca5890f..5e597df6ff 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -430,7 +430,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..b5f4ea8cdc 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -44,6 +44,7 @@ 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://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net:5/a%20d,5") + ("http://[::1]:8000/foo" 10 url "http://[::1]:8000/foo") ;; <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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Accept-bracketed-IPv6-hosts-in-ERC.patch --] [-- Type: text/x-patch, Size: 2621 bytes --] From eb3c13c5a09634c2ae71bf3dc97bd32bcf1bef0f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 02:48:29 -0700 Subject: [PATCH 02/10] Accept bracketed IPv6 hosts in ERC * 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-select-read-args): Keep bracketed IPv6 hosts intact. --- lisp/erc/erc-backend.el | 8 ++++++++ lisp/erc/erc.el | 7 +++++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc7a7d14dc..2ead0c9ba5 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -532,12 +532,20 @@ 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 + ;; Likely gives false positives and false negatives + (rx bot "[" + (group (+ (or (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 0a16831fba..a7114a4bcf 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2348,8 +2348,11 @@ erc-select-read-args (setq user-input (read-string "IRC server: " (erc-compute-server) 'erc-server-history-list)) - - (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) + (if (and (string-match (rx (or (: (* (not "[")) ":" (* any)) + (group (+ any))) + ":" (group (+ (not (any ":]")))) eot) + user-input) + (match-string 1 user-input)) (setq port (erc-string-to-port (match-string 2 user-input)) user-input (match-string 1 user-input)) (setq port -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Default-to-TLS-port-when-calling-erc-tls-in-lisp-cod.patch --] [-- Type: text/x-patch, Size: 4781 bytes --] From 74d61e3d1e8c34cb31efe764e79ac64417b06b47 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 03/10] Default to TLS port when calling erc-tls in lisp code * lisp/erc/erc.el (erc-normalize-port): Add standard IANA port-name mappings for 6667 and 6697. (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): When `erc-port' hasn't been set and the port param is a string, ask `erc-normalize-port' to look it up before falling back to `erc-default-port'. * test/lisp/erc/erc-tests.el (erc-tls): Add simplistic test focusing on default parameters. --- lisp/erc/erc.el | 18 ++++++++++++++--- test/lisp/erc/erc-tests.el | 41 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a7114a4bcf..f09720fc79 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1743,6 +1743,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))) @@ -1751,6 +1756,8 @@ erc-normalize-port (cond ((> port-nr 0) port-nr) + ((string-equal port "ircu") 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "irc") 194) ((string-equal port "ircs") @@ -2171,7 +2178,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'. @@ -2434,7 +2443,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 @@ -6656,7 +6665,10 @@ 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)) + (cond ((numberp port) port) + (erc-port (erc-normalize-port erc-port)) + (port (erc-normalize-port port)) + (t erc-default-port))) ;; time routines diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4971d0e194..be95a2f8e0 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -893,4 +893,45 @@ erc-process-input-line (should-not calls)))))) +(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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Add-optional-server-param-to-erc-networks-determine.patch --] [-- Type: text/x-patch, Size: 2926 bytes --] From 1bd05c2ced90a2bdc339bdd8cfc76dd67918afc5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 04/10] 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 091b8aa92d..95338e5f1e 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1232,14 +1232,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 66a334b709..88b9c3ca04 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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Improve-new-connections-in-erc-handle-irc-url.patch --] [-- Type: text/x-patch, Size: 12366 bytes --] From 45afa0d04d2306b78cedfdf6eb2e04b13bdda2ba Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 05/10] 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--handle-irc-url-connect-function, erc--handle-ircs-url-connect-function): Add placeholders for possible future options allowing a user to connect when clicking an IRC link without being prompted. (erc--handle-url-connect-function): New function to serve as an interactive-only fallback when a user hasn't specified a connect function. (erc-url-ircs): Add function conforming to browse-url, and possibly other library interfaces that offer URI integration. --- lisp/erc/erc.el | 145 ++++++++++++++++++++++++++++++++----- test/lisp/erc/erc-tests.el | 95 ++++++++++++++++++++++++ 2 files changed, 223 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f09720fc79..f06bbc6ab0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7450,25 +7450,136 @@ 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 +;; 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". + ;;;###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 connect-fn) + "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. + +Note that ERC no longer attempts to establish new connections +without human intervention, although opting in may eventually be +allowed." + (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 + (unless connect-fn + (user-error "Existing session for %s not found." host)) + (setq deferred t + server-buffer (apply connect-fn :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)))))) + +;; 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, since ERC doesn't lacks any concept of +;; configured server profiles, it 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) +(declare-function url-type "url-parse.el" (url) t) +(declare-function url-p "url-parse.el" (url) t) + +;; 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))) + (provide 'erc) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index be95a2f8e0..f68a7debed 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -934,4 +934,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 () + (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)))) + + (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 connect) + (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) + (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) + (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) + (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) + (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) + (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 connect) + (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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0006-POC-Make-erc-once-with-server-event-more-nimble.patch --] [-- Type: text/x-patch, Size: 2041 bytes --] From ef467e6e378b1098bfe60ac2ab25270b035a63c0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 06/10] [POC] Make erc-once-with-server-event more nimble * lisp/erc/erc.el (erc-once-with-server-event, erc-once-more): Allow ephemeral callbacks to indicate a need to postpone cleanup and go another round by signaling the new custom error called `erc-once-again'. Also add new optional `depth' argument to let caller specify a hook depth. --- lisp/erc/erc.el | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f06bbc6ab0..39ec11c94b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1484,7 +1484,9 @@ erc--default-target (when erc--target (erc--target-string erc--target))) -(defun erc-once-with-server-event (event f) +(define-error 'erc-once-again "Untracked server event" 'error) + +(defun erc-once-with-server-event (event f &optional depth) "Run function F the next time EVENT occurs in the `current-buffer'. You should make sure that `current-buffer' is a server buffer. @@ -1507,11 +1509,16 @@ erc-once-with-server-event (hook (erc-get-hook event))) (put fun 'erc-original-buffer (current-buffer)) (fset fun (lambda (proc parsed) - (with-current-buffer (get fun 'erc-original-buffer) - (remove-hook hook fun t)) - (fmakunbound fun) - (funcall f proc parsed))) - (add-hook hook fun nil t) + (let (rv again) + (condition-case _err + (setq rv (funcall f proc parsed)) + (erc-once-again (setq again t))) + (unless again + (with-current-buffer (get fun 'erc-original-buffer) + (remove-hook hook fun t)) + (fmakunbound fun)) + rv))) + (add-hook hook fun depth t) fun)) (define-inline erc-log (string) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #9: 0007-POC-Support-one-off-JOIN-handlers-in-ERC.patch --] [-- Type: text/x-patch, Size: 2468 bytes --] From a46f0bc6f452aec9be43b1534f5dc385dc39e72e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 07/10] [POC] Support one-off JOIN handlers in ERC * lisp/erc/erc.el (erc--join-with-callback, erc-cmd-JOIN): Factor out joining logic for use in things like URL handlers for external integrations. Accept a callback to run when channel is joined. --- lisp/erc/erc.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 39ec11c94b..371612b085 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3542,6 +3542,26 @@ erc--valid-local-channel-p (string-search "&" chan-types) (string-match-p "&" chan-types)))))) +(defun erc--join-with-callback (chnl key on-join) + (if-let* ((existing (erc-get-buffer chnl erc-server-process)) + ((with-current-buffer existing + (erc-get-channel-user (erc-current-nick))))) + (progn (switch-to-buffer existing) + (when on-join (funcall on-join))) + (let ((callback + (and on-join + (lambda (_ parsed) + (unless (equal chnl + (car (erc-response.command-args parsed))) + (signal 'erc-once-again nil)) + (with-current-buffer (erc-get-buffer chnl erc-server-process) + (funcall on-join)) + nil)))) + (setq erc--server-last-reconnect-count 0) + (when callback + (erc-once-with-server-event 'JOIN callback 90)) + (erc-server-join-channel nil chnl key)))) + (defun erc-cmd-JOIN (channel &optional key) "Join the channel given in CHANNEL, optionally with KEY. If CHANNEL is specified as \"-invite\", join the channel to which you @@ -3554,12 +3574,7 @@ erc-cmd-JOIN (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (if-let* ((existing (erc-get-buffer chnl erc-server-process)) - ((with-current-buffer existing - (erc-get-channel-user (erc-current-nick))))) - (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) - (erc-server-join-channel nil chnl key)))) + (erc--join-with-callback chnl key nil))) t) (defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #10: 0008-POC-Use-erc-join-with-callback-in-URL-handler.patch --] [-- Type: text/x-patch, Size: 2392 bytes --] From 596835a935222f4625820340bf8d86a487646ace Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 08/10] [POC] Use erc--join-with-callback in URL handler * lisp/erc/erc.el (erc-handle-irc-url): Accept new `on-join' one-off JOIN handler and pass it to `erc--join-with-callback'. * test/lisp/erc/erc-tests.el (erc-handle-irc-url): Use `erc--join-with-callback' instead of `erc-cmd-JOIN'. --- lisp/erc/erc.el | 6 +++--- test/lisp/erc/erc-tests.el | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 371612b085..fd91441828 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7479,7 +7479,7 @@ erc-get-parsed-vector-type ;;;###autoload (defun erc-handle-irc-url (host port channel nick password - &optional connect-fn) + &optional connect-fn on-join) "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. @@ -7526,10 +7526,10 @@ erc-handle-irc-url (with-current-buffer server-buffer (letrec ((f (lambda (&rest _) (remove-hook 'erc-after-connect f t) - (erc-cmd-JOIN channel key)))) + (erc--join-with-callback channel key on-join)))) (add-hook 'erc-after-connect f nil t))) (with-current-buffer server-buffer - (erc-cmd-JOIN channel key)))))) + (erc--join-with-callback channel key on-join)))))) ;; XXX ERASE ME (possibly use as basis for new section in info doc) ;; diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f68a7debed..947b45e1dc 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -968,8 +968,8 @@ erc-handle-irc-url (push r calls) (if (functionp rvbuf) (funcall rvbuf) rvbuf)))) - (cl-letf (((symbol-function 'erc-cmd-JOIN) - (lambda (&rest r) (push r calls)))) + (cl-letf (((symbol-function 'erc--join-with-callback) + (lambda (&rest r) (push (butlast r) calls)))) (with-current-buffer (erc-tests--make-server-buf "foonet") (setq rvbuf (current-buffer))) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #11: 0009-POC-Demo-improved-ol-irc-integration.patch --] [-- Type: text/x-patch, Size: 2928 bytes --] From 35c018604c93d7f7f4a52393c7e55dab185c0f90 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 09/10] [POC] Demo improved ol-irc integration * lisp/erc/erc.el (erc--org-init, erc--handle-url-org-visit, erc--handle-url-org-visit-irc, erc--handle-url-org-visit-ircs): Add various functions to demo org link integration. --- lisp/erc/erc.el | 52 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fd91441828..7137a7b401 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7602,6 +7602,58 @@ erc--handle-ircs-url ;; Amazingly, this does TRT for /&chan, /#chan, /##chan, /#&chan (url-irc url))) +;; ERASE ME +;; +;; Org's ol-irc.el is pretty elaborate. But a lot of things have to +;; go perfectly for joining and prompting to work as intended. + +(defun erc--handle-url-org-visit (ircsp link) + ;; The dispatcher that calls `org-irc-visit' strips the scheme and + ;; colon, leaving only "//irc.gnu.org/#chan", which becomes + ;; (("irc.gnu.org") "#chan") when parsed by `org-irc-parse-link'. + (pcase-let* + ((`((,server ,port) ,channel ,nick) link) + (oj (and nick + (lambda () + (cl-assert nick) + ;; Channel may not be populated yet + (unless (erc-get-server-user nick) + (erc-error "%s not found in %s" nick (erc-default-target))) + (goto-char erc-input-marker) + (insert (concat nick ": "))))) + (fn (or (if ircsp + erc--url-ircs-connect-function + erc--url-irc-connect-function) + (apply-partially #'erc--url-default-connect-function + (and ircsp t))))) + (erc-handle-irc-url server port channel nil nil fn oj))) + +(declare-function org-irc-parse-link "ol-irc" (link)) +(declare-function org-link-get-parameter "ol" (type key)) +(declare-function org-link-set-parameters "ol" (type &rest parameters)) + +(defun erc--handle-url-org-follow-irc (link _) + (erc--handle-url-org-visit nil (org-irc-parse-link link))) + +(defun erc--handle-url-org-follow-ircs (link _) + (erc--handle-url-org-visit t (org-irc-parse-link link))) + +;; Eventually, we should petition for `org-irc-visit-erc' to call our +;; stuff to do the heavy lifting, assuming a new enough Emacs is +;; present. The following is only for demo purposes. + +(defun erc--org-init () + ;; TODO also add irc6 and irc6s (possibly nonstandard) + (require 'ol-irc) + (org-link-set-parameters + "irc" + :follow #'erc--handle-url-org-follow-irc) + (org-link-set-parameters + "ircs" + :follow #'erc--handle-url-org-follow-ircs + :store (org-link-get-parameter "irc" :store) + :export (org-link-get-parameter "irc" :export))) + (provide 'erc) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #12: 0010-POC-etc-emacs-irc.desktop-New-file.patch --] [-- Type: text/x-patch, Size: 998 bytes --] From 1ef37c2aeff57b5d81a6ebd64a5a0d505203d923 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 22:07:08 -0700 Subject: [PATCH 10/10] [POC] * etc/emacs-irc.desktop: New file. --- etc/emacs-irc.desktop | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 etc/emacs-irc.desktop diff --git a/etc/emacs-irc.desktop b/etc/emacs-irc.desktop new file mode 100644 index 0000000000..ebdcda3a07 --- /dev/null +++ b/etc/emacs-irc.desktop @@ -0,0 +1,13 @@ +[Desktop Entry] +Name=Emacs (IRC) +GenericName=Chat client +Keywords=ERC;extensible;chat;IRC;client; +Categories=Network;Chat;IRCClient; +Comment=GNU Emacs is an extensible, customizable text editor - ERC is a powerful, modular, and extensible IRC client for Emacs +# FIXME update command line and name once autoloaded +Exec=emacs -l erc -f erc--handle-ircs-url %u +Icon=emacs +MimeType=x-scheme-handler/irc;x-scheme-handler/ircs; +NoDisplay=true +Terminal=false +Type=Application -- 2.36.1 ^ permalink raw reply related [flat|nested] 14+ messages in thread
[parent not found: <874jzl2hsv.fsf@neverwas.me>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <874jzl2hsv.fsf@neverwas.me> @ 2022-07-13 15:55 ` Stefan Kangas [not found] ` <CADwFkmkgXKH3y2i1si76V_NOuSyJENVrCLdEJ1AfDHEv9qh8jw@mail.gmail.com> 1 sibling, 0 replies; 14+ messages in thread From: Stefan Kangas @ 2022-07-13 15:55 UTC (permalink / raw) To: J.P., Lars Ingebrigtsen; +Cc: 56514, emacs-erc "J.P." <jp@neverwas.me> writes: > 1. The first patch strays outside ERC's turf. Should I open a separate > bug report for it? [1]. No need, as (IMHO) it's obviously correct. > 3. Should I include the actual setup code for the integrations? If so, > where would that go? My initial plan was to just have it all live > in the docs, perhaps under a new Info node. BTW (re integrations), My only comment is that it would be better if this all worked OOTB, but also that it would be even better if it was easy to switch between erc and rcirc in one centralized location (as opposed to having to redo the song and dance for EWW, browse-url, gnus, etc.). I'm not sure what's the best place to put it though. > I also threw in a .desktop file [2], knowing full well that folks > may just perceive that as more clutter polluting the Emacs tree. > Should I drop it? People wanting one can just make their own. What does the .desktop file imply here? Does it just make things easier to setup or does it come with it's own menu entry in desktop environments, etc.? (I don't use any desktop environment myself.) If it just makes setting things up easier, I don't see why we shouldn't include it. ^ permalink raw reply [flat|nested] 14+ messages in thread
[parent not found: <CADwFkmkgXKH3y2i1si76V_NOuSyJENVrCLdEJ1AfDHEv9qh8jw@mail.gmail.com>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <CADwFkmkgXKH3y2i1si76V_NOuSyJENVrCLdEJ1AfDHEv9qh8jw@mail.gmail.com> @ 2022-07-14 7:00 ` J.P. [not found] ` <874jzkuqk3.fsf@neverwas.me> 1 sibling, 0 replies; 14+ messages in thread From: J.P. @ 2022-07-14 7:00 UTC (permalink / raw) To: Stefan Kangas; +Cc: Lars Ingebrigtsen, emacs-erc, 56514 [-- Attachment #1: Type: text/plain, Size: 2851 bytes --] Stefan Kangas <stefankangas@gmail.com> writes: > "J.P." <jp@neverwas.me> writes: > >> 1. The first patch strays outside ERC's turf. Should I open a separate >> bug report for it? [1]. > > No need, as (IMHO) it's obviously correct. Okay, nice. FWIW, I've since added another test case covering those bracketed links sometimes found in markup languages. >> 3. Should I include the actual setup code for the integrations? If so, >> where would that go? My initial plan was to just have it all live >> in the docs, perhaps under a new Info node. BTW (re integrations), > > My only comment is that it would be better if this all worked OOTB, but > also that it would be even better if it was easy to switch between erc > and rcirc in one centralized location (as opposed to having to redo the > song and dance for EWW, browse-url, gnus, etc.). > > I'm not sure what's the best place to put it though. Me neither. But unifying everything seems like a worthy goal and the responsible thing to do. Although, ERC, as usual, will then have to decide whether to include compat code or just not support some aspects of URL handling on older versions of Emacs. It seems if we could somehow get all IRC-related URL types, like irc6, to look in lisp/url/url-irc.el for a loader, tweaking the existing code to serve these other variants would then be pretty straightforward (assuming that doesn't buck the original design too violently). >> I also threw in a .desktop file [2], knowing full well that folks >> may just perceive that as more clutter polluting the Emacs tree. >> Should I drop it? People wanting one can just make their own. > > What does the .desktop file imply here? Does it just make things easier > to setup or does it come with it's own menu entry in desktop > environments, etc.? (I don't use any desktop environment myself.) > > If it just makes setting things up easier, I don't see why we shouldn't > include it. As you suspect, some desktop environments use *.desktop files as a means of declaring default apps for opening various file types and URLs. IMO, the main problem is that it's difficult to know what folks expect to happen when clicking an irc:// link (in Firefox, say). For example, my current version tries to use an existing Emacs instance and falls back to creating one with emacs -Q. But people may not run an Emacs server or else may not want an existing one disturbed by IRC silliness. Others may want to load their own ERC config instead of being handed a plain vanilla ERC (which is currently the case). For these reasons, I find it unlikely we'd want to include this. But, if things go the other way, now or in the future, it'd be nice to have it depend on a unified interface rather than something client-specific. Anyway, thanks for your input. It's very much appreciated. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v2-v3.diff --] [-- Type: text/x-patch, Size: 13619 bytes --] From d627cde4978704db9b73a3cf55e4353fc2280388 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 22:20:19 -0700 Subject: [PATCH 00/10] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (10): Teach thing-at-point to recognize bracketed IPv6 URLs 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 [POC] Make erc-once-with-server-event more nimble [POC] Support one-off JOIN handlers in ERC [POC] Use erc--join-with-callback in URL handler [POC] Demo improved ol-irc integration [POC] * etc/emacs-irc.desktop: New file. etc/emacs-irc.desktop | 13 ++ lisp/erc/erc-backend.el | 6 + lisp/erc/erc-networks.el | 9 +- lisp/erc/erc.el | 338 ++++++++++++++++++++++------ lisp/thingatpt.el | 2 +- test/lisp/erc/erc-networks-tests.el | 17 ++ test/lisp/erc/erc-tests.el | 226 +++++++++++++++++++ test/lisp/thingatpt-tests.el | 3 + 8 files changed, 535 insertions(+), 79 deletions(-) create mode 100644 etc/emacs-irc.desktop Interdiff: diff --git a/etc/emacs-irc.desktop b/etc/emacs-irc.desktop index ebdcda3a07..96ce551647 100644 --- a/etc/emacs-irc.desktop +++ b/etc/emacs-irc.desktop @@ -5,7 +5,7 @@ Keywords=ERC;extensible;chat;IRC;client; Categories=Network;Chat;IRCClient; Comment=GNU Emacs is an extensible, customizable text editor - ERC is a powerful, modular, and extensible IRC client for Emacs # FIXME update command line and name once autoloaded -Exec=emacs -l erc -f erc--handle-ircs-url %u +Exec=sh -c "U=%u C=emacsclient E=emacs; if \\$C --eval emacs-version >/dev/null 2>&1; then exec \\$C --eval '(require (quote erc))' --eval \"(erc--handle-ircs-url \\\\\"\\$U\\\\\")\"; else exec \\$E -Q -l erc -f erc--handle-ircs-url \"\\$U\"; fi" Icon=emacs MimeType=x-scheme-handler/irc;x-scheme-handler/ircs; NoDisplay=true diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 2ead0c9ba5..9532891a38 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -533,10 +533,8 @@ erc-open-network-stream (apply #'open-network-stream name buffer host service p))) (defvar erc--server-connect-dumb-ipv6-regexp - ;; Likely gives false positives and false negatives - (rx bot "[" - (group (+ (or (any xdigit digit ":.") (: "%" (+ alnum))))) - "]" eot)) + ;; 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. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7137a7b401..46a714f302 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,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.") @@ -2357,55 +2357,47 @@ 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 (and (string-match (rx (or (: (* (not "[")) ":" (* any)) - (group (+ any))) - ":" (group (+ (not (any ":]")))) eot) - user-input) - (match-string 1 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 (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))))) (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 @@ -7556,9 +7548,9 @@ erc-handle-irc-url ;; 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, since ERC doesn't lacks any concept of -;; configured server profiles, it has no idea what values to give for -;; connection parameters, like nick, user, etc. +;; 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 @@ -7581,8 +7573,6 @@ erc--url-default-connect-function (call-interactively (if ircs #'erc-tls #'erc)))) (defvar url-irc-function) -(declare-function url-type "url-parse.el" (url) t) -(declare-function url-p "url-parse.el" (url) t) ;; FIXME rename this and autoload it (defun erc--handle-ircs-url (&optional url &rest _) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 947b45e1dc..b3228c0a62 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -893,6 +893,96 @@ erc-process-input-line (should-not calls)))))) +(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 ("Default") + (should (equal (ert-simulate-keys "\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6667 + :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))) + (list :server "irc.libera.chat" + :port 6697 + :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" + (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 "\C-a\C-knick@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 "\C-a\C-knick: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 "\C-a\C-k::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 "\C-a\C-k[::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 "\C-a\C-knick@[::1]:6667\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick "nick" + :password nil))))) + (ert-deftest erc-tls () (let (calls) (cl-letf (((symbol-function 'user-login-name) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index b5f4ea8cdc..67dd00104b 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -44,7 +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://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net:5/a%20d,5") - ("http://[::1]:8000/foo" 10 url "http://[::1]:8000/foo") + ;; 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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Teach-thing-at-point-to-recognize-bracketed-IPv6-URL.patch --] [-- Type: text/x-patch, Size: 2089 bytes --] From 5037acbd6208a4f023029d23523de18e2ea2defe Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 01:54:19 -0700 Subject: [PATCH 01/10] 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 b3dca5890f..5e597df6ff 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -430,7 +430,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://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net: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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Refactor-erc-select-read-args.patch --] [-- Type: text/x-patch, Size: 10727 bytes --] From 99864cadfb278704353696acb915979267daa153 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 13 Jul 2022 02:48:29 -0700 Subject: [PATCH 02/10] 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-backend.el | 6 +++ lisp/erc/erc.el | 79 ++++++++++++++++----------------- test/lisp/erc/erc-tests.el | 90 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 133 insertions(+), 42 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc7a7d14dc..9532891a38 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -532,12 +532,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 0a16831fba..92503e0579 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,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.") @@ -2341,52 +2341,47 @@ 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 (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))))) (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 4971d0e194..e7b9c7aa1e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -893,4 +893,94 @@ erc-process-input-line (should-not calls)))))) +(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 ("Default") + (should (equal (ert-simulate-keys "\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6667 + :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))) + (list :server "irc.libera.chat" + :port 6697 + :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" + (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 "\C-a\C-knick@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 "\C-a\C-knick: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 "\C-a\C-k::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 "\C-a\C-k[::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 "\C-a\C-knick@[::1]:6667\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick "nick" + :password nil))))) + ;;; erc-tests.el ends here -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch --] [-- Type: text/x-patch, Size: 4823 bytes --] From cee9be56cad2c5c4b290943892040d0c5d5960c2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 03/10] Default to TLS port when calling erc-tls from lisp * lisp/erc/erc.el (erc-normalize-port): Add standard IANA port-name mappings for 6667 and 6697. (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): When `erc-port' hasn't been set and the port param is a string, ask `erc-normalize-port' to look it up before falling back to `erc-default-port'. * test/lisp/erc/erc-tests.el (erc-tls): Add simplistic test focusing on default parameters. --- lisp/erc/erc.el | 18 ++++++++++++++--- test/lisp/erc/erc-tests.el | 41 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 92503e0579..b4893c1703 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1743,6 +1743,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))) @@ -1751,6 +1756,8 @@ erc-normalize-port (cond ((> port-nr 0) port-nr) + ((string-equal port "ircu") 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "irc") 194) ((string-equal port "ircs") @@ -2171,7 +2178,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'. @@ -2426,7 +2435,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 @@ -6648,7 +6657,10 @@ 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)) + (cond ((numberp port) port) + (erc-port (erc-normalize-port erc-port)) + (port (erc-normalize-port port)) + (t erc-default-port))) ;; time routines diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e7b9c7aa1e..909645b41f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -983,4 +983,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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Add-optional-server-param-to-erc-networks-determine.patch --] [-- Type: text/x-patch, Size: 2926 bytes --] From edc67ef9db79673283a78d2bf87b2f6a07964d86 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 04/10] 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 091b8aa92d..95338e5f1e 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1232,14 +1232,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 66a334b709..88b9c3ca04 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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Improve-new-connections-in-erc-handle-irc-url.patch --] [-- Type: text/x-patch, Size: 12255 bytes --] From 7d04f024d9f9072682b43258a15e985fe5c0c78b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 05/10] 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--handle-irc-url-connect-function, erc--handle-ircs-url-connect-function): Add placeholders for possible future options allowing a user to connect when clicking an IRC link without being prompted. (erc--handle-url-connect-function): New function to serve as an interactive-only fallback when a user hasn't specified a connect function. (erc-url-ircs): Add function conforming to browse-url, and possibly other library interfaces that offer URI integration. --- lisp/erc/erc.el | 143 ++++++++++++++++++++++++++++++++----- test/lisp/erc/erc-tests.el | 95 ++++++++++++++++++++++++ 2 files changed, 221 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b4893c1703..0c71f2a7f7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7442,25 +7442,134 @@ 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 +;; 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". + ;;;###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 connect-fn) + "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. + +Note that ERC no longer attempts to establish new connections +without human intervention, although opting in may eventually be +allowed." + (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 + (unless connect-fn + (user-error "Existing session for %s not found." host)) + (setq deferred t + server-buffer (apply connect-fn :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)))))) + +;; 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))) + (provide 'erc) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 909645b41f..53a2d02db6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1024,4 +1024,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 () + (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)))) + + (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 connect) + (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) + (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) + (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) + (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) + (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) + (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 connect) + (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.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0006-POC-Make-erc-once-with-server-event-more-nimble.patch --] [-- Type: text/x-patch, Size: 2041 bytes --] From 522b265843620c2e9d593e7bf3e0b458dbce836b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 06/10] [POC] Make erc-once-with-server-event more nimble * lisp/erc/erc.el (erc-once-with-server-event, erc-once-more): Allow ephemeral callbacks to indicate a need to postpone cleanup and go another round by signaling the new custom error called `erc-once-again'. Also add new optional `depth' argument to let caller specify a hook depth. --- lisp/erc/erc.el | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0c71f2a7f7..2e4b10d847 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1484,7 +1484,9 @@ erc--default-target (when erc--target (erc--target-string erc--target))) -(defun erc-once-with-server-event (event f) +(define-error 'erc-once-again "Untracked server event" 'error) + +(defun erc-once-with-server-event (event f &optional depth) "Run function F the next time EVENT occurs in the `current-buffer'. You should make sure that `current-buffer' is a server buffer. @@ -1507,11 +1509,16 @@ erc-once-with-server-event (hook (erc-get-hook event))) (put fun 'erc-original-buffer (current-buffer)) (fset fun (lambda (proc parsed) - (with-current-buffer (get fun 'erc-original-buffer) - (remove-hook hook fun t)) - (fmakunbound fun) - (funcall f proc parsed))) - (add-hook hook fun nil t) + (let (rv again) + (condition-case _err + (setq rv (funcall f proc parsed)) + (erc-once-again (setq again t))) + (unless again + (with-current-buffer (get fun 'erc-original-buffer) + (remove-hook hook fun t)) + (fmakunbound fun)) + rv))) + (add-hook hook fun depth t) fun)) (define-inline erc-log (string) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #9: 0007-POC-Support-one-off-JOIN-handlers-in-ERC.patch --] [-- Type: text/x-patch, Size: 2468 bytes --] From c82733f30fab7692ca4da2f5cb458c0e5e4470c2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 07/10] [POC] Support one-off JOIN handlers in ERC * lisp/erc/erc.el (erc--join-with-callback, erc-cmd-JOIN): Factor out joining logic for use in things like URL handlers for external integrations. Accept a callback to run when channel is joined. --- lisp/erc/erc.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2e4b10d847..a8800497ff 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3534,6 +3534,26 @@ erc--valid-local-channel-p (string-search "&" chan-types) (string-match-p "&" chan-types)))))) +(defun erc--join-with-callback (chnl key on-join) + (if-let* ((existing (erc-get-buffer chnl erc-server-process)) + ((with-current-buffer existing + (erc-get-channel-user (erc-current-nick))))) + (progn (switch-to-buffer existing) + (when on-join (funcall on-join))) + (let ((callback + (and on-join + (lambda (_ parsed) + (unless (equal chnl + (car (erc-response.command-args parsed))) + (signal 'erc-once-again nil)) + (with-current-buffer (erc-get-buffer chnl erc-server-process) + (funcall on-join)) + nil)))) + (setq erc--server-last-reconnect-count 0) + (when callback + (erc-once-with-server-event 'JOIN callback 90)) + (erc-server-join-channel nil chnl key)))) + (defun erc-cmd-JOIN (channel &optional key) "Join the channel given in CHANNEL, optionally with KEY. If CHANNEL is specified as \"-invite\", join the channel to which you @@ -3546,12 +3566,7 @@ erc-cmd-JOIN (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. - (if-let* ((existing (erc-get-buffer chnl erc-server-process)) - ((with-current-buffer existing - (erc-get-channel-user (erc-current-nick))))) - (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) - (erc-server-join-channel nil chnl key)))) + (erc--join-with-callback chnl key nil))) t) (defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #10: 0008-POC-Use-erc-join-with-callback-in-URL-handler.patch --] [-- Type: text/x-patch, Size: 2394 bytes --] From f7b789bf7655c914b585bd46e90ed15d4666bccf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 08/10] [POC] Use erc--join-with-callback in URL handler * lisp/erc/erc.el (erc-handle-irc-url): Accept new `on-join' one-off JOIN handler and pass it to `erc--join-with-callback'. * test/lisp/erc/erc-tests.el (erc-handle-irc-url): Use `erc--join-with-callback' instead of `erc-cmd-JOIN'. --- lisp/erc/erc.el | 6 +++--- test/lisp/erc/erc-tests.el | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a8800497ff..3ea551beac 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7471,7 +7471,7 @@ erc-get-parsed-vector-type ;;;###autoload (defun erc-handle-irc-url (host port channel nick password - &optional connect-fn) + &optional connect-fn on-join) "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. @@ -7518,10 +7518,10 @@ erc-handle-irc-url (with-current-buffer server-buffer (letrec ((f (lambda (&rest _) (remove-hook 'erc-after-connect f t) - (erc-cmd-JOIN channel key)))) + (erc--join-with-callback channel key on-join)))) (add-hook 'erc-after-connect f nil t))) (with-current-buffer server-buffer - (erc-cmd-JOIN channel key)))))) + (erc--join-with-callback channel key on-join)))))) ;; XXX ERASE ME (possibly use as basis for new section in info doc) ;; diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 53a2d02db6..b3228c0a62 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1058,8 +1058,8 @@ erc-handle-irc-url (push r calls) (if (functionp rvbuf) (funcall rvbuf) rvbuf)))) - (cl-letf (((symbol-function 'erc-cmd-JOIN) - (lambda (&rest r) (push r calls)))) + (cl-letf (((symbol-function 'erc--join-with-callback) + (lambda (&rest r) (push (butlast r) calls)))) (with-current-buffer (erc-tests--make-server-buf "foonet") (setq rvbuf (current-buffer))) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #11: 0009-POC-Demo-improved-ol-irc-integration.patch --] [-- Type: text/x-patch, Size: 2928 bytes --] From 202781bacf601d100b9bf0bbfd2da03daf8bbabf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 09/10] [POC] Demo improved ol-irc integration * lisp/erc/erc.el (erc--org-init, erc--handle-url-org-visit, erc--handle-url-org-visit-irc, erc--handle-url-org-visit-ircs): Add various functions to demo org link integration. --- lisp/erc/erc.el | 52 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3ea551beac..46a714f302 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7592,6 +7592,58 @@ erc--handle-ircs-url ;; Amazingly, this does TRT for /&chan, /#chan, /##chan, /#&chan (url-irc url))) +;; ERASE ME +;; +;; Org's ol-irc.el is pretty elaborate. But a lot of things have to +;; go perfectly for joining and prompting to work as intended. + +(defun erc--handle-url-org-visit (ircsp link) + ;; The dispatcher that calls `org-irc-visit' strips the scheme and + ;; colon, leaving only "//irc.gnu.org/#chan", which becomes + ;; (("irc.gnu.org") "#chan") when parsed by `org-irc-parse-link'. + (pcase-let* + ((`((,server ,port) ,channel ,nick) link) + (oj (and nick + (lambda () + (cl-assert nick) + ;; Channel may not be populated yet + (unless (erc-get-server-user nick) + (erc-error "%s not found in %s" nick (erc-default-target))) + (goto-char erc-input-marker) + (insert (concat nick ": "))))) + (fn (or (if ircsp + erc--url-ircs-connect-function + erc--url-irc-connect-function) + (apply-partially #'erc--url-default-connect-function + (and ircsp t))))) + (erc-handle-irc-url server port channel nil nil fn oj))) + +(declare-function org-irc-parse-link "ol-irc" (link)) +(declare-function org-link-get-parameter "ol" (type key)) +(declare-function org-link-set-parameters "ol" (type &rest parameters)) + +(defun erc--handle-url-org-follow-irc (link _) + (erc--handle-url-org-visit nil (org-irc-parse-link link))) + +(defun erc--handle-url-org-follow-ircs (link _) + (erc--handle-url-org-visit t (org-irc-parse-link link))) + +;; Eventually, we should petition for `org-irc-visit-erc' to call our +;; stuff to do the heavy lifting, assuming a new enough Emacs is +;; present. The following is only for demo purposes. + +(defun erc--org-init () + ;; TODO also add irc6 and irc6s (possibly nonstandard) + (require 'ol-irc) + (org-link-set-parameters + "irc" + :follow #'erc--handle-url-org-follow-irc) + (org-link-set-parameters + "ircs" + :follow #'erc--handle-url-org-follow-ircs + :store (org-link-get-parameter "irc" :store) + :export (org-link-get-parameter "irc" :export))) + (provide 'erc) -- 2.36.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #12: 0010-POC-etc-emacs-irc.desktop-New-file.patch --] [-- Type: text/x-patch, Size: 1200 bytes --] From d627cde4978704db9b73a3cf55e4353fc2280388 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 22:07:08 -0700 Subject: [PATCH 10/10] [POC] * etc/emacs-irc.desktop: New file. --- etc/emacs-irc.desktop | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 etc/emacs-irc.desktop diff --git a/etc/emacs-irc.desktop b/etc/emacs-irc.desktop new file mode 100644 index 0000000000..96ce551647 --- /dev/null +++ b/etc/emacs-irc.desktop @@ -0,0 +1,13 @@ +[Desktop Entry] +Name=Emacs (IRC) +GenericName=Chat client +Keywords=ERC;extensible;chat;IRC;client; +Categories=Network;Chat;IRCClient; +Comment=GNU Emacs is an extensible, customizable text editor - ERC is a powerful, modular, and extensible IRC client for Emacs +# FIXME update command line and name once autoloaded +Exec=sh -c "U=%u C=emacsclient E=emacs; if \\$C --eval emacs-version >/dev/null 2>&1; then exec \\$C --eval '(require (quote erc))' --eval \"(erc--handle-ircs-url \\\\\"\\$U\\\\\")\"; else exec \\$E -Q -l erc -f erc--handle-ircs-url \"\\$U\"; fi" +Icon=emacs +MimeType=x-scheme-handler/irc;x-scheme-handler/ircs; +NoDisplay=true +Terminal=false +Type=Application -- 2.36.1 ^ permalink raw reply related [flat|nested] 14+ messages in thread
[parent not found: <874jzkuqk3.fsf@neverwas.me>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <874jzkuqk3.fsf@neverwas.me> @ 2022-11-08 14:09 ` J.P. 2022-11-08 15:16 ` Stefan Kangas [not found] ` <CADwFkm=d+8wb6o_EwvKZWR7yc4tbwscgZ-YPzBnSqty42W+_Pg@mail.gmail.com> 0 siblings, 2 replies; 14+ messages in thread From: J.P. @ 2022-11-08 14:09 UTC (permalink / raw) To: 56514; +Cc: Lars Ingebrigtsen, emacs-erc, Stefan Kangas [-- Attachment #1: Type: text/plain, Size: 1536 bytes --] 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! [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v3-v4.diff --] [-- Type: text/x-patch, Size: 26174 bytes --] From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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://tester@irc.gnu.org/#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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Teach-thing-at-point-to-recognize-bracketed-IPv6-URL.patch --] [-- Type: text/x-patch, Size: 2087 bytes --] From 0d191d30b15ea2d5b6042f51c6cf421b82feb7e5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net: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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Accommodate-ircs-URLs-in-url-irc-and-browse-url.patch --] [-- Type: text/x-patch, Size: 4533 bytes --] From 6fd2f75707f123abfbcfae2d4f2837efed5b7adc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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://tester@irc.gnu.org/#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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Refactor-erc-select-read-args.patch --] [-- Type: text/x-patch, Size: 11086 bytes --] From e64b845f097590889109b6033f42cb5d68abf0b9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch --] [-- Type: text/x-patch, Size: 5926 bytes --] From a9b47f5a6079fb3030c9e1514b4cbbda86dafff8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Add-optional-server-param-to-erc-networks-determine.patch --] [-- Type: text/x-patch, Size: 2924 bytes --] From 9a44991ef351274c45d300d825066dd805296454 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0006-Improve-new-connections-in-erc-handle-irc-url.patch --] [-- Type: text/x-patch, Size: 14236 bytes --] From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 ^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links 2022-11-08 14:09 ` J.P. @ 2022-11-08 15:16 ` Stefan Kangas [not found] ` <CADwFkm=d+8wb6o_EwvKZWR7yc4tbwscgZ-YPzBnSqty42W+_Pg@mail.gmail.com> 1 sibling, 0 replies; 14+ messages in thread From: Stefan Kangas @ 2022-11-08 15:16 UTC (permalink / raw) To: J.P., 56514; +Cc: Lars Ingebrigtsen, emacs-erc "J.P." <jp@neverwas.me> writes: > 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? I'm hoping someone else will weigh in about this. > 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? No real opinion here. It feels slightly cleaner to add it as a proper argument, if we expect that other IRC clients than ERC would be interested in its value. > 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? You do have a point, but I think it's better to have the user option for consistency, and for ease of customization. Customizing an alist with customize is always going to be harder than customizing a single-value user option. > 4. Are any of these non-ERC changes newsworthy enough for etc/NEWS? I think teaching browse-url to recognize irc URLs is NEWS-worthy. I also added some notes inline below: > From 0d191d30b15ea2d5b6042f51c6cf421b82feb7e5 Mon Sep 17 00:00:00 2001 > From: "F. Jason Park" <jp@neverwas.me> > Date: Wed, 13 Jul 2022 01:54:19 -0700 > Subject: [PATCH 1/6] Teach thing-at-point to recognize bracketed IPv6 URLs I suggest pushing this patch so that we're sure to have it in Emacs 29. I don't think it's NEWS-worthy, as it's more of a bug fix. > From 6fd2f75707f123abfbcfae2d4f2837efed5b7adc Mon Sep 17 00:00:00 2001 > From: "F. Jason Park" <jp@neverwas.me> > Date: Mon, 11 Jul 2022 05:14:57 -0700 > Subject: [PATCH 2/6] Accommodate ircs:// URLs in url-irc and browse-url [...] > +;;;; 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) This change (support for ircs) should probably be in NEWS. What about `irc6' and `irc6s'? Should they have aliases? > From a9b47f5a6079fb3030c9e1514b4cbbda86dafff8 Mon Sep 17 00:00:00 2001 > From: "F. Jason Park" <jp@neverwas.me> > 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. This belongs in NEWS. > @@ -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."))) Warning about the default seems unfortunate. Then every user will be warned until they customize this. I think we should either disable the warning, or flip the default to nil. > From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 > From: "F. Jason Park" <jp@neverwas.me> > Date: Mon, 11 Jul 2022 05:14:57 -0700 > Subject: [PATCH 6/6] Improve new connections in erc-handle-irc-url [...] > @@ -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. Why would that be more polite? It seems to me that, sure, if you're developing an IRC client I can see why you'd want to use a test network. But it seems like overkill just for user customization. > @@ -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 > + This is a breaking change, no? I think it should be in NEWS, even if it is only to make ERC more standards compliant. ^ permalink raw reply [flat|nested] 14+ messages in thread
[parent not found: <CADwFkm=d+8wb6o_EwvKZWR7yc4tbwscgZ-YPzBnSqty42W+_Pg@mail.gmail.com>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <CADwFkm=d+8wb6o_EwvKZWR7yc4tbwscgZ-YPzBnSqty42W+_Pg@mail.gmail.com> @ 2022-11-09 13:41 ` J.P. 0 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2022-11-09 13:41 UTC (permalink / raw) To: Stefan Kangas; +Cc: 56514, emacs-erc, Lars Ingebrigtsen [-- Attachment #1: Type: text/plain, Size: 7038 bytes --] Stefan Kangas <stefankangas@gmail.com> writes: > "J.P." <jp@neverwas.me> writes: > >> 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? > > I'm hoping someone else will weigh in about this. > >> 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? > > No real opinion here. It feels slightly cleaner to add it as a proper > argument, if we expect that other IRC clients than ERC would be > interested in its value. Thinking about this more, I guess it's fine if a modern ERC running on an older Emacs uses the port alone to decide whether to connect over TLS. As such, I've abandoned the whole `url-irc-function' thing in favor of adding a proper argument, as suggested. The small fraction of users with their own `url-irc-function' (if any) may feel some churn though. >> 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? > > You do have a point, but I think it's better to have the user option for > consistency, and for ease of customization. Customizing an alist with > customize is always going to be harder than customizing a single-value > user option. Makes sense. I have thus added the missing ingredients and wired them up. >> 4. Are any of these non-ERC changes newsworthy enough for etc/NEWS? > > I think teaching browse-url to recognize irc URLs is NEWS-worthy. Added. > I also added some notes inline below: Much appreciated! >> From 0d191d30b15ea2d5b6042f51c6cf421b82feb7e5 Mon Sep 17 00:00:00 2001 >> From: "F. Jason Park" <jp@neverwas.me> >> Date: Wed, 13 Jul 2022 01:54:19 -0700 >> Subject: [PATCH 1/6] Teach thing-at-point to recognize bracketed IPv6 URLs > > I suggest pushing this patch so that we're sure to have it in Emacs 29. > > I don't think it's NEWS-worthy, as it's more of a bug fix. Installed. >> From 6fd2f75707f123abfbcfae2d4f2837efed5b7adc Mon Sep 17 00:00:00 2001 >> From: "F. Jason Park" <jp@neverwas.me> >> Date: Mon, 11 Jul 2022 05:14:57 -0700 >> Subject: [PATCH 2/6] Accommodate ircs:// URLs in url-irc and browse-url > [...] >> +;;;; 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) > > This change (support for ircs) should probably be in NEWS. Added. > What about `irc6' and `irc6s'? Should they have aliases? I guess I was trying to avoid growing lisp/loaddefs.el on account of a couple URL schemes that haven't caught on in the wild (and don't seem poised to). Still, I might as well ask around with some IRC folk just to be sure. >> From a9b47f5a6079fb3030c9e1514b4cbbda86dafff8 Mon Sep 17 00:00:00 2001 >> From: "F. Jason Park" <jp@neverwas.me> >> 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. > > This belongs in NEWS. Right, I definitely plan on mentioning this and most other ERC changes in some fashion. >> @@ -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."))) > > Warning about the default seems unfortunate. Then every user will be > warned until they customize this. > > I think we should either disable the warning, or flip the default to > nil. I've removed the option entirely because I've come to realize it's unlikely a new user would ever set a port parameter to an IANA name in the first place (via :port, `erc-port', or whatever). And existing users accustomed to doing so obviously already know what to expect (namely, quasi-obsolete port numbers, like 194). >> From 3658e89614cbe3b5b27f09271b7bc738a1c7ec38 Mon Sep 17 00:00:00 2001 >> From: "F. Jason Park" <jp@neverwas.me> >> Date: Mon, 11 Jul 2022 05:14:57 -0700 >> Subject: [PATCH 6/6] Improve new connections in erc-handle-irc-url > [...] >> + >> +@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. > > Why would that be more polite? It seems to me that, sure, if you're > developing an IRC client I can see why you'd want to use a test network. > > But it seems like overkill just for user customization. Agreed! That's basically nonsense (and so removed). >> +;; 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 >> + > > This is a breaking change, no? I think it should be in NEWS, even if it > is only to make ERC more standards compliant. ERC has always supported the auth:pass@ stuff, but my comment was confusing, so I've deleted it. Thanks so much for looking at these changes! [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v4-v5.diff --] [-- Type: text/x-patch, Size: 15699 bytes --] From 7def5db8d6272380acb4bd871becfeb0e96ce4de Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Wed, 9 Nov 2022 00:16:50 -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 +++++ etc/NEWS | 20 +++ lisp/erc/erc-backend.el | 6 + lisp/erc/erc-compat.el | 15 ++ lisp/erc/erc-networks.el | 9 +- lisp/erc/erc.el | 200 ++++++++++++++++-------- lisp/net/browse-url.el | 24 +++ lisp/thingatpt.el | 2 +- lisp/url/url-irc.el | 32 +++- test/lisp/erc/erc-networks-tests.el | 17 +++ test/lisp/erc/erc-tests.el | 226 ++++++++++++++++++++++++++++ test/lisp/net/browse-url-tests.el | 9 ++ test/lisp/thingatpt-tests.el | 3 + 13 files changed, 527 insertions(+), 75 deletions(-) Interdiff: diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..500ac5e50b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,6 +438,12 @@ The user options 'url-gateway-rlogin-host', 'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' are also obsolete. +--- +** The user function 'url-irc-function' now takes a 'scheme' argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + --- ** The linum.el library is now obsolete. We recommend using either the built-in 'display-line-numbers-mode', or @@ -2616,6 +2622,17 @@ This user option decides which URL scheme that 'browse-url' and related functions will use by default. For example, you could customize this to "https" to always prefer HTTPS URLs. +--- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening irc:// links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening irc:// +and ircs:// URLS by any caller that passes a URL string as an initial +arg. + --- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of @@ -2842,6 +2859,9 @@ remote host are shown. Alternatively, the user option *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. +--- +*** The url-irc library now understands ircs:// links. + --- *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. It copies the current line into the kill ring. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3c9293e28a..51a97c8de1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1534,15 +1534,6 @@ 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 @@ -1551,8 +1542,8 @@ erc-normalize-port * ircs -> 994 * ircd -> 6667 * ircd-dalnet -> 7000" - ;; These were updated in 2022 to reflect modern standards and - ;; practices. See also: + ;; These were updated somewhat 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 @@ -1564,20 +1555,14 @@ erc-normalize-port (cond ((> port-nr 0) port-nr) - ((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 "irc") + 194) ((string-equal port "ircs") 994) - ((string-equal port "ircd") + ((string-equal port "ircu") 6667) ; 6665-6669 + ((string-equal port "ircd") ; nonstandard (irc-serv is 529) 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "ircd-dalnet") 7000) (t @@ -7186,16 +7171,15 @@ erc-get-parsed-vector-type (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." +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 (&rest plist) - (let* ((scheme (and url-current-object (url-type url-current-object))) - (ircsp (if scheme +(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? ")))) @@ -7210,15 +7194,8 @@ erc--url-default-connect-function (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) +(defun erc-handle-irc-url (host port channel nick password 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 NICK and /join CHANNEL. @@ -7247,6 +7224,7 @@ erc-handle-irc-url (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)) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8d95c0667b..7ac6396d31 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -222,6 +222,14 @@ browse-url-man-function (function :tag "Other function")) :version "26.1") +(defcustom browse-url-irc-function 'browse-url-irc + "Function to open an irc:// link." + :type '(choice + (function-item :tag "Emacs IRC" :value browse-url-irc) + (const :tag "None" nil) + (function :tag "Other function")) + :version "29.1") + (defcustom browse-url-button-regexp (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|" @@ -547,6 +555,11 @@ browse-url--browser-kind-man (function-put 'browse-url--man 'browse-url-browser-kind #'browse-url--browser-kind-man) +(defun browse-url--irc (url &rest args) + "Call `browse-url-irc-function' with URL and ARGS." + (funcall browse-url-irc-function url args)) +(function-put 'browse-url--irc 'browse-url-browser-kind 'internal) + (defun browse-url--browser (url &rest args) "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) @@ -565,7 +578,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) + ("\\`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. diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 0dd25b7f49..f97b6de6fe 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -39,15 +39,12 @@ url-irc-function CHANNEL - What channel on the server to visit right away (can be nil) USER - What username 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." + SCHEME - a URI scheme, such as \"irc\" or \"ircs\"" :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) (function :tag "Other")) + :version "29.1" ; Added SCHEME :group 'url) ;; External. @@ -56,7 +53,7 @@ url-irc-function (defvar zenirc-server-alist) (defvar zenirc-buffer-name) -(defun url-irc-zenirc (host port channel user password) +(defun url-irc-zenirc (host port channel user password _) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) (format "%s:%d" host port))) @@ -70,14 +67,14 @@ url-irc-zenirc (insert "/join " channel) (zenirc-send-line)))) -(defun url-irc-rcirc (host port channel user password) +(defun url-irc-rcirc (host port channel user password _) (let ((chan (when channel (concat "#" channel)))) (rcirc-connect host port user nil nil (when chan (list chan)) password) (when chan (switch-to-buffer (concat chan "@" host))))) -(defun url-irc-erc (host port channel user password) - (erc-handle-irc-url host port channel user password)) +(defun url-irc-erc (host port channel user password scheme) + (erc-handle-irc-url host port channel user password scheme)) ;;;###autoload (defun url-irc (url) @@ -86,14 +83,18 @@ url-irc (pass (url-password url)) (user (url-user url)) (chan (url-filename url)) - (url-current-object url)) + (type (url-type url)) + (compatp (eql 5 (cdr (func-arity url-irc-function))))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (funcall url-irc-function host port chan user pass) + (when compatp + (lwarn 'url :error "Obsolete value for `url-irc-function'")) + (apply url-irc-function + host port chan user pass (unless compatp (list type))) nil)) ;;;; ircs:// diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e097090e5d..f83e8c8717 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1069,7 +1069,8 @@ erc-tls "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. + ;; null params. This is why `erc-open' recomputes almost + ;; everything. (ert-info ("Fallback") (let ((erc-nick "bob") (erc-server "irc.gnu.org") @@ -1126,43 +1127,43 @@ 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) + (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) + (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) + (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) + (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) + (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) - (should (equal '(:server "irc.gnu.org") (pop calls))) + (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) - (should (equal '(:server "irc.gnu.org") (pop calls))) + (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)) diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index cf917802e0..dc81976821 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -58,12 +58,12 @@ browse-url-tests-select-handler-man (ert-deftest browse-url-tests-select-handler-irc () (should (eq (browse-url-select-handler "irc://localhost" 'internal) - 'browse-url-irc)) + 'browse-url--irc)) (should-not (browse-url-select-handler "irc://localhost" 'external)) (should (eq (browse-url-select-handler "irc6://localhost") - 'browse-url-irc)) + 'browse-url--irc)) (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan") - 'browse-url-irc))) + 'browse-url--irc))) (ert-deftest browse-url-tests-select-handler-file () (should (eq (browse-url-select-handler "file://foo.txt") -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Accommodate-ircs-URLs-in-url-irc-and-browse-url.patch --] [-- Type: text/x-patch, Size: 9106 bytes --] From 929465942c10a1434ac6333ba6f3df9a110b0199 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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-function): Change signature of function interface to expect a final "scheme" argument, such as "ircs". (url-irc): Call `url-irc-function' with new positional argument, the scheme extracted via `url-type' from the input URL. (url-irc-erc, url-irc-rcirc, url-irc-zenirc): Accept a URL scheme as a sixth positional arg. (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-irc-function): Add new option. (browse-url--irc): Add new function to call `browse-url-irc-function'. (browse-url-default-handlers): Add "irc://" entry. (browse-url-irc): Add new function to serve as general handler for "irc://" URLS. Accept trailing variadic args to accommodate non-browse-url interfaces as well. * test/lisp/net/browse-url-tests.el (browse-url-tests-select-handler-irc): Add test for "irc://" URL pattern. * etc/NEWS: Mention select browse-url and url-irc changes. Bug#56514. --- etc/NEWS | 20 +++++++++++++++++++ lisp/net/browse-url.el | 24 +++++++++++++++++++++++ lisp/url/url-irc.el | 32 ++++++++++++++++++++++++------- test/lisp/net/browse-url-tests.el | 9 +++++++++ 4 files changed, 78 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..500ac5e50b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,6 +438,12 @@ The user options 'url-gateway-rlogin-host', 'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' are also obsolete. +--- +** The user function 'url-irc-function' now takes a 'scheme' argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + --- ** The linum.el library is now obsolete. We recommend using either the built-in 'display-line-numbers-mode', or @@ -2616,6 +2622,17 @@ This user option decides which URL scheme that 'browse-url' and related functions will use by default. For example, you could customize this to "https" to always prefer HTTPS URLs. +--- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening irc:// links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening irc:// +and ircs:// URLS by any caller that passes a URL string as an initial +arg. + --- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of @@ -2842,6 +2859,9 @@ remote host are shown. Alternatively, the user option *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. +--- +*** The url-irc library now understands ircs:// links. + --- *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. It copies the current line into the kill ring. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a..7ac6396d31 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -222,6 +222,14 @@ browse-url-man-function (function :tag "Other function")) :version "26.1") +(defcustom browse-url-irc-function 'browse-url-irc + "Function to open an irc:// link." + :type '(choice + (function-item :tag "Emacs IRC" :value browse-url-irc) + (const :tag "None" nil) + (function :tag "Other function")) + :version "29.1") + (defcustom browse-url-button-regexp (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|" @@ -547,6 +555,11 @@ browse-url--browser-kind-man (function-put 'browse-url--man 'browse-url-browser-kind #'browse-url--browser-kind-man) +(defun browse-url--irc (url &rest args) + "Call `browse-url-irc-function' with URL and ARGS." + (funcall browse-url-irc-function url args)) +(function-put 'browse-url--irc 'browse-url-browser-kind 'internal) + (defun browse-url--browser (url &rest args) "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) @@ -565,6 +578,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 +1524,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..f97b6de6fe 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,11 +38,13 @@ 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. + SCHEME - a URI scheme, such as \"irc\" or \"ircs\"" :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) (function :tag "Other")) + :version "29.1" ; Added SCHEME :group 'url) ;; External. @@ -51,7 +53,7 @@ url-irc-function (defvar zenirc-server-alist) (defvar zenirc-buffer-name) -(defun url-irc-zenirc (host port channel user password) +(defun url-irc-zenirc (host port channel user password _) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) (format "%s:%d" host port))) @@ -65,14 +67,14 @@ url-irc-zenirc (insert "/join " channel) (zenirc-send-line)))) -(defun url-irc-rcirc (host port channel user password) +(defun url-irc-rcirc (host port channel user password _) (let ((chan (when channel (concat "#" channel)))) (rcirc-connect host port user nil nil (when chan (list chan)) password) (when chan (switch-to-buffer (concat chan "@" host))))) -(defun url-irc-erc (host port channel user password) - (erc-handle-irc-url host port channel user password)) +(defun url-irc-erc (host port channel user password scheme) + (erc-handle-irc-url host port channel user password scheme)) ;;;###autoload (defun url-irc (url) @@ -80,16 +82,32 @@ url-irc (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (type (url-type url)) + (compatp (eql 5 (cdr (func-arity url-irc-function))))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (funcall url-irc-function host port chan user pass) + (when compatp + (lwarn 'url :error "Obsolete value for `url-irc-function'")) + (apply url-irc-function + host port chan user pass (unless compatp (list type))) 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..dc81976821 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://tester@irc.gnu.org/#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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Refactor-erc-select-read-args.patch --] [-- Type: text/x-patch, Size: 11097 bytes --] From 4043399073ac746074157d0e15fa46f99df41833 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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. Bug#56514. --- 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch --] [-- Type: text/x-patch, Size: 4804 bytes --] From 6aaeb39c3655829598d8d6cf843e27e4720dd136 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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-normalize-port): Add standard IANA port-name mappings for 6667 and 6697. (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. Bug#56514. --- lisp/erc/erc.el | 17 +++++++++++---- test/lisp/erc/erc-tests.el | 42 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7f25afa8c5..28370d7724 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1542,6 +1542,11 @@ erc-normalize-port * ircs -> 994 * ircd -> 6667 * ircd-dalnet -> 7000" + ;; These were updated somewhat 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))) @@ -1554,8 +1559,10 @@ erc-normalize-port 194) ((string-equal port "ircs") 994) - ((string-equal port "ircd") + ((string-equal port "ircu") 6667) ; 6665-6669 + ((string-equal port "ircd") ; nonstandard (irc-serv is 529) 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "ircd-dalnet") 7000) (t @@ -1924,7 +1931,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 +2192,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 +6399,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..db54cb4889 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1042,4 +1042,46 @@ 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 almost + ;; 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0005-Add-optional-server-param-to-erc-networks-determine.patch --] [-- Type: text/x-patch, Size: 2935 bytes --] From b2edeb5efffb7b7951245483af75567967ccc403 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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. Bug#56514. --- 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0006-Improve-new-connections-in-erc-handle-irc-url.patch --] [-- Type: text/x-patch, Size: 14005 bytes --] From 7def5db8d6272380acb4bd871becfeb0e96ce4de Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 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. (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. Bug#56514. --- doc/misc/erc.texi | 39 +++++++++++++++ lisp/erc/erc-compat.el | 15 ++++++ lisp/erc/erc.el | 100 ++++++++++++++++++++++++++++++------- test/lisp/erc/erc-tests.el | 95 +++++++++++++++++++++++++++++++++++ 4 files changed, 232 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 28370d7724..51a97c8de1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7169,25 +7169,91 @@ 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 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)))))) + +(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 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 -- 2.38.1 ^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#56514: ircs:// integration for rcirc (bug#56514) [not found] <87pmiabvd5.fsf@neverwas.me> 2022-07-12 12:49 ` bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links Lars Ingebrigtsen [not found] ` <87edyqzeag.fsf@gnus.org> @ 2022-11-08 14:41 ` J.P. 2022-11-11 14:05 ` bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links J.P. ` (4 subsequent siblings) 7 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2022-11-08 14:41 UTC (permalink / raw) To: Philip Kaludercic; +Cc: 56514, emacs-erc Hi Philip, Just a heads up: I'm in the process of possibly tweaking url-irc (and browse-url) to better support irc:// links in internal Emacs apps. If you're interested, this mostly concerns the second patch here: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=56514#22 Basically, I wanted a way to tell `url-irc-erc' whether to connect via TLS without relying on port numbers and without changing the signature of `url-irc-function'. Rather than mess with `func-arity' or the like, I've opted to just hijack an existing variable from the url(-vars) library, `url-current-object', which seems ready made for this purpose. The idea is to simply bind it to the parsed URL object during calls to `url-irc-function'. Please let me know if you see any downsides to doing this or if a smarter approach comes to mind. BTW, as the patch shows, I've left the rcirc side alone. But if you want to handle ircs:// links without bothering with all the `url-current-object' business above, simply arranging to switch to 'tls whenever the port is 6697 should have you pretty well covered, I think. Let me know if that doesn't make sense. Thanks, J.P. ^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] <87pmiabvd5.fsf@neverwas.me> ` (2 preceding siblings ...) 2022-11-08 14:41 ` bug#56514: ircs:// integration for rcirc (bug#56514) J.P. @ 2022-11-11 14:05 ` J.P. [not found] ` <87iljl4meb.fsf@neverwas.me> ` (3 subsequent siblings) 7 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2022-11-11 14:05 UTC (permalink / raw) To: 56514; +Cc: emacs-erc [-- Attachment #1: Type: text/plain, Size: 147 bytes --] v6. Fixed compat function. Removed convenience function for browsing URLs. Deleted nonsensical paragraph from doc (overdue). Added test scenario. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v5-v6.diff --] [-- Type: text/x-patch, Size: 7650 bytes --] From 2d35563e0ac22686bb69100536692cb026fc67f2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 11 Nov 2022 00:12:34 -0800 Subject: [PATCH 0/5] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (5): 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 | 28 +++ etc/NEWS | 20 ++ lisp/erc/erc-backend.el | 6 + lisp/erc/erc-compat.el | 19 ++ lisp/erc/erc-networks.el | 9 +- lisp/erc/erc.el | 192 ++++++++++----- lisp/net/browse-url.el | 24 ++ lisp/url/url-irc.el | 32 ++- test/lisp/erc/erc-networks-tests.el | 17 ++ test/lisp/erc/erc-scenarios-misc.el | 28 +++ test/lisp/erc/erc-tests.el | 226 ++++++++++++++++++ .../lisp/erc/resources/join/legacy/foonet.eld | 2 +- test/lisp/net/browse-url-tests.el | 9 + 13 files changed, 537 insertions(+), 75 deletions(-) Interdiff: diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index d01eab1bbb..9742fc3c22 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -998,10 +998,10 @@ 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}. +@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 @@ -1012,22 +1012,11 @@ Integrations need a function as well: @lisp - '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" - 0 t erc-browse-url-handler 0) + '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 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. - +Users on Emacs 28 and below may need to use @code{browse-url} instead. @node Options @section Options diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 683d19dfc7..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,20 +169,23 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) -(declare-function browse-url-irc "browse-url" (url &rest _)) +(defvar url-irc-function) -(defun erc-compat--browse-url-irc (string &rest _) - "Parse STRING and call `url-irc'." +(defun erc-compat--29-browse-url-irc (string &rest _) + (cl-assert (< emacs-major-version 29)) (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))) + (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) - (add-to-list 'browse-url-default-handlers - '("\\`irc6?s?://" . erc-compat--browse-url-irc))) + (unless (assoc "\\`irc6?s?://" browse-url-default-handlers) + (push '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) + browse-url-default-handlers))) (provide 'erc-compat) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 51a97c8de1..cfd1c34ef0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7195,7 +7195,7 @@ erc--url-default-connect-function (apply (if ircsp #'erc-tls #'erc) args))) ;;;###autoload -(defun erc-handle-irc-url (host port channel nick password scheme) +(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 NICK and /join CHANNEL. @@ -7247,14 +7247,6 @@ erc-handle-irc-url (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) ;;; erc.el ends here 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/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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Accommodate-ircs-URLs-in-url-irc-and-browse-url.patch --] [-- Type: text/x-patch, Size: 9108 bytes --] From ee1c51c8f8309aa7f3761d71789be41c68a31591 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 1/5] Accommodate ircs:// URLs in url-irc and browse-url * lisp/url/url-irc.el (url-irc-function): Change signature of function interface to expect a final "scheme" argument, such as "ircs". (url-irc): Call `url-irc-function' with new positional argument, the scheme extracted via `url-type' from the input URL. (url-irc-erc, url-irc-rcirc, url-irc-zenirc): Accept a URL scheme as a sixth positional arg. (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-irc-function): Add new option. (browse-url--irc): Add new function to call `browse-url-irc-function'. (browse-url-default-handlers): Add "irc://" entry. (browse-url-irc): Add new function to serve as general handler for "irc://" URLS. Accept trailing variadic args to accommodate non-browse-url interfaces as well. * test/lisp/net/browse-url-tests.el (browse-url-tests-select-handler-irc): Add test for "irc://" URL pattern. * etc/NEWS: Mention select browse-url and url-irc changes. (Bug#56514.) --- etc/NEWS | 20 +++++++++++++++++++ lisp/net/browse-url.el | 24 +++++++++++++++++++++++ lisp/url/url-irc.el | 32 ++++++++++++++++++++++++------- test/lisp/net/browse-url-tests.el | 9 +++++++++ 4 files changed, 78 insertions(+), 7 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..500ac5e50b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,6 +438,12 @@ The user options 'url-gateway-rlogin-host', 'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name' are also obsolete. +--- +** The user function 'url-irc-function' now takes a 'scheme' argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + --- ** The linum.el library is now obsolete. We recommend using either the built-in 'display-line-numbers-mode', or @@ -2616,6 +2622,17 @@ This user option decides which URL scheme that 'browse-url' and related functions will use by default. For example, you could customize this to "https" to always prefer HTTPS URLs. +--- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening irc:// links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening irc:// +and ircs:// URLS by any caller that passes a URL string as an initial +arg. + --- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of @@ -2842,6 +2859,9 @@ remote host are shown. Alternatively, the user option *** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'. The old name is still available as an obsolete function alias. +--- +*** The url-irc library now understands ircs:// links. + --- *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. It copies the current line into the kill ring. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a..7ac6396d31 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -222,6 +222,14 @@ browse-url-man-function (function :tag "Other function")) :version "26.1") +(defcustom browse-url-irc-function 'browse-url-irc + "Function to open an irc:// link." + :type '(choice + (function-item :tag "Emacs IRC" :value browse-url-irc) + (const :tag "None" nil) + (function :tag "Other function")) + :version "29.1") + (defcustom browse-url-button-regexp (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|" @@ -547,6 +555,11 @@ browse-url--browser-kind-man (function-put 'browse-url--man 'browse-url-browser-kind #'browse-url--browser-kind-man) +(defun browse-url--irc (url &rest args) + "Call `browse-url-irc-function' with URL and ARGS." + (funcall browse-url-irc-function url args)) +(function-put 'browse-url--irc 'browse-url-browser-kind 'internal) + (defun browse-url--browser (url &rest args) "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) @@ -565,6 +578,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 +1524,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..f97b6de6fe 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,11 +38,13 @@ 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. + SCHEME - a URI scheme, such as \"irc\" or \"ircs\"" :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) (function :tag "Other")) + :version "29.1" ; Added SCHEME :group 'url) ;; External. @@ -51,7 +53,7 @@ url-irc-function (defvar zenirc-server-alist) (defvar zenirc-buffer-name) -(defun url-irc-zenirc (host port channel user password) +(defun url-irc-zenirc (host port channel user password _) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) (format "%s:%d" host port))) @@ -65,14 +67,14 @@ url-irc-zenirc (insert "/join " channel) (zenirc-send-line)))) -(defun url-irc-rcirc (host port channel user password) +(defun url-irc-rcirc (host port channel user password _) (let ((chan (when channel (concat "#" channel)))) (rcirc-connect host port user nil nil (when chan (list chan)) password) (when chan (switch-to-buffer (concat chan "@" host))))) -(defun url-irc-erc (host port channel user password) - (erc-handle-irc-url host port channel user password)) +(defun url-irc-erc (host port channel user password scheme) + (erc-handle-irc-url host port channel user password scheme)) ;;;###autoload (defun url-irc (url) @@ -80,16 +82,32 @@ url-irc (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (type (url-type url)) + (compatp (eql 5 (cdr (func-arity url-irc-function))))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (funcall url-irc-function host port chan user pass) + (when compatp + (lwarn 'url :error "Obsolete value for `url-irc-function'")) + (apply url-irc-function + host port chan user pass (unless compatp (list type))) 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..dc81976821 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://tester@irc.gnu.org/#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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Refactor-erc-select-read-args.patch --] [-- Type: text/x-patch, Size: 11099 bytes --] From 3b6eeb91e25da87c33a0da6a4b768cbbc60d96d8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 2/5] 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. (Bug#56514.) --- 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch --] [-- Type: text/x-patch, Size: 4806 bytes --] From 6f3717e60b223090d84a198ee80c1d90ec7a0263 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 3/5] Default to TLS port when calling erc-tls from lisp * lisp/erc/erc.el (erc-normalize-port): Add standard IANA port-name mappings for 6667 and 6697. (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. (Bug#56514.) --- lisp/erc/erc.el | 17 +++++++++++---- test/lisp/erc/erc-tests.el | 42 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7f25afa8c5..28370d7724 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1542,6 +1542,11 @@ erc-normalize-port * ircs -> 994 * ircd -> 6667 * ircd-dalnet -> 7000" + ;; These were updated somewhat 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))) @@ -1554,8 +1559,10 @@ erc-normalize-port 194) ((string-equal port "ircs") 994) - ((string-equal port "ircd") + ((string-equal port "ircu") 6667) ; 6665-6669 + ((string-equal port "ircd") ; nonstandard (irc-serv is 529) 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "ircd-dalnet") 7000) (t @@ -1924,7 +1931,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 +2192,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 +6399,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..db54cb4889 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1042,4 +1042,46 @@ 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 almost + ;; 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0004-Add-optional-server-param-to-erc-networks-determine.patch --] [-- Type: text/x-patch, Size: 2937 bytes --] From 960c1ec9f753a9c61f6353c12a8e616bd4121ca5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 11 Jul 2022 05:14:57 -0700 Subject: [PATCH 4/5] 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. (Bug#56514.) --- 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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Improve-new-connections-in-erc-handle-irc-url.patch --] [-- Type: text/x-patch, Size: 15917 bytes --] From 2d35563e0ac22686bb69100536692cb026fc67f2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> 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 ^ permalink raw reply related [flat|nested] 14+ messages in thread
[parent not found: <87iljl4meb.fsf@neverwas.me>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <87iljl4meb.fsf@neverwas.me> @ 2022-11-16 14:22 ` J.P. 0 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2022-11-16 14:22 UTC (permalink / raw) To: 56514; +Cc: emacs-erc Quick note: > 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: > [...] > + > +(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))) This won't work on 27, so we'll probably have to do something like (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) ^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] <87pmiabvd5.fsf@neverwas.me> ` (4 preceding siblings ...) [not found] ` <87iljl4meb.fsf@neverwas.me> @ 2022-12-30 14:20 ` J.P. 2023-11-06 2:34 ` J.P. [not found] ` <875y2flics.fsf@neverwas.me> 7 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2022-12-30 14:20 UTC (permalink / raw) To: 56514; +Cc: emacs-erc FYI, these changes introduced a bug related to the default non-TLS port for interactive entry-point invocations. It's hopefully being addressed by https://debbugs.gnu.org/cgi/bugreport.cgi?bug=60428 Thanks. ^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] <87pmiabvd5.fsf@neverwas.me> ` (5 preceding siblings ...) 2022-12-30 14:20 ` J.P. @ 2023-11-06 2:34 ` J.P. [not found] ` <875y2flics.fsf@neverwas.me> 7 siblings, 0 replies; 14+ messages in thread From: J.P. @ 2023-11-06 2:34 UTC (permalink / raw) To: 56514; +Cc: emacs-erc [-- Attachment #1: Type: text/plain, Size: 367 bytes --] There's been some mention on the tracker recently regarding `func-arity' and misguided expectations. If it's important to stamp out misuses in the Emacs tree, then I suppose the one in `url-irc' qualifies. The attached patch should fix it, I think. Technically, this bug was introduced in Emacs 29.1, but it's probably not worth disturbing the release branch over. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Don-t-use-func-arity-to-trigger-API-warning-in-url-i.patch --] [-- Type: text/x-patch, Size: 1763 bytes --] From 014a25e9fe8fb3c104d69d8e8cb787bff5e6a8b3 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 5 Nov 2023 16:03:15 -0800 Subject: [PATCH] Don't use func-arity to trigger API warning in url-irc * lisp/url/url-irc.el (url-irc): Use more robust `condition-case' pattern instead, which will still fail when met with various edge cases. The old way was only useful for non-variadic lambda lists consisting entirely of named positional parameters. (Bug#56514) --- lisp/url/url-irc.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 1463335d40f..e11b4a6a58e 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -83,18 +83,20 @@ url-irc (pass (url-password url)) (user (url-user url)) (chan (url-filename url)) - (type (url-type url)) - (compatp (eql 5 (cdr (func-arity url-irc-function))))) + (type (url-type url))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (when compatp - (lwarn 'url :error "Obsolete value for `url-irc-function'")) - (apply url-irc-function - host port chan user pass (unless compatp (list type))) + (condition-case nil + (funcall url-irc-function host port chan user pass type) + (wrong-number-of-arguments + (display-warning 'url + (concat "Incompatible value for `url-irc-function'." + " Likely not expecting a 6th (SCHEME) arg.")) + (funcall url-irc-function host port chan user pass))) nil)) ;;;; ircs:// -- 2.41.0 ^ permalink raw reply related [flat|nested] 14+ messages in thread
[parent not found: <875y2flics.fsf@neverwas.me>]
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links [not found] ` <875y2flics.fsf@neverwas.me> @ 2023-11-11 10:15 ` Eli Zaretskii 0 siblings, 0 replies; 14+ messages in thread From: Eli Zaretskii @ 2023-11-11 10:15 UTC (permalink / raw) To: J.P.; +Cc: 56514, emacs-erc > Cc: emacs-erc@gnu.org > From: "J.P." <jp@neverwas.me> > Date: Sun, 05 Nov 2023 18:34:59 -0800 > > There's been some mention on the tracker recently regarding `func-arity' > and misguided expectations. If it's important to stamp out misuses in > the Emacs tree, then I suppose the one in `url-irc' qualifies. The > attached patch should fix it, I think. > > Technically, this bug was introduced in Emacs 29.1, but it's probably > not worth disturbing the release branch over. Yes, please install on master, and thanks. ^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links
@ 2022-07-12 8:14 J.P.
0 siblings, 0 replies; 14+ messages in thread
From: J.P. @ 2022-07-12 8:14 UTC (permalink / raw)
To: 56514; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5353 bytes --]
Allowing users to follow links for various application protocols is
typically done by presenting an interface for external client handlers.
One such interface is `url-irc-function', needed by url.el's `url-irc'
loader. One such handler is `erc-handle-irc-url', tasked by ERC with
teleporting users to the right channel on the right server.
When conditions are ideal, things mostly work as designed. But when the
going gets tough and multiple asynchronous flows are in play, the user
experience suffers. In some cases, things don't work at all (and haven't
since at least Emacs 27). For example, clicking on a link with a channel
only works when an existing connection can be found. Otherwise, a hybrid
server/channel buffer is created, which violates many a foundational
invariant. (That it doesn't blow up right away is troublesome in its own
right and needs addressing stat, IMO.)
The attached changes are mainly meant to shore up the existing
implementation where it's lacking (and otherwise stay out of the way).
Once everything's firing, we should be able to:
M-x browse-url-at-point RET on any irc:// link anywhere:
(add-to-list 'browse-url-default-handlers
'("\\`ircs?://" . erc--handle-ircs-url))
Follow irc:// links in eww, gnus, and beyond:
(setq eww-use-browse-url
(concat eww-use-browse-url "\\|\\`ircs?:"))
(push '("\\bircs?://[a-z.@_+0-9%=?&/#-]+"
0 t erc--handle-ircs-url 0)
gnus-button-alist)
Click on org links featuring the nonstandard "/chan/user" syntax:
(erc--org-init)
Most importantly, we ought to be able to do these things without sharing
anything inadvertently, sensitive or not. A number of minor, supporting
changes that help provide such assurances are also included, such as
ensuring `erc-tls' defaults to a secure port when called from lisp code.
(Note that nothing's yet autoloaded for the snippets above, so you'll
have to require all the players beforehand if trying them out with
a real endpoint, such as "ircs://testnet.ergo.chat/#test".)
In the end, I'm hoping other folks will step forward who may be more
familiar with the libraries mentioned so that nicer renditions can
emerge.
Thanks,
J.P.
In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.34, cairo version 1.17.6)
of 2022-07-06 built on localhost
Repository revision: e6504c3eda12c72268d2db6598764f043b74c24d
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 36 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
'CFLAGS=-O0 -g3'
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068
epg-config gnus-util text-property-search time-date subr-x mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils rmc iso-transl tooltip eldoc paren electric
uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
faces cus-face macroexp files window text-properties overlay sha1 md5
base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process
emacs)
Memory information:
((conses 16 35545 5688)
(symbols 48 5073 0)
(strings 32 13303 1546)
(string-bytes 1 429956)
(vectors 16 9197)
(vector-slots 8 145428 11407)
(floats 8 21 25)
(intervals 56 214 0)
(buffers 992 10))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Default-to-TLS-port-when-calling-erc-tls-in-lisp-cod.patch --]
[-- Type: text/x-patch, Size: 4779 bytes --]
From 56688029946a6248fa2e2b5eb550f535d266d58b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 1/8] Default to TLS port when calling erc-tls in lisp code
* lisp/erc/erc.el (erc-normalize-port): Add standard IANA port-name
mappings for 6667 and 6697.
(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): When `erc-port' hasn't been set and the port param
is a string, ask `erc-normalize-port' to look it up before falling
back to `erc-default-port'.
* test/lisp/erc/erc-tests.el (erc-tls): Add simplistic test focusing
on default parameters.
---
lisp/erc/erc.el | 18 ++++++++++++++---
test/lisp/erc/erc-tests.el | 41 ++++++++++++++++++++++++++++++++++++++
2 files changed, 56 insertions(+), 3 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0a16831fba..f05b9fb6ae 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1743,6 +1743,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)))
@@ -1751,6 +1756,8 @@ erc-normalize-port
(cond
((> port-nr 0)
port-nr)
+ ((string-equal port "ircu") 6667)
+ ((string-equal port "ircs-u") 6697)
((string-equal port "irc")
194)
((string-equal port "ircs")
@@ -2171,7 +2178,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'.
@@ -2431,7 +2440,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
@@ -6653,7 +6662,10 @@ 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))
+ (cond ((numberp port) port)
+ (erc-port (erc-normalize-port erc-port))
+ (port (erc-normalize-port port))
+ (t erc-default-port)))
;; time routines
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 4971d0e194..be95a2f8e0 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -893,4 +893,45 @@ erc-process-input-line
(should-not calls))))))
+(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.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Add-optional-server-param-to-erc-networks-determine.patch --]
[-- Type: text/x-patch, Size: 2924 bytes --]
From 21fc469a728ca5ae0fd8d934e9ce308dccc13440 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 2/8] 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 091b8aa92d..95338e5f1e 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1232,14 +1232,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 66a334b709..88b9c3ca04 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.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Improve-how-erc-handle-irc-url-treats-new-connection.patch --]
[-- Type: text/x-patch, Size: 12160 bytes --]
From 5f02415a7b40021433314be0ed4a0e9b59e7e6b0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 3/8] Improve how erc-handle-irc-url treats new connections
* 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--handle-irc-url-connect-function,
erc--handle-ircs-url-connect-function): Add placeholders for possible
future options allowing a user to connect when clicking an IRC link
without being prompted.
(erc--handle-url-connect-function): New function to serve as an
interactive-only fallback when a user hasn't specified a connect
function.
(erc-url-ircs): Add function conforming to browse-url, and possibly
other library interfaces that offer URI integration.
---
lisp/erc/erc.el | 142 ++++++++++++++++++++++++++++++++-----
test/lisp/erc/erc-tests.el | 95 +++++++++++++++++++++++++
2 files changed, 220 insertions(+), 17 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f05b9fb6ae..722fec59bc 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7447,25 +7447,133 @@ 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
+;; 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".
+
;;;###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 connect-fn)
+ "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.
+
+Note: calling this function with NICK and/or PASSWORD is
+deprecated and results in a warning. Moreover, ERC no longer
+attempts to establish new connections without human intervention,
+although opting in may eventually be allowed."
+ (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)
+ (when (or nick password)
+ (display-warning 'erc (concat "Calling `erc-handle-irc-url' with a nick "
+ "or a password argument is deprecated.")))
+ (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
+ `(,@(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))))))
+
+;; XXX ERASE ME
+;;
+;; The final spec was simplified from the 2003 Butcher draft and
+;; doesn't allow an auth@ component or trailing ,flags or &options.
+;; Because of this, we shouldn't just connect and risk exposing
+;; whatever's returned by `user-login-name'.
+;;
+;; For now, as a demo, users must require erc and do something like:
+;;
+;; (add-to-list 'browse-url-default-handlers
+;; '("\\`ircs?://" . 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 "\\|\\`ircs?:"))
+;;
+;; Those that don't use browse-url get the same handler:
+;;
+;; (push '("\\bircs?://[a-z.@_+0-9%=?&/#-]+"
+;; 0 t erc--handle-ircs-url 0)
+;; gnus-button-alist)
+;;
+;; Finally, insert something like "ircs://testnet.ergo.chat/#test"
+;; where appropriate and perform a suitable action.
+;;
+;; https://www.iana.org/assignments/uri-schemes
+;; https://datatracker.ietf.org/doc/html/draft-butcher-irc-url#section-6
+
+;; Contenders for exporting as user options.
+(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)
+(declare-function url-type "url-parse.el" (url) t)
+(declare-function url-p "url-parse.el" (url) t)
+
+;; 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-match "ircs" (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)))
+
(provide 'erc)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index be95a2f8e0..f68a7debed 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -934,4 +934,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 ()
+ (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))))
+
+ (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 connect)
+ (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)
+ (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)
+ (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)
+ (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)
+ (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)
+ (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 connect)
+ (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.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-POC-Make-erc-once-with-server-event-more-nimble.patch --]
[-- Type: text/x-patch, Size: 2039 bytes --]
From 17802e2458a0ecb28ef43f062411fd50c48c7b41 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 4/8] [POC] Make erc-once-with-server-event more nimble
* lisp/erc/erc.el (erc-once-with-server-event, erc-once-more): Allow
ephemeral callbacks to indicate a need to postpone cleanup and go
another round by signaling the new custom error called
`erc-once-again'. Also add new optional `depth' argument to let
caller specify a hook depth.
---
lisp/erc/erc.el | 19 +++++++++++++------
1 file changed, 13 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 722fec59bc..28f3cd2edd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1484,7 +1484,9 @@ erc--default-target
(when erc--target
(erc--target-string erc--target)))
-(defun erc-once-with-server-event (event f)
+(define-error 'erc-once-again "Untracked server event" 'error)
+
+(defun erc-once-with-server-event (event f &optional depth)
"Run function F the next time EVENT occurs in the `current-buffer'.
You should make sure that `current-buffer' is a server buffer.
@@ -1507,11 +1509,16 @@ erc-once-with-server-event
(hook (erc-get-hook event)))
(put fun 'erc-original-buffer (current-buffer))
(fset fun (lambda (proc parsed)
- (with-current-buffer (get fun 'erc-original-buffer)
- (remove-hook hook fun t))
- (fmakunbound fun)
- (funcall f proc parsed)))
- (add-hook hook fun nil t)
+ (let (rv again)
+ (condition-case _err
+ (setq rv (funcall f proc parsed))
+ (erc-once-again (setq again t)))
+ (unless again
+ (with-current-buffer (get fun 'erc-original-buffer)
+ (remove-hook hook fun t))
+ (fmakunbound fun))
+ rv)))
+ (add-hook hook fun depth t)
fun))
(define-inline erc-log (string)
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-POC-Support-one-off-JOIN-handlers-in-ERC.patch --]
[-- Type: text/x-patch, Size: 2466 bytes --]
From 812d522cd93b91fc66d99bc375bcbbaf294b6953 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 5/8] [POC] Support one-off JOIN handlers in ERC
* lisp/erc/erc.el (erc--join-with-callback, erc-cmd-JOIN): Factor out
joining logic for use in things like URL handlers for external
integrations. Accept a callback to run when channel is joined.
---
lisp/erc/erc.el | 27 +++++++++++++++++++++------
1 file changed, 21 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 28f3cd2edd..b9d2edeb70 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3539,6 +3539,26 @@ erc--valid-local-channel-p
(string-search "&" chan-types)
(string-match-p "&" chan-types))))))
+(defun erc--join-with-callback (chnl key on-join)
+ (if-let* ((existing (erc-get-buffer chnl erc-server-process))
+ ((with-current-buffer existing
+ (erc-get-channel-user (erc-current-nick)))))
+ (progn (switch-to-buffer existing)
+ (when on-join (funcall on-join)))
+ (let ((callback
+ (and on-join
+ (lambda (_ parsed)
+ (unless (equal chnl
+ (car (erc-response.command-args parsed)))
+ (signal 'erc-once-again nil))
+ (with-current-buffer (erc-get-buffer chnl erc-server-process)
+ (funcall on-join))
+ nil))))
+ (setq erc--server-last-reconnect-count 0)
+ (when callback
+ (erc-once-with-server-event 'JOIN callback 90))
+ (erc-server-join-channel nil chnl key))))
+
(defun erc-cmd-JOIN (channel &optional key)
"Join the channel given in CHANNEL, optionally with KEY.
If CHANNEL is specified as \"-invite\", join the channel to which you
@@ -3551,12 +3571,7 @@ erc-cmd-JOIN
(setq chnl (erc-ensure-channel-name channel)))
(when chnl
;; Prevent double joining of same channel on same server.
- (if-let* ((existing (erc-get-buffer chnl erc-server-process))
- ((with-current-buffer existing
- (erc-get-channel-user (erc-current-nick)))))
- (switch-to-buffer existing)
- (setq erc--server-last-reconnect-count 0)
- (erc-server-join-channel nil chnl key))))
+ (erc--join-with-callback chnl key nil)))
t)
(defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN)
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-POC-Use-erc-join-with-callback-in-URL-handler.patch --]
[-- Type: text/x-patch, Size: 2338 bytes --]
From 2bc81251215a3e4d32a8ecaf3f8741da101f8abf Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 6/8] [POC] Use erc--join-with-callback in URL handler
* lisp/erc/erc.el (erc-handle-irc-url): Accept new `on-join' one-off
JOIN handler and pass it to `erc--join-with-callback'.
* test/lisp/erc/erc-tests.el (erc-handle-irc-url): Use
`erc--join-with-callback' instead of `erc-cmd-JOIN'.
---
lisp/erc/erc.el | 6 +++---
test/lisp/erc/erc-tests.el | 4 ++--
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index b9d2edeb70..1771aa4942 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7476,7 +7476,7 @@ erc-get-parsed-vector-type
;;;###autoload
(defun erc-handle-irc-url (host port channel nick password
- &optional connect-fn)
+ &optional connect-fn on-join)
"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.
@@ -7527,10 +7527,10 @@ erc-handle-irc-url
(with-current-buffer server-buffer
(letrec ((f (lambda (&rest _)
(remove-hook 'erc-after-connect f t)
- (erc-cmd-JOIN channel key))))
+ (erc--join-with-callback channel key on-join))))
(add-hook 'erc-after-connect f nil t)))
(with-current-buffer server-buffer
- (erc-cmd-JOIN channel key))))))
+ (erc--join-with-callback channel key on-join))))))
;; XXX ERASE ME
;;
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index f68a7debed..947b45e1dc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -968,8 +968,8 @@ erc-handle-irc-url
(push r calls)
(if (functionp rvbuf) (funcall rvbuf) rvbuf))))
- (cl-letf (((symbol-function 'erc-cmd-JOIN)
- (lambda (&rest r) (push r calls))))
+ (cl-letf (((symbol-function 'erc--join-with-callback)
+ (lambda (&rest r) (push (butlast r) calls))))
(with-current-buffer (erc-tests--make-server-buf "foonet")
(setq rvbuf (current-buffer)))
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #8: 0007-POC-Demo-improved-ol-irc-integration.patch --]
[-- Type: text/x-patch, Size: 2868 bytes --]
From 0c5e7678a475a948aa206dc30bd31fbee3ad98f8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 05:14:57 -0700
Subject: [PATCH 7/8] [POC] Demo improved ol-irc integration
* lisp/erc/erc.el (erc--org-init, erc--handle-url-org-visit,
erc--handle-url-org-visit-irc, erc--handle-url-org-visit-ircs): Add
various functions to demo org link integration.
---
lisp/erc/erc.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 51 insertions(+)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 1771aa4942..efa88bfff5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7596,6 +7596,57 @@ erc--handle-ircs-url
;; Amazingly, this does TRT for /&chan, /#chan, /##chan, /#&chan
(url-irc url)))
+;; ERASE ME
+;;
+;; Org's ol-irc.el is pretty elaborate. But a lot of things have to
+;; go perfectly for joining and prompting to work as intended.
+
+(defun erc--handle-url-org-visit (ircsp link)
+ ;; The dispatcher that calls `org-irc-visit' strips the scheme and
+ ;; colon, leaving only "//irc.gnu.org/#chan", which becomes
+ ;; (("irc.gnu.org") "#chan") when parsed by `org-irc-parse-link'.
+ (pcase-let*
+ ((`((,server ,port) ,channel ,nick) link)
+ (oj (and nick
+ (lambda ()
+ (cl-assert nick)
+ ;; Channel may not be populated yet
+ (unless (erc-get-server-user nick)
+ (erc-error "%s not found in %s" nick (erc-default-target)))
+ (goto-char erc-input-marker)
+ (insert (concat nick ": ")))))
+ (fn (or (if ircsp
+ erc--url-ircs-connect-function
+ erc--url-irc-connect-function)
+ (apply-partially #'erc--url-default-connect-function
+ (and ircsp t)))))
+ (erc-handle-irc-url server port channel nil nil fn oj)))
+
+(declare-function org-irc-parse-link "ol-irc" (link))
+(declare-function org-link-get-parameter "ol" (type key))
+(declare-function org-link-set-parameters "ol" (type &rest parameters))
+
+(defun erc--handle-url-org-follow-irc (link _)
+ (erc--handle-url-org-visit nil (org-irc-parse-link link)))
+
+(defun erc--handle-url-org-follow-ircs (link _)
+ (erc--handle-url-org-visit t (org-irc-parse-link link)))
+
+;; Eventually, we should petition for `org-irc-visit-erc' to call our
+;; stuff to do the heavy lifting, assuming a new enough Emacs is
+;; present. The following is only for demo purposes.
+
+(defun erc--org-init ()
+ (require 'ol-irc)
+ (org-link-set-parameters
+ "irc"
+ :follow #'erc--handle-url-org-follow-irc)
+ (org-link-set-parameters
+ "ircs"
+ :follow #'erc--handle-url-org-follow-ircs
+ :store (org-link-get-parameter "irc" :store)
+ :export (org-link-get-parameter "irc" :export)))
+
(provide 'erc)
--
2.36.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0008-POC-etc-emacs-irc.desktop-New-file.patch --]
[-- Type: text/x-patch, Size: 1133 bytes --]
From d9b84e4332ca87973dd21cc78495c50e180c4100 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 11 Jul 2022 22:07:08 -0700
Subject: [PATCH 8/8] [POC] * etc/emacs-irc.desktop: New file
XXX this won't work without autoloading `erc--handle-ircs-url'
---
etc/emacs-irc.desktop | 14 ++++++++++++++
1 file changed, 14 insertions(+)
create mode 100644 etc/emacs-irc.desktop
diff --git a/etc/emacs-irc.desktop b/etc/emacs-irc.desktop
new file mode 100644
index 0000000000..ed13e918d2
--- /dev/null
+++ b/etc/emacs-irc.desktop
@@ -0,0 +1,14 @@
+[Desktop Entry]
+Name=Emacs (IRC)
+GenericName=Chat client
+Keywords=ERC;extensible;chat;IRC;client;
+Categories=Network;Chat;IRCClient;
+Comment=GNU Emacs is an extensible, customizable text editor - ERC is a powerful, modular, and extensible IRC client for Emacs
+# FIXME update command line and name once autoloaded
+# Also check if shell-quoting %u is needed, since it likely includes a #
+Exec=emacs -l erc -f erc--handle-ircs-url %u
+Icon=emacs
+MimeType=x-scheme-handler/irc;x-scheme-handler/ircs;
+NoDisplay=true
+Terminal=false
+Type=Application
--
2.36.1
^ permalink raw reply related [flat|nested] 14+ messages in threadend of thread, other threads:[~2023-11-11 10:15 UTC | newest]
Thread overview: 14+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <87pmiabvd5.fsf@neverwas.me>
2022-07-12 12:49 ` bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links Lars Ingebrigtsen
[not found] ` <87edyqzeag.fsf@gnus.org>
2022-07-13 14:44 ` J.P.
[not found] ` <874jzl2hsv.fsf@neverwas.me>
2022-07-13 15:55 ` Stefan Kangas
[not found] ` <CADwFkmkgXKH3y2i1si76V_NOuSyJENVrCLdEJ1AfDHEv9qh8jw@mail.gmail.com>
2022-07-14 7:00 ` J.P.
[not found] ` <874jzkuqk3.fsf@neverwas.me>
2022-11-08 14:09 ` J.P.
2022-11-08 15:16 ` Stefan Kangas
[not found] ` <CADwFkm=d+8wb6o_EwvKZWR7yc4tbwscgZ-YPzBnSqty42W+_Pg@mail.gmail.com>
2022-11-09 13:41 ` J.P.
2022-11-08 14:41 ` bug#56514: ircs:// integration for rcirc (bug#56514) J.P.
2022-11-11 14:05 ` bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links J.P.
[not found] ` <87iljl4meb.fsf@neverwas.me>
2022-11-16 14:22 ` J.P.
2022-12-30 14:20 ` J.P.
2023-11-06 2:34 ` J.P.
[not found] ` <875y2flics.fsf@neverwas.me>
2023-11-11 10:15 ` Eli Zaretskii
2022-07-12 8:14 J.P.
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).