Add the initial Emacs interface

5 files changed, 789 insertions, 1 deletions

diff --git a/README b/README
index 07c10c8..8603d3d 100644
--- a/README
+++ b/README
@@ -96,4 +96,4 @@ A rough roadmap:
 
 [+] Basic usage example.
 [.] WeeChat plugin.
-[ ] Emacs mode (and perhaps an XML-based interface).
+[+] Emacs mode (and an XML-based interface).
diff --git a/emacs/xml_interface.c b/emacs/xml_interface.c
new file mode 100644
index 0000000..36b1742
--- /dev/null
+++ b/emacs/xml_interface.c
@@ -0,0 +1,338 @@
+/**
+   @file xml-interface.c
+   @brief An XML interface to communicate with Emacs.
+   @author defanor <defanor@uberspace.net>
+   @date 2021
+   @copyright MIT license.
+
+A basic and ad hoc XML interface, should be improved. Just one active
+request (per direction) at a time. This program may delay responses,
+the parent process (e.g., Emacs) must always respond without waiting
+for any other interaction over this interface to complete (in order to
+avoid dead locks). <request> and <response> elements are used for
+that, and then there are elements that don't require responses, such
+as <log> and <console>.
+
+This program's output is separated with NUL ('\0') characters, to
+simplify parsing in Emacs, while the input is separated with newline
+and EOF ones, to simplify reading with libxml2.
+
+*/
+
+#include <string.h>
+#include <stdio.h>
+#include <errno.h>
+#include <syslog.h>
+#include <gnutls/gnutls.h>
+#include <gsasl.h>
+#include <rexmpp.h>
+#include <rexmpp_openpgp.h>
+
+
+xmlNodePtr postponed_incoming_req = NULL;
+
+
+void print_xml (xmlNodePtr node) {
+  char *s = rexmpp_xml_serialize(node);
+  printf("%s%c\n", s, '\0');
+  free(s);
+}
+
+xmlNodePtr read_xml () {
+  xmlNodePtr elem = NULL;
+  xmlDocPtr doc = xmlReadFd(STDIN_FILENO, "", "utf-8", 0);
+  if (doc != NULL) {
+    elem = xmlCopyNode(xmlDocGetRootElement(doc), 1);
+    xmlFreeDoc(doc);
+    return elem;
+  }
+  return NULL;
+}
+
+
+void request (xmlNodePtr payload)
+{
+  xmlNodePtr req = xmlNewNode(NULL, "request");
+  xmlAddChild(req, payload);
+  print_xml(req);
+  xmlFreeNode(req);
+}
+
+xmlNodePtr read_response () {
+  xmlNodePtr elem = read_xml();
+  if (rexmpp_xml_match(elem, NULL, "response")) {
+    return elem;
+  } else if (postponed_incoming_req == NULL) {
+    postponed_incoming_req = elem;
+    return read_response();
+  }
+  return NULL;
+}
+
+xmlNodePtr req_block (xmlNodePtr req) {
+  request(req);
+  return read_response();
+}
+
+void req_process (rexmpp_t *s,
+                  xmlNodePtr elem)
+{
+  xmlNodePtr rep = xmlNewNode(NULL, "response");
+  rexmpp_err_t err;
+  char buf[64];
+  xmlNodePtr child = xmlFirstElementChild(elem);
+  if (rexmpp_xml_match(child, NULL, "stop")) {
+    snprintf(buf, 64, "%d", rexmpp_stop(s));
+    xmlNodeAddContent(rep, buf);
+  }
+  if (rexmpp_xml_match(child, NULL, "console")) {
+    char *in = xmlNodeGetContent(child);
+    rexmpp_console_feed(s, in, strlen(in));
+    free(in);
+  }
+  if (rexmpp_xml_match(child, NULL, "send")) {
+    if (xmlFirstElementChild(child)) {
+      xmlNodePtr stanza = xmlCopyNode(xmlFirstElementChild(child), 1);
+      snprintf(buf, 64, "%d", rexmpp_send(s, stanza));
+      xmlNodeAddContent(rep, buf);
+    }
+  }
+  if (rexmpp_xml_match(child, NULL, "openpgp-decrypt-message")) {
+    int valid;
+    xmlNodePtr plaintext =
+      rexmpp_openpgp_decrypt_verify_message(s, xmlFirstElementChild(child),
+                                            &valid);
+    xmlAddChild(rep, plaintext);
+    snprintf(buf, 64, "%d", valid);
+    xmlNewProp(rep, "valid", buf);
+  }
+  if (rexmpp_xml_match(child, NULL, "openpgp-payload")) {
+    enum rexmpp_ox_mode mode = REXMPP_OX_CRYPT;
+    char *mode_str = xmlGetProp(child, "mode");
+    if (strcmp(mode_str, "sign") == 0) {
+      mode = REXMPP_OX_SIGN;
+    } else if (strcmp(mode_str, "signcrypt") == 0) {
+      mode = REXMPP_OX_SIGNCRYPT;
+    }
+    free(mode_str);
+
+    xmlNodePtr payload_xml =
+      xmlFirstElementChild(rexmpp_xml_find_child(child, NULL, "payload"));
+
+    char **recipients[16];
+    int recipients_num = 0;
+    xmlNodePtr plchild;
+    for (plchild = xmlFirstElementChild(child);
+         plchild != NULL && recipients_num < 15;
+         plchild = plchild->next) {
+      if (rexmpp_xml_match(plchild, NULL, "to")) {
+        recipients[recipients_num] = xmlNodeGetContent(plchild);
+        recipients_num++;
+      }
+    }
+    recipients[recipients_num] = NULL;
+    char *payload_str = rexmpp_openpgp_payload(s, xmlCopyNode(payload_xml, 1), recipients, mode);
+    for (recipients_num = 0; recipients[recipients_num] != NULL; recipients_num++) {
+      free(recipients[recipients_num]);
+    }
+
+    xmlNodeAddContent(rep, payload_str);
+    free(payload_str);
+  }
+  print_xml(rep);
+  xmlFreeNode(rep);
+  return;
+}
+
+void my_logger (rexmpp_t *s, int priority, const char *fmt, va_list args) {
+  /* Or could just use stderr. */
+  char *buf = malloc(4096);
+  vsnprintf(buf, 4096, fmt, args);
+  char *priority_str = "unknown";
+  switch (priority) {
+  case LOG_EMERG: priority_str = "emerg"; break;
+  case LOG_ALERT: priority_str = "alert"; break;
+  case LOG_CRIT: priority_str = "crit"; break;
+  case LOG_ERR: priority_str = "err"; break;
+  case LOG_WARNING: priority_str = "warning"; break;
+  case LOG_NOTICE: priority_str = "notice"; break;
+  case LOG_INFO: priority_str = "info"; break;
+  case LOG_DEBUG: priority_str = "debug"; break;
+  }
+  xmlNodePtr node = xmlNewNode(NULL, "log");
+  xmlNewProp(node, "priority", priority_str);
+  xmlNodeAddContent(node, buf);
+  free(buf);
+  print_xml(node);
+  xmlFreeNode(node);
+}
+
+void my_console_print_cb (rexmpp_t *s, const char *fmt, va_list args) {
+  char *buf = malloc(1024 * 20);
+  vsnprintf(buf, 1024 * 20, fmt, args);
+  xmlNodePtr node = xmlNewNode(NULL, "console");
+  xmlNodeAddContent(node, buf);
+  free(buf);
+  print_xml(node);
+  xmlFreeNode(node);
+}
+
+int my_sasl_property_cb (rexmpp_t *s, Gsasl_property prop) {
+  if (prop == GSASL_AUTHID) {
+    gsasl_property_set (s->sasl_session, GSASL_AUTHID, s->initial_jid.local);
+    return GSASL_OK;
+  }
+  char *prop_str = NULL;
+  switch (prop) {
+  case GSASL_PASSWORD: prop_str = "password"; break;
+  case GSASL_AUTHID: prop_str = "authid"; break;
+  default: return GSASL_NO_CALLBACK;
+  }
+  xmlNodePtr req = xmlNewNode(NULL, "sasl");
+  xmlNewProp(req, "property", prop_str);
+  xmlNodePtr rep = req_block(req);
+  if (rep == NULL) {
+    return GSASL_NO_CALLBACK;
+  }
+  char *val = xmlNodeGetContent(rep);
+  xmlFreeNode(rep);
+  if (val == NULL) {
+    return GSASL_NO_CALLBACK;
+  }
+  gsasl_property_set (s->sasl_session, prop, val);
+  free(val);
+  return GSASL_OK;
+}
+
+int my_xml_in_cb (rexmpp_t *s, xmlNodePtr node) {
+  xmlNodePtr req = xmlNewNode(NULL, "xml-in");
+  xmlAddChild(req, xmlCopyNode(node, 1));
+  xmlNodePtr rep = req_block(req);
+  char *val = xmlNodeGetContent(rep);
+  xmlFreeNode(rep);
+  if (val == NULL) {
+    return 0;
+  }
+  int n = atoi(val);
+  free(val);
+  return n;
+}
+
+int my_xml_out_cb (rexmpp_t *s, xmlNodePtr node) {
+  xmlNodePtr req = xmlNewNode(NULL, "xml-out");
+  xmlAddChild(req, xmlCopyNode(node, 1));
+  xmlNodePtr rep = req_block(req);
+  char *val = xmlNodeGetContent(rep);
+  xmlFreeNode(rep);
+  if (val == NULL) {
+    return 0;
+  }
+  int n = atoi(val);
+  free(val);
+  return n;
+}
+
+
+main (int argc, char **argv) {
+
+  /* The minimal initialisation: provide an allocated rexmpp_t
+     structure and an initial jid. */
+  rexmpp_t s;
+  rexmpp_err_t err;
+  err = rexmpp_init(&s, argv[1], my_logger);
+  if (err != REXMPP_SUCCESS) {
+    return -1;
+  }
+  s.sasl_property_cb = my_sasl_property_cb;
+  s.xml_in_cb = my_xml_in_cb;
+  s.xml_out_cb = my_xml_out_cb;
+  s.console_print_cb = my_console_print_cb;
+
+  /* Could set a client certificate for SASL EXTERNAL authentication
+     here. */
+  /* gnutls_certificate_set_x509_key_file(s.gnutls_cred, */
+  /*                                      "cert.pem", */
+  /*                                      "key.pem", */
+  /*                                      GNUTLS_X509_FMT_PEM); */
+
+  /* Could also set various other things manually. */
+  /* s.socks_host = "127.0.0.1"; */
+  /* s.socks_port = 4321; */
+  /* s.manual_host = "foo.custom"; */
+  /* gnutls_certificate_set_x509_trust_file(s.gnutls_cred, */
+  /*                                        "foo.custom.crt", */
+  /*                                        GNUTLS_X509_FMT_PEM); */
+  /* rexmpp_openpgp_set_home_dir(&s, "pgp"); */
+  s.roster_cache_file = "roster.xml";
+
+
+  /* Once the main structure is initialised and everything is
+     sufficiently configured, we are ready to run the main loop and
+     call rexmpp from it. */
+
+  fd_set read_fds, write_fds;
+  int nfds;
+  struct timeval tv;
+  struct timeval *mtv;
+  int n = 0;
+
+  do {
+    /* Check if we have some user input. */
+    if (n > 0 && FD_ISSET(STDIN_FILENO, &read_fds)) {
+      xmlNodePtr elem = read_xml();
+      if (elem != NULL) {
+        req_process(&s, elem);
+        xmlFreeNode(elem);
+      }
+    }
+
+    /* Run a single rexmpp iteration. */
+    err = rexmpp_run(&s, &read_fds, &write_fds);
+    /* A request could have been queued during it, process it now. */
+    while (postponed_incoming_req != NULL) {
+      xmlNodePtr elem = postponed_incoming_req;
+      postponed_incoming_req = NULL;
+      req_process(&s, elem);
+      xmlFreeNode(elem);
+    }
+    if (err == REXMPP_SUCCESS) {
+      break;
+    }
+    if (err != REXMPP_E_AGAIN) {
+      printf("error: %s\n", rexmpp_strerror(err));
+      break;
+    }
+    /* Could inspect the state here. */
+    /* printf("res %d / conn %d / tls %d / sasl %d / stream %d / carbons %d\n", */
+    /*        s.resolver_state, */
+    /*        s.tcp_state, */
+    /*        s.tls_state, */
+    /*        s.sasl_state, */
+    /*        s.stream_state, */
+    /*        s.carbons_state); */
+
+    /* Ask rexmpp which file descriptors it is interested in, and what
+       the timeouts should be. */
+    FD_ZERO(&read_fds);
+    FD_ZERO(&write_fds);
+    nfds = rexmpp_fds(&s, &read_fds, &write_fds);
+    mtv = rexmpp_timeout(&s, NULL, (struct timeval*)&tv);
+
+    /* Add other file descriptors we are interested in, particularly
+       stdin for user input. */
+    FD_SET(STDIN_FILENO, &read_fds);
+
+    /* Run select(2) with all those file descriptors and timeouts,
+       waiting for either user input or some rexmpp event to occur. */
+    n = select(nfds, &read_fds, &write_fds, NULL, mtv);
+    if (n == -1) {
+      printf("select error: %s\n", strerror(errno));
+      break;
+    }
+  } while (1);
+
+  /* Deinitialise the rexmpp structure in the end, freeing whatever it
+     allocated. */
+  rexmpp_done(&s);
+  return 0;
+}
diff --git a/emacs/xmpp.el b/emacs/xmpp.el
new file mode 100644
index 0000000..40b43af
--- /dev/null
+++ b/emacs/xmpp.el
@@ -0,0 +1,438 @@
+;;; xmpp.el --- an XMPP client             -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 defanor
+
+;; Author: defanor <defanor@uberspace.net>
+;; Maintainer: defanor <defanor@uberspace.net>
+;; Created: 2021-02-24
+;; Keywords: xmpp, rexmpp
+;; Homepage: https://git.uberspace.net/rexmpp/
+;; Version: 0.0.0
+
+;; This file is not part of GNU Emacs.
+
+;; 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See rexmpp's xml_interface.c. Possibly it'll also work with other
+;; libraries later. Might be nice to reuse some generic IM UI library,
+;; something like lui.el.
+
+;; This is even less polished than the library.
+
+;;; Code:
+
+(require 'xml)
+(require 'seq)
+
+(defvar xmpp-command "rexmpp_xml_interface"
+  "A command to run an XMPP client subprocess.")
+
+(defvar xmpp-proc nil
+  "XMPP process buffer. This should be defined for all the
+  XMPP-related buffers.")
+(make-variable-buffer-local 'xmpp-proc)
+
+(defvar xmpp-jid nil
+  "User JID related to a current XMPP-related buffer.")
+(make-variable-buffer-local 'xmpp-jid)
+
+(defvar xmpp-query-buffers nil
+  "An association list of query buffers corresponding to JIDs.")
+(make-variable-buffer-local 'xmpp-query-buffers)
+
+(defvar xmpp-muc-buffers nil
+  "An association list of MUC buffers corresponding to conference
+  JIDs.")
+(make-variable-buffer-local 'xmpp-muc-buffers)
+
+(defvar xmpp-log-buffer nil
+  "An XMPP log buffer.")
+(make-variable-buffer-local 'xmpp-log-buffer)
+
+(defvar xmpp-console-buffer nil
+  "An XMPP text console buffer.")
+(make-variable-buffer-local 'xmpp-console-buffer)
+
+(defvar xmpp-xml-buffer nil
+  "An XMPP XML console buffer.")
+(make-variable-buffer-local 'xmpp-xml-buffer)
+
+(defvar xmpp-request-queue nil
+  "A subprocess request queue.")
+(make-variable-buffer-local 'xmpp-request-queue)
+
+
+(defun xmpp-jid-to-bare (jid)
+  (let* ((jid-list (reverse (string-to-list jid)))
+         (resource-pos (seq-position jid-list ?/)))
+    (if resource-pos
+        (concat (reverse (seq-drop jid-list (1+ resource-pos))))
+      jid)))
+
+(defun xmpp-jid-localpart (jid)
+  (let* ((jid-list (string-to-list jid))
+         (at-pos (seq-position jid-list ?@)))
+    (when at-pos
+      (concat (seq-take jid-list at-pos)))))
+
+(defun xmpp-jid-resource (jid)
+  (let* ((jid-list (reverse (string-to-list jid)))
+         (resource-pos (seq-position jid-list ?/)))
+    (if resource-pos
+        (concat (reverse (seq-take jid-list resource-pos)))
+      jid)))
+
+
+(defun xmpp-gen-id ()
+  (number-to-string (random)))
+
+(defun xmpp-xml-child (xml elem)
+  (seq-find (lambda (x) (and (consp x) (eq (xml-node-name x) elem)))
+            xml))
+
+(defun xmpp-proc-write (xml &optional proc)
+  (let ((cur-proc (or proc xmpp-proc)))
+    (with-temp-buffer
+      (xml-print xml)
+      (insert "\n")
+      (process-send-region cur-proc (point-min) (point-max))
+      (process-send-eof cur-proc))))
+
+(defun xmpp-with-message-body (proc message-xml func)
+  (let* ((message-contents (xml-node-children message-xml))
+         (message-body (xmpp-xml-child message-contents 'body))
+         (message-openpgp (xmpp-xml-child message-contents 'openpgp)))
+    (if message-openpgp
+        ;; TODO: check validation results.
+        (xmpp-request `(openpgp-decrypt-message nil ,message-xml)
+                      (lambda (response)
+                        (let* ((payload (xmpp-xml-child response 'payload)))
+                          (funcall func (car (xml-node-children payload)))))
+                      proc)
+      (funcall func message-body))))
+
+(defun xmpp-process-input (proc xml)
+  (with-current-buffer (process-buffer proc)
+    (with-current-buffer xmpp-xml-buffer
+      (xmpp-insert (format "<!-- server, %s -->\n" (current-time-string)))
+      (xmpp-insert-xml (list xml))
+      (xmpp-insert "\n")))
+  (when (eq (xml-node-name xml) 'message)
+    (xmpp-with-message-body
+     proc xml
+     (lambda (message-body)
+       (let ((message-from (xml-get-attribute-or-nil xml 'from)))
+         (pcase (xml-get-attribute-or-nil xml 'type)
+           ("chat"
+            (when message-body
+              (with-current-buffer (xmpp-query message-from proc)
+                (xmpp-insert
+                 (concat "< " (car (xml-node-children message-body)) "\n")))))
+           ("groupchat"
+            (when message-body
+              (with-current-buffer (xmpp-muc-buffer message-from proc)
+                (xmpp-insert
+                 (concat (xmpp-jid-resource message-from) ": "
+                         (car (xml-node-children message-body)) "\n")))))))))))
+
+(defun xmpp-set-from (proc xml)
+  (let* ((name (xml-node-name xml))
+         (attr (xml-node-attributes xml))
+         (children (xml-node-children xml))
+         (new-attr (if (assoc 'from attr)
+                       attr
+                     (cons (cons 'from
+                                 (with-current-buffer
+                                     (process-buffer proc)
+                                   xmpp-jid))
+                           attr))))
+    (cons name (cons new-attr children))))
+
+(defun xmpp-process-output (proc xml)
+  (with-current-buffer (process-buffer proc)
+    (with-current-buffer xmpp-xml-buffer
+      (xmpp-insert (format "<!-- client, %s -->\n" (current-time-string)))
+      (xmpp-insert-xml (list xml))
+      (xmpp-insert "\n")))
+  (when (eq (xml-node-name xml) 'message)
+    (xmpp-with-message-body
+     ;; The "from" attribute is needed for validation.
+     proc (xmpp-set-from proc xml)
+     (lambda (message-body)
+       (let ((message-to (xml-get-attribute-or-nil xml 'to)))
+         (pcase (xml-get-attribute-or-nil xml 'type)
+           ("chat"
+            (when message-body
+              (let ((buf (xmpp-query message-to proc)))
+                (when buf
+                  (with-current-buffer buf
+                    (xmpp-insert
+                     (concat
+                      "> " (car (xml-node-children message-body)) "\n")))))))
+           ("groupchat" nil)))))))
+
+(defun xmpp-process (proc xml)
+  (let* ((buf (process-buffer proc))
+         (log-buf (with-current-buffer buf xmpp-log-buffer))
+         (console-buf (with-current-buffer buf xmpp-console-buffer))
+         (xml-elem (car xml)))
+    (pcase (xml-node-name xml-elem)
+      ('request
+       (pcase (car (xml-node-children xml-elem))
+         (`(sasl ((property . ,prop)))
+          (xmpp-proc-write `((response nil ,(read-passwd
+                                             (concat "SASL " prop ": "))))
+                           proc))
+         (`(xml-in nil ,xml-in)
+          (progn (xmpp-process-input proc xml-in)
+                 (xmpp-proc-write '((response nil "0")) proc)))
+         (`(xml-out nil ,xml-out)
+          (progn (xmpp-process-output proc xml-out)
+                 (xmpp-proc-write '((response nil "0")) proc)))))
+      ('log
+       (with-current-buffer log-buf
+         (goto-char (point-max))
+         (insert (format "%s [%s] %s\n" (current-time-string)
+                         (xml-get-attribute xml-elem 'priority)
+                         (car (xml-node-children xml-elem))))))
+      ('console
+       (with-current-buffer console-buf
+         (xmpp-insert (car (xml-node-children xml-elem)))))
+      ('response
+       (with-current-buffer buf
+         (when (cdar (last xmpp-request-queue))
+           (funcall (cdar (last xmpp-request-queue))
+                    (car (xml-node-children xml-elem))))
+         (setq-local xmpp-request-queue
+                     (reverse (cdr (reverse xmpp-request-queue))))
+         ;; send the next request if we have any queued
+         (when xmpp-request-queue
+           (xmpp-proc-write `((request nil ,(caar (last xmpp-request-queue))))
+                            xmpp-proc)))))))
+
+(defun xmpp-request (req cb &optional proc)
+  (let ((cur-proc (or proc xmpp-proc)))
+    (with-current-buffer (process-buffer cur-proc)
+      (when (not xmpp-request-queue)
+        (xmpp-proc-write `((request nil ,req)) cur-proc))
+      (push (cons req cb) xmpp-request-queue))))
+
+(defun xmpp-stop (&optional proc)
+  (interactive)
+  (xmpp-request '(stop) nil proc))
+
+(defun xmpp-send (xml &optional proc)
+  (xmpp-request `(send nil ,xml) nil proc))
+
+(defun xmpp-filter (proc str)
+  (when (buffer-live-p (process-buffer proc))
+    (with-current-buffer (process-buffer proc)
+      (save-excursion
+        (goto-char (point-max))
+        (insert str)
+        (goto-char (point-min))
+        (let ((zero (search-forward "\0" nil t)))
+          (while zero
+            (let ((xml (xml-parse-region (point-min) (1- zero))))
+              (xmpp-process proc xml)
+              (delete-region (point-min) zero)
+              (setq zero (search-forward "\0" nil t)))))))))
+
+(defun xmpp (jid)
+  "Initiates a new XMPP session."
+  (interactive "sJID: ")
+  (let* ((bare-jid (xmpp-jid-to-bare jid))
+         (proc-buf (generate-new-buffer
+                    (concat "*xmpp:" bare-jid " process*"))))
+    (with-current-buffer proc-buf
+      (setq-local xmpp-jid bare-jid)
+      (setq-local xmpp-request-queue nil)
+      (setq-local xmpp-query-buffers '())
+      (setq-local xmpp-muc-buffers '())
+      (setq-local xmpp-log-buffer
+                  (generate-new-buffer
+                   (concat "*xmpp:" bare-jid " log*")))
+      (setq-local xmpp-console-buffer
+                  (generate-new-buffer
+                   (concat "*xmpp:" bare-jid " text console*")))
+      (setq-local xmpp-xml-buffer
+                  (generate-new-buffer
+                   (concat "*xmpp:" bare-jid " XML console*")))
+      (with-current-buffer xmpp-console-buffer
+        (xmpp-console-mode))
+      (with-current-buffer xmpp-xml-buffer
+        (xmpp-xml-mode))
+      (setq-local xmpp-proc
+                  (make-process :name "xmpp"
+                                :command (list xmpp-command jid)
+                                :buffer proc-buf
+                                :filter 'xmpp-filter))
+      (let ((new-proc xmpp-proc))
+        (with-current-buffer xmpp-console-buffer
+          (setq-local xmpp-proc new-proc))
+        (with-current-buffer xmpp-xml-buffer
+          (setq-local xmpp-proc new-proc))
+        (with-current-buffer xmpp-log-buffer
+          (setq-local xmpp-proc new-proc))))))
+
+(defun xmpp-insert (args)
+  (save-excursion
+    (goto-char xmpp-input-point)
+    (funcall 'insert args)
+    (setq-local xmpp-input-point (point)))
+  (goto-char (point-max)))
+
+(defun xmpp-insert-xml (xml)
+  (save-excursion
+    (goto-char xmpp-input-point)
+    (xml-print xml)
+    (setq-local xmpp-input-point (point)))
+  (goto-char (point-max)))
+
+(defun xmpp-send-input ()
+  (interactive)
+  (let ((input (buffer-substring xmpp-input-point (point-max))))
+    (pcase major-mode
+      ('xmpp-query-mode (xmpp-send `(message ((xmlns . "jabber:client")
+                                              (id . ,(xmpp-gen-id))
+                                              (to . ,xmpp-jid)
+                                              (type . "chat"))
+                                             (body nil ,input))))
+      ('xmpp-muc-mode (xmpp-send `(message ((xmlns . "jabber:client")
+                                            (id . ,(xmpp-gen-id))
+                                            (to . ,xmpp-jid)
+                                            (type . "groupchat"))
+                                           (body nil ,input))))
+      ('xmpp-console-mode (xmpp-request `(console nil ,input) nil xmpp-proc))
+      ('xmpp-xml-mode
+       (mapcar 'xmpp-send (xml-parse-region xmpp-input-point (point-max))))))
+  (delete-region xmpp-input-point (point-max)))
+
+
+(defvar xmpp-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'xmpp-send-input)
+    map)
+  "Keymap for `xmpp-mode'.")
+
+(define-derived-mode xmpp-mode nil "XMPP"
+  "XMPP major mode."
+  (setq-local xmpp-input-point (point-min)))
+
+(define-derived-mode xmpp-query-mode xmpp-mode "XMPP-query"
+  "XMPP Query major mode."
+  (setq-local xmpp-input-point (point-min)))
+
+(define-derived-mode xmpp-muc-mode xmpp-mode "XMPP-MUC"
+  "XMPP Query major mode."
+  (setq-local xmpp-input-point (point-min)))
+
+(define-derived-mode xmpp-console-mode xmpp-mode "XMPP-text-console"
+  "XMPP Text Console major mode."
+  (setq-local xmpp-input-point (point-min)))
+
+(define-derived-mode xmpp-xml-mode xmpp-mode "XMPP-XML-console"
+  "XMPP XML Console major mode."
+  (setq-local xmpp-input-point (point-min)))
+
+
+(defun xmpp-query-buffer-on-close ()
+  (let ((query-jid xmpp-jid))
+    (when (buffer-live-p (process-buffer xmpp-proc))
+      (with-current-buffer (process-buffer xmpp-proc)
+        (setq xmpp-query-buffers
+              (seq-remove (lambda (x) (equal (car x) query-jid))
+                          xmpp-query-buffers)))))
+  t)
+
+(defun xmpp-muc-buffer-on-close ()
+  (let ((muc-jid xmpp-jid))
+    (when (buffer-live-p (process-buffer xmpp-proc))
+      (with-current-buffer (process-buffer xmpp-proc)
+        (setq xmpp-muc-buffers
+              (seq-remove (lambda (x) (equal (car x) muc-jid))
+                          xmpp-muc-buffers)))))
+  t)
+
+(defun xmpp-query (jid &optional proc)
+  (interactive "sQuery JID: ")
+  (let ((process (or proc xmpp-proc))
+        (bare-jid (xmpp-jid-to-bare jid)))
+    (with-current-buffer (process-buffer process)
+      (if (assoc bare-jid xmpp-query-buffers)
+          (let ((query-buf (cdr (assoc bare-jid xmpp-query-buffers))))
+            (display-buffer query-buf)
+            query-buf)
+        (let ((query-buf (generate-new-buffer (concat "*xmpp:" bare-jid "*"))))
+          (with-current-buffer query-buf
+            (xmpp-query-mode)
+            (setq-local xmpp-jid bare-jid)
+            (setq-local xmpp-proc process)
+            (setq-local kill-buffer-query-functions
+                        (cons #'xmpp-query-buffer-on-close
+                              kill-buffer-query-functions)))
+          (push (cons bare-jid query-buf) xmpp-query-buffers)
+          (display-buffer query-buf)
+          query-buf)))))
+
+(defun xmpp-muc-join (jid &optional nick proc)
+  (interactive "sConference JID: ")
+  (let* ((process (or proc xmpp-proc))
+         (bare-jid (xmpp-jid-to-bare jid))
+         (my-nick (or nick (xmpp-jid-localpart xmpp-jid)))
+         (full-jid (concat bare-jid "/" my-nick)))
+    (xmpp-send `(presence ((xmlns . "jabber:client")
+                           (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)))
+
+(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"))))))
+
+
+(defun xmpp-muc-buffer (jid &optional proc)
+  (let* ((process (or proc xmpp-proc))
+        (bare-jid (xmpp-jid-to-bare jid)))
+    (with-current-buffer (process-buffer process)
+      (if (assoc bare-jid xmpp-muc-buffers)
+          (let ((muc-buf (cdr (assoc bare-jid xmpp-muc-buffers))))
+            (display-buffer muc-buf)
+            muc-buf)
+        (let ((muc-buf (generate-new-buffer (concat "*xmpp:" bare-jid "*"))))
+          (with-current-buffer muc-buf
+            (xmpp-muc-mode)
+            (setq-local xmpp-jid bare-jid)
+            (setq-local xmpp-proc process)
+            (setq-local kill-buffer-query-functions
+                        (cons #'xmpp-muc-buffer-on-close
+                              kill-buffer-query-functions)))
+          (push (cons bare-jid muc-buf) xmpp-muc-buffers)
+          (display-buffer muc-buf)
+          muc-buf)))))
+
+(provide 'xmpp)
+
+;;; xmpp.el ends here
diff --git a/examples/basic.c b/examples/basic.c
index e3bf12c..55597a8 100644
--- a/examples/basic.c
+++ b/examples/basic.c
@@ -1,3 +1,11 @@
+/**
+   @file basic.c
+   @brief A reference rexmpp-based client.
+   @author defanor <defanor@uberspace.net>
+   @date 2020--2021
+   @copyright MIT license.
+*/
+
 #include <string.h>
 #include <stdio.h>
 #include <errno.h>
@@ -230,4 +238,5 @@ main (int argc, char **argv) {
   /* Deinitialise the rexmpp structure in the end, freeing whatever it
      allocated. */
   rexmpp_done(&s);
+  return 0;
 }
diff --git a/src/rexmpp_console.c b/src/rexmpp_console.c
index b44e045..ecc1338 100644
--- a/src/rexmpp_console.c
+++ b/src/rexmpp_console.c
@@ -315,6 +315,7 @@ void rexmpp_console_feed (rexmpp_t *s, char *str, ssize_t str_len) {
     }
     msg_text = jid_str + strlen(jid_str) + 1;
     xmlNodePtr msg = rexmpp_xml_add_id(s, xmlNewNode(NULL, "message"));
+    xmlNewNs(msg, "jabber:client", NULL);
     xmlNewProp(msg, "to", jid.full);
     xmlNewProp(msg, "type", "chat");
     xmlNewTextChild(msg, NULL, "body", msg_text);
@@ -349,6 +350,7 @@ void rexmpp_console_feed (rexmpp_t *s, char *str, ssize_t str_len) {
     free(b64);
 
     xmlNodePtr msg = rexmpp_xml_add_id(s, xmlNewNode(NULL, "message"));
+    xmlNewNs(msg, "jabber:client", NULL);
     xmlNewProp(msg, "to", jid.full);
     xmlNewProp(msg, "type", "chat");
     xmlAddChild(msg, openpgp);
@@ -370,6 +372,7 @@ void rexmpp_console_feed (rexmpp_t *s, char *str, ssize_t str_len) {
       }
       msg_text = jid_str + strlen(jid_str) + 1;
       xmlNodePtr msg = rexmpp_xml_add_id(s, xmlNewNode(NULL, "message"));
+      xmlNewNs(msg, "jabber:client", NULL);
       xmlNewProp(msg, "to", jid.full);
       xmlNewProp(msg, "type", "groupchat");
       xmlNewTextChild(msg, NULL, "body", msg_text);