>From 45afa0d04d2306b78cedfdf6eb2e04b13bdda2ba 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 | 145 ++++++++++++++++++++++++++++++++----- test/lisp/erc/erc-tests.el | 95 ++++++++++++++++++++++++ 2 files changed, 223 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f09720fc79..f06bbc6ab0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7450,25 +7450,136 @@ erc-get-parsed-vector-type ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. -;; FIXME change user to nick, and use API to find server buffer +;; FIXME update comment above once the URL business is fully settled. +;; Also: the function `url-retrieve-internal' finds a "loader" by +;; looking for a library providing a feature named "url-", but +;; no such file currently exists for "ircs". + ;;;###autoload -(defun erc-handle-irc-url (host port channel user password) - "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD. +(defun erc-handle-irc-url (host port channel nick password + &optional connect-fn) + "Use ERC to IRC on HOST:PORT in CHANNEL. If ERC is already connected to HOST:PORT, simply /join CHANNEL. -Otherwise, connect to HOST:PORT as USER and /join CHANNEL." - (let ((server-buffer - (car (erc-buffer-filter - (lambda () - (and (string-equal erc-session-server host) - (= erc-session-port port) - (erc-open-server-buffer-p))))))) - (with-current-buffer (or server-buffer (current-buffer)) - (if (and server-buffer channel) - (erc-cmd-JOIN channel) - (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name) - (not server-buffer) password nil channel - (when server-buffer - (get-buffer-process server-buffer))))))) +Otherwise, connect to HOST:PORT as NICK and /join CHANNEL. + +Note that ERC no longer attempts to establish new connections +without human intervention, although opting in may eventually be +allowed." + (when (eql port 0) (setq port nil)) + (let* ((net (erc-networks--determine host)) + (server-buffer + ;; Viable matches may slip through the cracks for unknown + ;; networks. Additional passes could likely improve things. + (car (erc-buffer-filter + (lambda () + (and (not erc--target) + (erc-server-process-alive) + ;; Always trust a matched network. + (or (and net (eq net (erc-network))) + (and (string-equal erc-session-server host) + ;; Ports only matter when dialed hosts + ;; match and we have sufficient info. + (or (not port) + (= (erc-normalize-port erc-session-port) + port))))))))) + key deferred) + (unless server-buffer + (unless connect-fn + (user-error "Existing session for %s not found." host)) + (setq deferred t + server-buffer (apply connect-fn :server host + `(,@(and port (list :port port)) + ,@(and nick (list :nick nick)) + ,@(and password `(:password ,password)))))) + (when channel + ;; These aren't percent-decoded by default + (when (string-prefix-p "%" channel) + (setq channel (url-unhex-string channel))) + (cl-multiple-value-setq (channel key) (split-string channel "[?]")) + (if deferred + ;; Alternatively, we could make this a defmethod, so when + ;; autojoin is loaded, it can do its own thing. Also, as + ;; with `erc-once-with-server-event', it's fine to set local + ;; hooks here because they're killed when reconnecting. + (with-current-buffer server-buffer + (letrec ((f (lambda (&rest _) + (remove-hook 'erc-after-connect f t) + (erc-cmd-JOIN channel key)))) + (add-hook 'erc-after-connect f nil t))) + (with-current-buffer server-buffer + (erc-cmd-JOIN channel key)))))) + +;; XXX ERASE ME (possibly use as basis for new section in info doc) +;; +;; For now, as a demo, users must require erc and do something like: +;; +;; (add-to-list 'browse-url-default-handlers +;; '("\\`irc6?s?://" . erc--handle-ircs-url)) +;; +;; Libraries that optionally depend on browse-url, like eww, etc. need +;; an extra hand as well: +;; +;; (setq eww-use-browse-url +;; (concat eww-use-browse-url "\\|\\`irc6?s?:")) +;; +;; Those that don't use browse-url get the same handler: +;; +;; (add-to-list 'gnus-button-alist +;; '("\\birc6?s?://[][a-z0-9.,@_:+%?&/#-]+" +;; 0 t erc--handle-ircs-url 0)) +;; +;; Finally, insert something like "ircs://testnet.ergo.chat/#test" +;; where appropriate and perform a suitable action. + +;; The two variables below are contenders for exporting as user +;; options. The rationale for separate functions here instead of, +;; say, a single option granting ERC permission to connect +;; automatically is that, since ERC doesn't lacks any concept of +;; configured server profiles, it has no idea what values to give for +;; connection parameters, like nick, user, etc. +;; +;; Also, the current spec was simplified from the 2003 Butcher draft +;; and doesn't explicitly allow for an auth[:password]@ component (or +;; trailing ,flags or &options, for that matter). Regardless, even +;; when provided, we shouldn't just connect and risk exposing +;; whatever's returned by `user-login-name', right? +;; +;; https://www.iana.org/assignments/uri-schemes +;; https://datatracker.ietf.org/doc/html/draft-butcher-irc-url#section-6 + +(defvar erc--url-irc-connect-function nil) +(defvar erc--url-ircs-connect-function nil) + +(defun erc--url-default-connect-function (ircs &rest plist) + (let ((erc-server (plist-get plist :server)) + (erc-port (or (plist-get plist :port) + (and ircs (erc-normalize-port 'ircs-u)) + erc-port)) + (erc-nick (or (plist-get plist :nick) erc-nick))) + (call-interactively (if ircs #'erc-tls #'erc)))) + +(defvar url-irc-function) +(declare-function url-type "url-parse.el" (url) t) +(declare-function url-p "url-parse.el" (url) t) + +;; FIXME rename this and autoload it +(defun erc--handle-ircs-url (&optional url &rest _) + (unless url + (setq url (pop command-line-args-left)) + (cl-assert url)) + (require 'url-parse) + (unless (url-p url) + (setq url (url-generic-parse-url url))) + (let* ((ircsp (string-suffix-p "s" (url-type url))) + (fn (or (if ircsp + erc--url-ircs-connect-function + erc--url-irc-connect-function) + (apply-partially #'erc--url-default-connect-function ircsp))) + (url-irc-function (lambda (&rest r) + (apply #'erc-handle-irc-url `(,@r ,fn))))) + ;; Amazingly, this does TRT for /&chan, /#chan, /##chan, /#&chan + (url-irc url))) + (provide 'erc) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index be95a2f8e0..f68a7debed 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -934,4 +934,99 @@ erc-tls '(nil 7000 nil "Bob's Name" t "bob:changeme" nil nil nil nil "bobo" nil))))))) +(defun erc-tests--make-server-buf (name) + (with-current-buffer (get-buffer-create name) + (erc-mode) + (setq erc-server-process (start-process "sleep" (current-buffer) + "sleep" "1") + erc-session-server (concat "irc." name ".org") + erc-session-port 6667 + erc-network (intern name)) + (set-process-query-on-exit-flag erc-server-process nil) + (current-buffer))) + +(defun erc-tests--make-client-buf (server name) + (unless (bufferp server) + (setq server (get-buffer server))) + (with-current-buffer (get-buffer-create name) + (erc-mode) + (setq erc--target (erc--target-from-string name)) + (dolist (v '(erc-server-process + erc-session-server + erc-session-port + erc-network)) + (set v (buffer-local-value v server))) + (current-buffer))) + +(ert-deftest erc-handle-irc-url () + (should-error (erc-handle-irc-url "irc.gnu.org" 6667 nil nil nil)) + (let* (calls + rvbuf + erc-networks-alist + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook + (connect (lambda (&rest r) + (push r calls) + (if (functionp rvbuf) (funcall rvbuf) rvbuf)))) + + (cl-letf (((symbol-function 'erc-cmd-JOIN) + (lambda (&rest r) (push r calls)))) + + (with-current-buffer (erc-tests--make-server-buf "foonet") + (setq rvbuf (current-buffer))) + (erc-tests--make-server-buf "barnet") + (erc-tests--make-server-buf "baznet") + + (ert-info ("Unknown network") + (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil connect) + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, no port") + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil connect) + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, no port") + (setq erc-networks-alist '((foonet "irc.foonet.org"))) + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil connect) + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, different port") + (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil connect) + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, existing chan with key") + (erc-tests--make-client-buf "foonet" "#chan") + (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil connect) + (should (equal '("#chan" "sec") (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, connect, no chan") + (erc-handle-irc-url "irc.gnu.org" nil nil nil nil connect) + (should (equal '(:server "irc.gnu.org") (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, connect, chan") + (with-current-buffer "foonet" + (should-not (local-variable-p 'erc-after-connect))) + (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu"))) + (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil connect) + (should (equal '(:server "irc.gnu.org") (pop calls))) + (should-not calls) + (with-current-buffer "gnu" + (should (local-variable-p 'erc-after-connect)) + (funcall (car erc-after-connect)) + (should (equal '("#spam" nil) (pop calls))) + (should-not erc-after-connect) + (should-not (local-variable-p 'erc-after-connect))) + (should-not calls)))) + + (when noninteractive + (kill-buffer "foonet") + (kill-buffer "barnet") + (kill-buffer "baznet") + (kill-buffer "#chan"))) + ;;; erc-tests.el ends here -- 2.36.1