From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#56514: 29.0.50; Improve ERC's URI scheme integration for irc:// links Date: Thu, 14 Jul 2022 00:00:28 -0700 Message-ID: <874jzkuqk3.fsf__40759.8780396924$1657782128$gmane$org@neverwas.me> References: <87pmiabvd5.fsf@neverwas.me> <87edyqzeag.fsf@gnus.org> <874jzl2hsv.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="18564"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: Lars Ingebrigtsen , emacs-erc@gnu.org, 56514@debbugs.gnu.org To: Stefan Kangas Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Jul 14 09:02:00 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oBsrH-0004ch-TS for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 14 Jul 2022 09:02:00 +0200 Original-Received: from localhost ([::1]:56480 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oBsrF-0000w8-I2 for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 14 Jul 2022 03:01:57 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:36068) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oBsqM-0000tE-Qa for bug-gnu-emacs@gnu.org; Thu, 14 Jul 2022 03:01:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:54674) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oBsqM-0005EG-HS for bug-gnu-emacs@gnu.org; Thu, 14 Jul 2022 03:01:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oBsqM-0006jb-BL for bug-gnu-emacs@gnu.org; Thu, 14 Jul 2022 03:01:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 14 Jul 2022 07:01:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 56514 X-GNU-PR-Package: emacs Original-Received: via spool by 56514-submit@debbugs.gnu.org id=B56514.165778205925870 (code B ref 56514); Thu, 14 Jul 2022 07:01:02 +0000 Original-Received: (at 56514) by debbugs.gnu.org; 14 Jul 2022 07:00:59 +0000 Original-Received: from localhost ([127.0.0.1]:48571 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oBsqC-0006j4-K7 for submit@debbugs.gnu.org; Thu, 14 Jul 2022 03:00:59 -0400 Original-Received: from mail-108-mta12.mxroute.com ([136.175.108.12]:41227) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oBsq8-0006io-6w for 56514@debbugs.gnu.org; Thu, 14 Jul 2022 03:00:51 -0400 Original-Received: from filter006.mxroute.com ([140.82.40.27] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta12.mxroute.com (ZoneMTA) with ESMTPSA id 181fb82700a0000261.001 for <56514@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Thu, 14 Jul 2022 07:00:38 +0000 X-Zone-Loop: 14a707b373e60d6867b6b1677c5fabb8b21b610f9d2d X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=7eBXGC/D6CRo9GZj0x/2tcK1om+hiG3H9O02OnM/01M=; b=Ypv2DJjSddmGmSeMMmi/au7RKm h3CmGgy0uMLpcyWMk+vS7gRBo8kyb4vL9/Ke9u0t0+tYGOol4XaUFiB16e8uFUmvJrb8coaGwFYs0 O9cRNmL/Zo5Gc4EGVq9giG2S3RjI/ED6SlzjNrlBfDF8nnB9U1P3mFMtxFnChJwq77pRTEYejzSMP uwMMjgCjW98GyM/29OQT98GqX/b8MkifV15tFH96h7q3oKTAsr1LmBZlzubniRNZNoFUTI/kxO179 BS/pLgIvJJx/UJsMCRuUhHyaqPQO17+rMjE95u/LhTwwo6qsZbZi/SPm8ya1loPgYpPjm1g7Z6lCN PFZrYbnw==; In-Reply-To: (Stefan Kangas's message of "Wed, 13 Jul 2022 08:55:20 -0700") X-AuthUser: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:236963 Archived-At: --=-=-= Content-Type: text/plain Stefan Kangas writes: > "J.P." 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From d627cde4978704db9b73a3cf55e4353fc2280388 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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]") ;; markup ("Url: ..." 8 url "foo://1.example.com") ("Url: ..." 30 url "foo://2.example.com") -- 2.36.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Teach-thing-at-point-to-recognize-bracketed-IPv6-URL.patch >From 5037acbd6208a4f023029d23523de18e2ea2defe Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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]") ;; markup ("Url: ..." 8 url "foo://1.example.com") ("Url: ..." 30 url "foo://2.example.com") -- 2.36.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Refactor-erc-select-read-args.patch >From 99864cadfb278704353696acb915979267daa153 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Default-to-TLS-port-when-calling-erc-tls-from-lisp.patch >From cee9be56cad2c5c4b290943892040d0c5d5960c2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Add-optional-server-param-to-erc-networks-determine.patch >From edc67ef9db79673283a78d2bf87b2f6a07964d86 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Improve-new-connections-in-erc-handle-irc-url.patch >From 7d04f024d9f9072682b43258a15e985fe5c0c78b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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-", 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-POC-Make-erc-once-with-server-event-more-nimble.patch >From 522b265843620c2e9d593e7bf3e0b458dbce836b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-POC-Support-one-off-JOIN-handlers-in-ERC.patch >From c82733f30fab7692ca4da2f5cb458c0e5e4470c2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-POC-Use-erc-join-with-callback-in-URL-handler.patch >From f7b789bf7655c914b585bd46e90ed15d4666bccf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0009-POC-Demo-improved-ol-irc-integration.patch >From 202781bacf601d100b9bf0bbfd2da03daf8bbabf Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0010-POC-etc-emacs-irc.desktop-New-file.patch >From d627cde4978704db9b73a3cf55e4353fc2280388 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-=--