c36d61687a
- Groupchats now support XEP-0313 Message Archive Management (MAM)!
- This uses the history stored in the sqlite database, as implemented in the
previous commits.
- The QUERY-ARCHIVE megafunction builds up a SQL query to get stuff out of the
database, in accordance with provided MAM + RSM parameters.
- Notably, various hacks are in here that need to be fixed.
- IQ 'set's are now processed, which means we needed to add a stub impl of
Schrödinger's Chat so people don't drop out of MUCs all of a sudden.
(Well, it just responds to every ping indiscriminately...)
- Oh also the new presence subscription stuff from earlier is borked.
32 lines
1.5 KiB
Common Lisp
32 lines
1.5 KiB
Common Lisp
;;;; XEP-0313: Message Archive Management
|
|
|
|
(in-package :whatsxmpp)
|
|
|
|
(defun whitelisted-mam-keywordize (thing)
|
|
"Interns THING, but only after making sure it's a string from XEP-0313."
|
|
(if (member thing '("start" "end" "with" "first" "last" "count" "max" "FORM_TYPE" "after" "before")
|
|
:test #'string=)
|
|
(intern (string-upcase thing) :keyword)
|
|
thing))
|
|
|
|
(defun alist-from-mam-query (query-elt)
|
|
"Parses the QUERY-ELT, a MAM <query> element, and returns an alist."
|
|
(labels ((consify-df (field-elt)
|
|
(cons (whitelisted-mam-keywordize
|
|
(dom:get-attribute field-elt "var"))
|
|
(nil-empty
|
|
(get-node-text
|
|
(get-node-named (child-elements field-elt) "value")))))
|
|
(consify-rsm (rsm-elt)
|
|
(cons (whitelisted-mam-keywordize
|
|
(dom:node-name rsm-elt))
|
|
(nil-empty (get-node-text rsm-elt)))))
|
|
(let* ((x-elt (get-node-with-xmlns (child-elements query-elt) +data-forms-ns+))
|
|
(rsm-elt (get-node-with-xmlns (child-elements query-elt) +rsm-ns+))
|
|
(query-id (dom:get-attribute query-elt "queryid"))
|
|
(form-fields (map 'list #'consify-df (child-elements x-elt)))
|
|
(rsm-fields (when rsm-elt
|
|
(map 'list #'consify-rsm (child-elements rsm-elt)))))
|
|
(append form-fields rsm-fields (when query-id
|
|
`((:query-id . ,query-id)))))))
|