all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* 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 thread

end 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 external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.