branch: elpa/jabber
commit 4a9ea2a8572f123a524823a479a2e8349f60e5d8
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
uri: Separate command dispatch
---
lisp/jabber-uri.el | 81 +++++++++++++++++++++++++++++++++++++++++++++++
lisp/jabber-util.el | 69 ----------------------------------------
lisp/jabber.el | 1 +
tests/jabber-test-util.el | 25 +++++++++++++++
4 files changed, 107 insertions(+), 69 deletions(-)
diff --git a/lisp/jabber-uri.el b/lisp/jabber-uri.el
new file mode 100644
index 0000000000..43df85e3ea
--- /dev/null
+++ b/lisp/jabber-uri.el
@@ -0,0 +1,81 @@
+;;; jabber-uri.el --- XMPP URI parsing and dispatch -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2026 Thanos Apollo
+
+;; Maintainer: Thanos Apollo <[email protected]>
+
+;; This file is a part of jabber.el.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;;; Commentary:
+
+;; Parse XMPP URIs separately from dispatching their interactive commands.
+
+;;; Code:
+
+(require 'url-parse)
+(require 'jabber-ahc)
+(require 'jabber-chat)
+(require 'jabber-muc)
+(require 'jabber-register)
+(require 'jabber-util)
+
+(defun jabber-uri--parse-args (text)
+ "Return decoded key-value pairs from URI argument TEXT."
+ (when text
+ (mapcar (lambda (pair)
+ (pcase-let ((`(,key ,value) (split-string pair "=")))
+ (cons key (jabber-unhex value))))
+ (split-string text ";"))))
+
+(defun jabber-uri-parse (uri)
+ "Return the JID, method, and arguments parsed from XMPP URI."
+ (when (string-match "//" uri)
+ (error "URIs with authority part are not supported"))
+ (unless (string-match
+ "\\`xmpp:\\([^?]+\\)\\(?:\\?\\([a-z]+\\)\\(?:;\\(.*\\)\\)?\\)?\\'"
+ uri)
+ (error "Invalid XMPP URI '%s'" uri))
+ (list :jid (jabber-unhex (match-string 1 uri))
+ :method (match-string 2 uri)
+ :args (jabber-uri--parse-args (match-string 3 uri))))
+
+(defun jabber-uri--dispatch (uri-data)
+ "Run the command described by parsed URI-DATA."
+ (let ((account (jabber-read-account))
+ (jid (plist-get uri-data :jid))
+ (method (plist-get uri-data :method))
+ (args (plist-get uri-data :args)))
+ (cond
+ ((string= method "join")
+ (jabber-muc-join
+ account jid (jabber-muc-read-my-nickname account jid) t))
+ ((string= method "register")
+ (jabber-get-register account jid))
+ ((string= method "command")
+ (jabber-ahc-execute-command account jid (cdr (assoc "node" args))))
+ (t
+ (jabber-chat-with account jid)))))
+
+(defun jabber-handle-uri (uri &rest _ignored-args)
+ "Handle XMPP URI according to draft-saintandre-xmpp-iri-04.
+See Info node `(jabber)XMPP URIs'.
+IGNORED-ARGS are ignored arguments the handler may pass."
+ (interactive "sEnter XMPP URI: ")
+ (let ((uri-data (jabber-uri-parse uri)))
+ (raise-frame)
+ (jabber-uri--dispatch uri-data)))
+
+(defun jabber-url-xmpp (url)
+ "Handle XMPP URLs from internal Emacs functions."
+ (jabber-handle-uri (url-recreate-url url)))
+
+(fset 'url-xmpp #'jabber-url-xmpp)
+
+(provide 'jabber-uri)
+
+;;; jabber-uri.el ends here
diff --git a/lisp/jabber-util.el b/lisp/jabber-util.el
index 08eae7fb4b..cb36ada8a8 100644
--- a/lisp/jabber-util.el
+++ b/lisp/jabber-util.el
@@ -46,14 +46,6 @@
;; Global reference declarations
(declare-function auth-source-search "auth-source" (&rest spec))
-(declare-function jabber-chat-with "jabber-chat.el"
- (jc jid &optional other-window))
-(declare-function jabber-ahc-execute-command "jabber-ahc.el" (jc to node))
-(declare-function jabber-get-register "jabber-register.el" (jc to))
-(declare-function jabber-muc-read-my-nickname "jabber-muc.el"
- (jc group &optional default))
-(declare-function jabber-muc-join "jabber-muc.el"
- (jc group nickname &optional popup))
(defvar jabber-delay-xmlns) ; jabber-xml.el
(defvar jabber-delay-legacy-xmlns) ; jabber-xml.el
(defvar jabber-stanzas-xmlns) ; jabber-xml.el
@@ -776,67 +768,6 @@ For example, \"ji%C5%99i@%C4%8Dechy.example/v%20Praze\"
becomes
\"jiři@čechy.example/v Praze\"."
(decode-coding-string (url-unhex-string string) 'utf-8))
-(defun jabber-handle-uri (uri &rest _ignored-args)
- "Handle XMPP links according to draft-saintandre-xmpp-iri-04.
-See Info node `(jabber)XMPP URIs'.
-URI is a string with the \"xmpp://\" link to handle.
-IGNORED-ARGS are ignored arguments the handler may pass."
- (interactive "sEnter XMPP URI: ")
-
- (when (string-match "//" uri)
- (error "URIs with authority part are not supported"))
-
- ;; This regexp handles three cases:
- ;; xmpp:[email protected]
- ;; xmpp:[email protected]?roster
- ;; xmpp:[email protected]?roster;name=Romeo%20Montague;group=Lovers
- (unless (string-match
"^xmpp:\\([^?]+\\)\\(\\?\\([a-z]+\\)\\(;\\(.*\\)\\)?\\)?" uri)
- (error "Invalid XMPP URI '%s'" uri))
-
- ;; We start by raising the Emacs frame.
- (raise-frame)
-
- (let ((jid (jabber-unhex (match-string 1 uri)))
- (method (match-string 3 uri))
- (args (let ((text (match-string 5 uri)))
- ;; If there are arguments...
- (when text
- ;; ...split the pairs by ';'...
- (let ((pairs (split-string text ";")))
- (mapcar (lambda (pair)
- ;; ...and split keys from values by '='.
- (pcase-let ((`(,key ,value)
- (split-string pair "=")))
- ;; Values can be hex-coded.
- (cons key (jabber-unhex value))))
- pairs))))))
- ;; The full list of methods is at
- ;; <URL:http://www.jabber.org/registrar/querytypes.html>.
- (cond
- ;; Join an MUC.
- ((string= method "join")
- (let ((account (jabber-read-account)))
- (jabber-muc-join
- account jid (jabber-muc-read-my-nickname account jid) t)))
- ;; Register with a service.
- ((string= method "register")
- (jabber-get-register (jabber-read-account) jid))
- ;; Run an ad-hoc command
- ((string= method "command")
- ;; XXX: does the 'action' attribute make sense?
- (jabber-ahc-execute-command
- (jabber-read-account) jid (cdr (assoc "node" args))))
- ;; Everything else: open a chat buffer.
- (t
- (jabber-chat-with (jabber-read-account) jid)))))
-
-(defun jabber-url-xmpp (url)
- "Handle XMPP URLs from internal Emacs functions."
- ;; URL handlers are looked up by scheme as `url-SCHEME'.
- (jabber-handle-uri (url-recreate-url url)))
-
-(fset 'url-xmpp #'jabber-url-xmpp)
-
(defun jabber-string>-numerical (s1 s2)
"Return t when S1 collates after S2 in numerical order."
(cond ((string= s1 s2) nil)
diff --git a/lisp/jabber.el b/lisp/jabber.el
index 1250dcafb8..cff9b632e3 100644
--- a/lisp/jabber.el
+++ b/lisp/jabber.el
@@ -196,6 +196,7 @@ One disabled account with a non-standard port:
(require 'jabber-disco-menu)
(require 'jabber-roster-menu)
(require 'jabber-chat-commands)
+(require 'jabber-uri)
(require 'jabber-truncate)
(when (featurep 'dbusbind)
(require 'jabber-notifications nil t))
diff --git a/tests/jabber-test-util.el b/tests/jabber-test-util.el
index f75df5f379..c1235fb8fa 100644
--- a/tests/jabber-test-util.el
+++ b/tests/jabber-test-util.el
@@ -8,6 +8,7 @@
(require 'ert)
(require 'jabber-util)
+(require 'jabber-uri)
(defvar jabber-jid-obarray (make-vector 127 0))
@@ -351,5 +352,29 @@
(should (equal '("[email protected]" "[email protected]" "[email protected]")
(funcall sorter '("[email protected]" "[email protected]"
"[email protected]"))))))
+;;; Group 7: XMPP URI parsing
+
+(ert-deftest jabber-test-uri-parse-chat ()
+ "Parse a plain chat URI without a query method."
+ (should (equal (jabber-uri-parse "xmpp:[email protected]")
+ '(:jid "[email protected]" :method nil :args nil))))
+
+(ert-deftest jabber-test-uri-parse-method-and-arguments ()
+ "Parse and decode an XMPP URI method and its arguments."
+ (should (equal
+ (jabber-uri-parse
+ "xmpp:[email protected]?command;node=hello%20world;action=next")
+ '(:jid "[email protected]"
+ :method "command"
+ :args (("node" . "hello world") ("action" . "next"))))))
+
+(ert-deftest jabber-test-uri-rejects-authority ()
+ "Reject XMPP URIs containing an authority part."
+ (should-error (jabber-uri-parse "xmpp://[email protected]")))
+
+(ert-deftest jabber-test-uri-rejects-trailing-text ()
+ "Reject text after a complete XMPP URI."
+ (should-error (jabber-uri-parse "xmpp:[email protected]?join trailing")))
+
(provide 'jabber-test-util)
;;; jabber-test-util.el ends here
