diff --git a/default.nix b/default.nix index 5dc8e70..10f63d1 100644 --- a/default.nix +++ b/default.nix @@ -676,6 +676,7 @@ buildLisp.program { "xmpp.lisp" "xep-0030.lisp" "xep-0363.lisp" + "xep-0115.lisp" "sqlite.lisp" "db.lisp" "stuff.lisp" diff --git a/namespaces.lisp b/namespaces.lisp index 9038b99..9aacab5 100644 --- a/namespaces.lisp +++ b/namespaces.lisp @@ -21,3 +21,4 @@ (defparameter +unique-stanzas-ns+ "urn:xmpp:sid:0") (defparameter +chat-states-ns+ "http://jabber.org/protocol/chatstates") (defparameter +hints-ns+ "urn:xmpp:hints") +(defparameter +entity-caps-ns+ "http://jabber.org/protocol/caps") diff --git a/stuff.lisp b/stuff.lisp index e0b8715..3c3cb2d 100644 --- a/stuff.lisp +++ b/stuff.lisp @@ -23,6 +23,17 @@ (format *debug-io* "Connection complete! \\o/") (emit :connected comp)) +(defparameter +whatsapp-user-disco-info-list+ + `((disco-identity "whatsxmpp" "phone" "client") + ;; FIXME: The features here must be lexicographically sorted! + (disco-feature ,+entity-caps-ns+) + (disco-feature ,+chat-states-ns+) + (disco-feature ,+disco-info-ns+)) + "List of calls to DISCO-IDENTITY and DISCO-FEATURE for WhatsApp users bridged through to XMPP.") +(defparameter +whatsapp-user-entity-caps+ + (generate-entity-caps +whatsapp-user-disco-info-list+) + "Entity caps string for a bridged WhatsApp user.") + (defun disco-info-handler (comp &key to from &allow-other-keys) "Handles XEP-0030 disco#info requests." (format *debug-io* "~&disco#info: ~A~%" to) @@ -45,7 +56,7 @@ ((and user-name (not to-resource)) `((disco-identity ,user-name "registered" "account"))) ((and user-name (equal to-resource "whatsapp")) - `((disco-identity "whatsxmpp" "phone" "client"))) + +whatsapp-user-disco-info-list+) (chat-subject `((disco-identity ,chat-subject "text" "conference") (disco-feature ,+muc-ns+) @@ -265,24 +276,21 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678." (with-wa-handler-context (comp conn jid) (format *debug-io* "~&ws-error ~A: ~A~%" jid err) (admin-msg comp jid - (format nil "WhatsApp websocket error: ~A" err)) + (format nil "WhatsApp websocket error: ~A~%Will automatically reconnect, but if issues persist, try a re-connect or re-register." err)) (admin-presence comp jid "WebSocket error" "away") (setf (gethash jid (component-whatsapps comp)) nil))) (defun wa-handle-ws-close (comp conn jid) (with-wa-handler-context (comp conn jid) (format *debug-io* "~&ws-close: ~A~%" jid) - (admin-msg comp jid - "WhatsApp websocket closed (will reconnect soon).") - (admin-presence comp jid "WebSocket closed" "away") - (setf (gethash jid (component-whatsapps comp)) nil))) - -(defun wa-handle-ws-open (comp conn jid) - (with-wa-handler-context (comp conn jid) - (format *debug-io* "~&ws-open: ~A~%" jid) - (admin-presence comp jid "Connected" "away") - (admin-msg comp jid - "WhatsApp websocket connected."))) + (when (nth-value 1 (gethash jid (component-whatsapps comp))) + ;; If true, we're still doing automatic reconnections. + ;; Otherwise, we will have already yelled at the user for + ;; whatever caused them to disconnect, so don't do anything here. + (admin-msg comp jid + "WhatsApp websocket closed (will reconnect soon).") + (admin-presence comp jid "WebSocket closed" "away") + (setf (gethash jid (component-whatsapps comp)) nil)))) (defun wa-handle-ws-qrcode (comp conn jid qrcode) (with-wa-handler-context (comp conn jid) @@ -307,6 +315,18 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678." (whatscl::send-presence conn :available) (format *debug-io* "~&ws-connected: ~A (as ~A)~%" jid wa-jid)))) +(defun wa-handle-disconnect (comp conn jid kind) + (with-wa-handler-context (comp conn jid) + (format *debug-io* "~&disconnect for ~A: ~A" jid kind) + (let ((reason + (case kind + (:replaced "Connection replaced by other WhatsApp Web session") + (:removed "Connection removed in mobile app")))) + (admin-msg comp jid (format nil "Error: ~A." reason)) + (admin-presence comp jid reason "xa")) + (admin-msg comp jid "(Disabling automatic reconnections.)") + (remhash jid (component-whatsapps comp)))) + (defun wa-handle-error-status-code (comp conn jid err) (with-wa-handler-context (comp conn jid) (format *debug-io* "~&error-status-code for ~A: ~A~%" jid err) @@ -524,6 +544,11 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (component-name comp))) (cxml:with-element "status" (cxml:text status)) + (cxml:with-element "c" + (cxml:attribute "xmlns" +entity-caps-ns+) + (cxml:attribute "hash" "sha-1") + (cxml:attribute "node" "https://git.theta.eu.org/eta/whatsxmpp") + (cxml:attribute "ver" +whatsapp-user-entity-caps+)) (cxml:with-element "x" (cxml:attribute "xmlns" +vcard-avatar-ns+) (if avatar-sha1 @@ -854,11 +879,11 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (cxml:attribute "xmlns" +chat-states-ns+)))))))) (defun bind-wa-handlers (comp conn jid) - (on :ws-open conn (lambda () (wa-handle-ws-open comp conn jid))) (on :ws-close conn (lambda (&rest args) (declare (ignore args)) (wa-handle-ws-close comp conn jid))) (on :ws-error conn (lambda (e) (wa-handle-ws-error comp conn jid e))) + (on :disconnect conn (lambda (k) (wa-handle-disconnect comp conn jid k))) (on :error conn (lambda (e backtrace) (wa-handle-error comp conn jid e backtrace))) (on :error-status-code conn (lambda (e) (wa-handle-error-status-code comp conn jid e))) (on :qrcode conn (lambda (text) (wa-handle-ws-qrcode comp conn jid text))) diff --git a/xep-0115.lisp b/xep-0115.lisp new file mode 100644 index 0000000..7f0dbd9 --- /dev/null +++ b/xep-0115.lisp @@ -0,0 +1,29 @@ +;;;; XEP-0115: Entity Capabilities + +(in-package :whatsxmpp) + +(defun format-disco-identity (name type category &optional (lang "")) + "Formats a disco#info identity into a verification string part." + (format nil "~A/~A/~A/~A" category type lang name)) + +(defun generate-entity-caps (disco-info-list) + "Using DISCO-INFO-LIST, a quoted list of calls to DISCO-IDENTITY and DISCO-FEATURE, generate and return an XEP-0115 verification string. +WARNING: You must pre-sort DISCO-INFO-LIST according to the rules in XEP-0115 ยง 5.1." + (let (identities features) + (loop + for call in disco-info-list + do (ecase (car call) + (disco-identity (push (cdr call) identities)) + (disco-feature (push (cdr call) features)))) + (qbase64:encode-bytes + (ironclad:digest-sequence :sha1 + (babel:string-to-octets + (format nil "~{~A<~}~{~A<~}" + (mapcar (lambda (call) + ;; Because DISCO-IDENTITY and FORMAT-DISCO-IDENTITY + ;; intentionally take the same lambda lists, + ;; we can just do this. + (apply #'format-disco-identity call)) + identities) + ;; DISCO-FEATURE takes one argument (the feature name) + (mapcar #'car features)))))))