branch: elpa/jabber
commit 92d3cbc2b384fff6ecd2da08c5f41a20e8c5f55f
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
openpgp: Run send hooks on MUC send paths
---
Makefile | 1 +
lisp/jabber-openpgp-legacy.el | 5 +-
lisp/jabber-openpgp.el | 31 ++++++++-----
tests/jabber-test-openpgp.el | 104 ++++++++++++++++++++++++++++++++++++++++++
4 files changed, 128 insertions(+), 13 deletions(-)
diff --git a/Makefile b/Makefile
index 7b22090e9e..4d6f7d6fe4 100644
--- a/Makefile
+++ b/Makefile
@@ -44,6 +44,7 @@ TESTS ?= tests/jabber-test-activity.el \
tests/jabber-test-omemo-protocol.el \
tests/jabber-test-omemo-store.el \
tests/jabber-test-omemo-trust.el \
+ tests/jabber-test-openpgp.el \
tests/jabber-test-openpgp-legacy.el \
tests/jabber-test-presence.el \
tests/jabber-test-pubsub.el \
diff --git a/lisp/jabber-openpgp-legacy.el b/lisp/jabber-openpgp-legacy.el
index 32c46751e9..0668c25b5e 100644
--- a/lisp/jabber-openpgp-legacy.el
+++ b/lisp/jabber-openpgp-legacy.el
@@ -305,13 +305,16 @@ envelope."
all-keys
nil))
(stripped (jabber-openpgp-legacy--strip-armor encrypted))
+ (id (format "emacs-msg-%d" (floor (* 1000 (float-time)))))
(stanza `(message ((to . ,group)
- (type . "groupchat"))
+ (type . "groupchat")
+ (id . ,id))
(body () ,jabber-openpgp-legacy-fallback-body)
(x ((xmlns .
,jabber-openpgp-legacy-encrypted-xmlns))
,stripped)
,(jabber-hints-store)
,@extra-elements)))
+ (jabber-chat--run-send-hooks stanza body id)
(jabber-send-sexp jc stanza))))
;;; Message decryption (receive)
diff --git a/lisp/jabber-openpgp.el b/lisp/jabber-openpgp.el
index 19b0cebd79..2993cc8d93 100644
--- a/lisp/jabber-openpgp.el
+++ b/lisp/jabber-openpgp.el
@@ -394,18 +394,25 @@ envelope."
(jabber-openpgp--ensure-recipient-keys
jc all-jids
(lambda ()
- (with-current-buffer buffer
- (let* ((inner-xml (jabber-openpgp--build-crypt-xml all-jids body))
- (encrypted (jabber-openpgp--encrypt jc inner-xml all-jids))
- (stanza `(message ((to . ,group)
- (type . "groupchat"))
- (openpgp ((xmlns . ,jabber-openpgp-xmlns))
- ,(base64-encode-string encrypted t))
- (body () ,jabber-openpgp-fallback-body)
- ,(jabber-hints-store)
- ,(jabber-eme-encryption jabber-openpgp-xmlns
"OpenPGP")
- ,@extra-elements)))
- (jabber-send-sexp jc stanza)))))))
+ (let* ((inner-xml (jabber-openpgp--build-crypt-xml all-jids body))
+ (encrypted (jabber-openpgp--encrypt jc inner-xml all-jids))
+ (id (format "emacs-msg-%.6f" (float-time)))
+ (stanza `(message ((to . ,group)
+ (type . "groupchat")
+ (id . ,id))
+ (openpgp ((xmlns . ,jabber-openpgp-xmlns))
+ ,(base64-encode-string encrypted t))
+ (body () ,jabber-openpgp-fallback-body)
+ ,(jabber-hints-store)
+ ,(jabber-eme-encryption jabber-openpgp-xmlns
"OpenPGP")
+ ,@extra-elements)))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ ;; This runs from the async key-fetch callback where the
+ ;; current buffer is not the MUC buffer; the send hooks
+ ;; read buffer-local state, so restore the buffer first.
+ (jabber-chat--run-send-hooks stanza body id)))
+ (jabber-send-sexp jc stanza))))))
;;; Receive path
diff --git a/tests/jabber-test-openpgp.el b/tests/jabber-test-openpgp.el
new file mode 100644
index 0000000000..5fc49718c5
--- /dev/null
+++ b/tests/jabber-test-openpgp.el
@@ -0,0 +1,104 @@
+;;; jabber-test-openpgp.el --- Tests for jabber-openpgp -*- lexical-binding:
t; -*-
+
+;;; Commentary:
+
+;; XEP-0373 OpenPGP send paths.
+
+;;; Code:
+
+(require 'ert)
+(require 'jabber-chat)
+(require 'jabber-openpgp)
+(require 'jabber-openpgp-legacy)
+
+;;; Group 1: MUC send hooks (XEP-0373)
+
+(defmacro jabber-test-openpgp--with-muc-send-stubs (sent-var &rest body)
+ "Run BODY with the OpenPGP MUC encrypt/send path stubbed.
+SENT-VAR is bound to the stanza passed to `jabber-send-sexp'."
+ (declare (indent 1) (debug t))
+ `(let ((,sent-var nil))
+ (cl-letf (((symbol-function 'jabber-openpgp--muc-participant-jids)
+ (lambda (_group) '("[email protected]")))
+ ((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-openpgp--ensure-recipient-keys)
+ (lambda (_jc _jids callback) (funcall callback)))
+ ((symbol-function 'jabber-openpgp--build-crypt-xml)
+ (lambda (_jids _body) '(payload ())))
+ ((symbol-function 'jabber-openpgp--encrypt)
+ (lambda (_jc _xml _jids &optional _sign) "cipher"))
+ ((symbol-function 'jabber-send-sexp)
+ (lambda (_jc stanza) (setq ,sent-var stanza))))
+ ,@body)))
+
+(ert-deftest jabber-test-openpgp-muc-send-hooks-run-in-buffer ()
+ "MUC send hooks run in the originating buffer, not the callback's."
+ (let* ((muc-buffer (generate-new-buffer "*test-openpgp-muc*"))
+ (hook-buffer nil)
+ (jabber-chat-send-hooks
+ (list (lambda (_body _id)
+ (setq hook-buffer (current-buffer))
+ '((probe ((xmlns . "test:probe"))))))))
+ (unwind-protect
+ (jabber-test-openpgp--with-muc-send-stubs sent
+ (with-current-buffer muc-buffer
+ (setq-local jabber-group "[email protected]")
+ (jabber-openpgp--send-muc 'fake-jc "hello"))
+ (should (eq hook-buffer muc-buffer))
+ (should sent)
+ (should (jabber-xml-get-attribute sent 'id))
+ (should (jabber-xml-get-children sent 'probe)))
+ (kill-buffer muc-buffer))))
+
+(ert-deftest jabber-test-openpgp-muc-send-dead-buffer-still-sends ()
+ "A dead originating buffer skips send hooks but the stanza still goes out."
+ (let* ((muc-buffer (generate-new-buffer "*test-openpgp-muc*"))
+ (pending-callback nil)
+ (jabber-chat-send-hooks
+ (list (lambda (_body _id) '((probe ((xmlns . "test:probe"))))))))
+ (jabber-test-openpgp--with-muc-send-stubs sent
+ (cl-letf (((symbol-function 'jabber-openpgp--ensure-recipient-keys)
+ (lambda (_jc _jids callback) (setq pending-callback
callback))))
+ (with-current-buffer muc-buffer
+ (setq-local jabber-group "[email protected]")
+ (jabber-openpgp--send-muc 'fake-jc "hello")))
+ ;; Buffer dies while the key fetch is in flight.
+ (kill-buffer muc-buffer)
+ (funcall pending-callback)
+ (should sent)
+ (should-not (jabber-xml-get-children sent 'probe)))))
+
+;;; Group 2: MUC send hooks (XEP-0027 legacy)
+
+(ert-deftest jabber-test-openpgp-legacy-muc-send-runs-hooks ()
+ "Legacy MUC send stamps an id and runs the send hooks."
+ (let* ((muc-buffer (generate-new-buffer "*test-openpgp-legacy-muc*"))
+ (hook-buffer nil)
+ (sent nil)
+ (jabber-chat-send-hooks
+ (list (lambda (_body _id)
+ (setq hook-buffer (current-buffer))
+ '((probe ((xmlns . "test:probe"))))))))
+ (unwind-protect
+ (cl-letf (((symbol-function
'jabber-openpgp-legacy--muc-participant-jids)
+ (lambda (_group) '("[email protected]")))
+ ((symbol-function 'jabber-openpgp--our-key)
+ (lambda (_jc) 'our-key))
+ ((symbol-function 'jabber-openpgp--recipient-key)
+ (lambda (_jid) 'their-key))
+ ((symbol-function 'epg-encrypt-string)
+ (lambda (&rest _) "-----BEGIN PGP
MESSAGE-----\n\nZm9v\n-----END PGP MESSAGE-----"))
+ ((symbol-function 'jabber-send-sexp)
+ (lambda (_jc stanza) (setq sent stanza))))
+ (with-current-buffer muc-buffer
+ (setq-local jabber-group "[email protected]")
+ (jabber-openpgp-legacy--send-muc 'fake-jc "hello"))
+ (should (eq hook-buffer muc-buffer))
+ (should sent)
+ (should (jabber-xml-get-attribute sent 'id))
+ (should (jabber-xml-get-children sent 'probe)))
+ (kill-buffer muc-buffer))))
+
+(provide 'jabber-test-openpgp)
+;;; jabber-test-openpgp.el ends here
