From ecbef993632c9b3bdf442b381e02e1ad24bc1c87 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Fri, 17 Nov 2023 18:34:47 +0300
Subject: Implement MUC self-ping (XEP-0410)

---
 emacs/xml_interface.c | 16 ++++++++++++++++
 emacs/xmpp.el         | 46 +++++++++++++++++++++++++++++++---------------
 2 files changed, 47 insertions(+), 15 deletions(-)

(limited to 'emacs')

diff --git a/emacs/xml_interface.c b/emacs/xml_interface.c
index 02db77d..f98d5d1 100644
--- a/emacs/xml_interface.c
+++ b/emacs/xml_interface.c
@@ -182,6 +182,22 @@ void req_process (rexmpp_t *s,
     char *in = strdup(rexmpp_xml_text_child(child));
     rexmpp_http_upload_path(s, NULL, in, NULL, on_http_upload, strdup(id));
     free(in);
+    /* Responding from on_http_upload */
+  } else if (rexmpp_xml_match(child, NULL, "muc-ping-set")) {
+    const char *occupant_jid = rexmpp_xml_find_attr_val(child, "occupant-jid");
+    const char *delay = rexmpp_xml_find_attr_val(child, "delay");
+    const char *password = rexmpp_xml_find_attr_val(child, "password");
+    if (occupant_jid != NULL && delay != NULL) {
+      snprintf(buf, 64, "%d",
+               rexmpp_muc_ping_set(s, occupant_jid, password, atoi(delay)));
+      respond_text(s, id, buf);
+    }
+  } else if (rexmpp_xml_match(child, NULL, "muc-ping-remove")) {
+    const char *occupant_jid = rexmpp_xml_find_attr_val(child, "occupant-jid");
+    if (occupant_jid != NULL) {
+      snprintf(buf, 64, "%d", rexmpp_muc_ping_remove(s, occupant_jid));
+      respond_text(s, id, buf);
+    }
   }
   return;
 }
diff --git a/emacs/xmpp.el b/emacs/xmpp.el
index 3fcf8b5..ebe6911 100644
--- a/emacs/xmpp.el
+++ b/emacs/xmpp.el
@@ -298,7 +298,7 @@ its printing--which doesn't handle namespaces--can be used too."
                        (add-face-text-property
                         0
                         (length from-nick)
-                        (if (equal xmpp-muc-my-nick from-nick)
+                        (if (equal xmpp-muc-my-occupant-jid message-from)
                             'xmpp-my-nick
                           'xmpp-other-nick)
                         nil
@@ -348,9 +348,20 @@ its printing--which doesn't handle namespaces--can be used too."
                         (concat
                          (xmpp-timestamp-string) ", "
                          my-name
-                         (xmpp-message-string (car (xml-node-children message-body)))
-                          "\n")))))))
-              ("groupchat" nil)))))))))
+                         (xmpp-message-string
+                          (car (xml-node-children message-body)))
+                         "\n")))))))
+              ("groupchat" nil))))))))
+  (when (and (xmpp-xml-match xml 'presence "jabber:client")
+             (or (not (xml-get-attribute-or-nil xml 'type))
+                 (equal (xml-get-attribute-or-nil xml 'type) "available"))
+             (xmpp-xml-child xml 'x "http://jabber.org/protocol/muc"))
+    ;; Joining a MUC
+    (let* ((occupant-jid (xml-get-attribute xml 'to))
+           (muc-jid (xmpp-jid-to-bare occupant-jid))
+           (buf (xmpp-muc-buffer muc-jid proc)))
+      (with-current-buffer buf
+        (setq-local xmpp-muc-my-occupant-jid occupant-jid)))))
 
 (defun xmpp-process (proc xml)
   (let* ((buf (process-buffer proc))
@@ -645,20 +656,25 @@ its printing--which doesn't handle namespaces--can be used too."
                              (id . ,(xmpp-gen-id))
                              (to . ,full-jid))
                             (x ((xmlns . "http://jabber.org/protocol/muc")))))
-      (let ((buf (xmpp-muc-buffer jid proc)))
-        (with-current-buffer buf
-          (setq-local xmpp-muc-my-nick my-nick))
-        buf))))
+      (xmpp-request
+       `(muc-ping-set ((occupant-jid . ,full-jid)
+                       (delay . "600"))
+                      nil)
+       nil
+       proc))))
 
 (defun xmpp-muc-leave (jid &optional proc)
   (interactive "sConference JID: ")
-  (let ((process (or proc xmpp-proc))
-        (full-jid (concat jid "/" xmpp-muc-my-nick)))
-    (xmpp-send `(presence ((xmlns . "jabber:client")
-                           (id . ,(xmpp-gen-id))
-                           (to . ,full-jid)
-                           (type . "unavailable"))))))
-
+  (with-current-buffer (process-buffer (or proc xmpp-proc))
+    (with-current-buffer (cdr (assoc jid xmpp-muc-buffers))
+      (xmpp-send `(presence ((xmlns . "jabber:client")
+                             (id . ,(xmpp-gen-id))
+                             (to . ,xmpp-muc-my-occupant-jid)
+                             (type . "unavailable"))))
+      (xmpp-request
+       `(muc-ping-remove ((occupant-jid . ,xmpp-muc-my-occupant-jid))
+                         nil)
+       nil))))
 
 (defun xmpp-muc-buffer (jid &optional proc)
   (let* ((process (or proc xmpp-proc))
-- 
cgit v1.2.3