branch: elpa/jabber
commit bf0656ad99e7c9c47d76d2caab9b25b159473e84
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chat: Emit origin-id on outgoing messages
---
CHANGELOG.org | 1 +
doap.xml | 2 +-
lisp/jabber-chat.el | 16 ++++++++++++++--
tests/jabber-test-chat.el | 26 ++++++++++++++++++++++++++
4 files changed, 42 insertions(+), 3 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index c355539017..fe7ac2a014 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -3,6 +3,7 @@
* [Unreleased]
** Added
+- Outgoing messages carry an XEP-0359 origin-id, so replies from other clients
reference a stable id
- OMEMO signed pre-keys now rotate automatically on connect
(~jabber-omemo-signed-pre-key-rotation-period~, 7 days default)
** Fixes
diff --git a/doap.xml b/doap.xml
index 82578c638f..6658127d18 100644
--- a/doap.xml
+++ b/doap.xml
@@ -444,7 +444,7 @@
<xmpp:status>partial</xmpp:status>
<xmpp:version>0.7.0</xmpp:version>
<xmpp:since>0.10.0</xmpp:since>
- <xmpp:note>Origin-id generation on send, stanza-id parsing for MAM
deduplication.</xmpp:note>
+ <xmpp:note>Origin-id stamped on all outgoing messages; stanza-id
parsing for MAM deduplication and reply targets. No disco feature announcement
or referenced-stanza support.</xmpp:note>
</xmpp:SupportedXep>
</implements>
<implements>
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index 87e62708f8..b38645a9f9 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -1033,6 +1033,18 @@ mean the entire element; Dino emits bare <body/> for
full quotes)."
'all))
'all)))
+(defconst jabber-chat--sid-xmlns "urn:xmpp:sid:0"
+ "XEP-0359 unique and stable stanza IDs namespace.")
+
+(defun jabber-chat--origin-id-send-hook (_body id)
+ "Return an XEP-0359 <origin-id/> element carrying ID.
+Stamps every outgoing message so peers replying to us can
+reference a stable id instead of the message id attribute."
+ (and id (list `(origin-id ((xmlns . ,jabber-chat--sid-xmlns)
+ (id . ,id))))))
+
+(add-hook 'jabber-chat-send-hooks #'jabber-chat--origin-id-send-hook)
+
(defun jabber-chat--stanza-id-element (xml-data &optional expected-by)
"Return the first valid XEP-0359 <stanza-id/> child in XML-DATA.
When EXPECTED-BY is non-nil, accept only elements whose `by'
@@ -1041,7 +1053,7 @@ arbitrary `by' values, so groupchat callers must pass the
room JID."
(seq-find
(lambda (child)
(and (eq (jabber-xml-node-name child) 'stanza-id)
- (string= (jabber-xml-get-xmlns child) "urn:xmpp:sid:0")
+ (string= (jabber-xml-get-xmlns child) jabber-chat--sid-xmlns)
(jabber-xml-get-attribute child 'id)
(let ((by (jabber-xml-get-attribute child 'by)))
(and by
@@ -1055,7 +1067,7 @@ Shares its namespace with <stanza-id/>, so match on the
node name."
(let ((el (seq-find
(lambda (child)
(and (eq (jabber-xml-node-name child) 'origin-id)
- (string= (jabber-xml-get-xmlns child) "urn:xmpp:sid:0")))
+ (string= (jabber-xml-get-xmlns child)
jabber-chat--sid-xmlns)))
(jabber-xml-node-children xml-data))))
(and el (jabber-xml-get-attribute el 'id))))
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index c3423c0e0c..df2794bf5f 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -261,6 +261,32 @@
(plist (jabber-chat--msg-plist-from-stanza stanza)))
(should-not (plist-get plist :fallback-range))))
+(ert-deftest jabber-test-chat-send-hooks-stamp-origin-id ()
+ "The default send hooks stamp an XEP-0359 origin-id on outgoing stanzas."
+ (with-temp-buffer
+ (let ((stanza '(message ((to . "[email protected]")
+ (type . "chat")
+ (id . "m-1"))
+ (body () "hi"))))
+ (jabber-chat--run-send-hooks stanza "hi" "m-1")
+ (let ((el (seq-find (lambda (child)
+ (and (consp child) (eq (car child) 'origin-id)))
+ (jabber-xml-node-children stanza))))
+ (should el)
+ (should (equal "m-1" (jabber-xml-get-attribute el 'id)))
+ (should (equal "urn:xmpp:sid:0" (jabber-xml-get-xmlns el)))))))
+
+(ert-deftest jabber-test-chat-origin-id-round-trip ()
+ "A stanza stamped by the send hook parses back into :origin-id."
+ (with-temp-buffer
+ (let ((stanza '(message ((to . "[email protected]")
+ (type . "chat")
+ (id . "m-2"))
+ (body () "hi"))))
+ (jabber-chat--run-send-hooks stanza "hi" "m-2")
+ (should (equal "m-2" (plist-get (jabber-chat--msg-plist-from-stanza
stanza)
+ :origin-id))))))
+
(ert-deftest jabber-test-chat-plist-reply-fallback-not-masked ()
"A non-reply <fallback> before the reply one must not mask it."
(let* ((stanza '(message ((from . "[email protected]/phone")
