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.
34 lines
1.3 KiB
Common Lisp
34 lines
1.3 KiB
Common Lisp
(in-package :whatsxmpp)
|
|
|
|
(defun octets-to-lowercase-hex (buf)
|
|
"Formats BUF, a vector of octets, as a lowercase hex string and returns it."
|
|
(declare (type (vector (unsigned-byte 8)) buf))
|
|
(format nil "~(~{~2,'0X~}~)" (coerce buf 'list)))
|
|
|
|
(defun sha1-octets (buf)
|
|
"Returns the SHA1 of BUF, a vector of octets, in lowercase hex."
|
|
(octets-to-lowercase-hex (ironclad:digest-sequence :sha1 buf)))
|
|
|
|
(defun sha1-hex (str)
|
|
"Returns the SHA1 of STR, a string, in lowercase hex."
|
|
(sha1-octets (babel:string-to-octets str)))
|
|
|
|
(defun child-elements (node)
|
|
"Returns the child elements (excluding text nodes) of the CXML DOM node NODE."
|
|
(remove-if-not #'dom:element-p (dom:child-nodes node)))
|
|
|
|
(defun nil-empty (seq)
|
|
"If SEQ (a sequence) is empty, returns NIL; otherwise, returns SEQ."
|
|
(unless (eql (length seq) 0) seq))
|
|
|
|
(defmacro with-promise-from-thread (() &body forms)
|
|
"Return a promise that executes FORMS in a new thread, resolving the promise with the return value of (PROGN ,@FORMS) or rejecting it if an ERROR condition is thrown (with said condition)."
|
|
(let ((resolve (gensym))
|
|
(reject (gensym)))
|
|
`(with-promise (,resolve ,reject)
|
|
(bt:make-thread
|
|
(lambda ()
|
|
(handler-case
|
|
(,resolve (progn ,@forms))
|
|
(error (e) (,reject e))))))))
|