eta
/
whatsxmpp
1
0
Fork 0
Code Issues Pull Requests Releases Activity
Browse Source

Initial support for typing notifications / chat state (1-to-1 only)

master
η (eta) 9 months ago
parent
f0612e6613
commit
b8760ac948
1 changed files with 66 additions and 3 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 69
      stuff.lisp

69
stuff.lisp
View File

@ -19,6 +19,8 @@
(defparameter +muc-stable-id-ns+ "http://jabber.org/protocol/muc#stable_id")
(defparameter +muc-user-ns+ "http://jabber.org/protocol/muc#user")
(defparameter +unique-stanzas-ns+ "urn:xmpp:sid:0")
(defparameter +chat-states-ns+ "http://jabber.org/protocol/chatstates")
(defparameter +hints-ns+ "urn:xmpp:hints")
(defvar *xmpp-debug-io* (make-broadcast-stream))
(defvar *xmpp-debug-out* (make-synonym-stream '*xmpp-debug-io*))
@ -559,7 +561,8 @@
(id (dom:get-attribute stanza "id"))
(children (dom:child-nodes stanza))
(body (get-node-named children "body"))
(marker (get-node-with-xmlns children +chat-markers-ns+)))
(marker (get-node-with-xmlns children +chat-markers-ns+))
(chat-state (get-node-with-xmlns children +chat-states-ns+)))
(cond
(body
(let* ((child-nodes (dom:child-nodes body))
@ -571,6 +574,9 @@
(let ((marker-type (dom:tag-name marker))
(msgid (dom:get-attribute marker "id")))
(emit :message-marker comp :from from :to to :type marker-type :marker-id msgid :id id :stanza stanza)))
(chat-state
(let ((state-type (dom:tag-name chat-state)))
(emit :chat-state comp :from from :to to :type state-type :id id :stanza stanza)))
(t
(emit :message comp :from from :to to :id id :stanza stanza)))))
@ -707,7 +713,6 @@ Commands:
(cxml:with-element "status"
(cxml:text status))))
(defun wa-resetup-users (comp)
"Go through the list of WhatsApp users and reconnect those whose connections have dropped."
(with-component-data-lock (comp)
@ -900,6 +905,7 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678."
(update-session-data jid sessdata)
(admin-msg comp jid status)
(admin-presence comp jid status)
(whatscl::send-presence conn :available)
(format *debug-io* "~&ws-connected: ~A (as ~A)~%" jid wa-jid))))
(defun wa-handle-error-status-code (comp conn jid err)
@ -1002,6 +1008,8 @@ WhatsXMPP represents users as u440123456789 and groups as g1234-5678."
(cxml:with-element "delay"
(cxml:attribute "xmlns" +delivery-delay-ns+)
(cxml:attribute "stamp" (local-time:format-timestring nil ts)))
(cxml:with-element "active"
(cxml:attribute "xmlns" +chat-states-ns+))
(when (and group-localpart (not ,suppress-insert))
(cxml:with-element "stanza-id"
(cxml:attribute "xmlns" +unique-stanzas-ns+)
@ -1544,6 +1552,25 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
(sqlite:reset-statement insert-member-stmt)))
(handle-wa-chat-invitation comp conn jid uid localpart :noretry t))))))
(defun wa-handle-presence (comp conn jid &key for-jid type participant &allow-other-keys)
(with-wa-handler-context (comp conn jid)
(let* ((localpart (wa-jid-to-whatsxmpp-localpart for-jid))
(chat-state
(cond
((eql type :composing) "composing")
((eql type :paused) "paused")
((eql type :available) "active")
(t (return-from wa-handle-presence)))))
(unless participant ; Groups hard
(let ((from-jid (concatenate 'string
localpart
"@"
(component-name comp))))
(with-message (comp jid
:from from-jid)
(cxml:with-element chat-state
(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)
@ -1566,6 +1593,10 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
(on :status-change conn (lambda (for-jid status)
(wa-handle-status-change comp conn jid for-jid status)))
(on :presence conn (lambda (&key of type participant &allow-other-keys)
(wa-handle-presence comp conn jid
:for-jid of :type type
:participant participant)))
(on :connected conn (lambda (waj) (wa-handle-ws-connected comp conn jid waj))))
(defun handle-setup-user (comp jid)
@ -1861,7 +1892,8 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
(when conn
(loop
for localpart in (get-contact-localparts uid)
do (handle-wa-contact-presence comp conn stripped localpart))))))
do (handle-wa-contact-presence comp conn stripped localpart))
(whatscl::send-presence conn :available)))))
(t nil))))))
(defun whatsxmpp-presence-probe-handler (comp &key from to id &allow-other-keys)
@ -1908,6 +1940,34 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
:text "That user's JID isn't in a recognizable format."
:type "modify"))))))
(defun whatsxmpp-chat-state-handler (comp &key from to type &allow-other-keys)
"Handles a chat state sent to the whatsxmpp bridge."
(with-component-data-lock (comp)
(multiple-value-bind (to-hostname to-localpart)
(parse-jid to)
(declare (ignore to-hostname))
(format *debug-io* "~&chat state: ~A is ~A to ~A~%" from type to)
(let* ((stripped (strip-resource from))
(uid (get-user-id stripped))
(conn (gethash stripped (component-whatsapps comp)))
(wa-jid (whatsxmpp-localpart-to-wa-jid to-localpart))
(presence-type
(cond
((string= type "composing") :composing)
((string= type "paused") :paused)
((string= type "active") :available)
(t (return-from whatsxmpp-chat-state-handler)))))
(unless uid
(warn "Got chat state for user that isn't registered")
(return-from whatsxmpp-chat-state-handler))
(unless wa-jid
(return-from whatsxmpp-chat-state-handler))
(unless conn
(warn "Can't send chat state, since user connection is offline"))
(whatscl::send-presence conn presence-type
(unless (eql presence-type :active)
wa-jid))))))
(defun whatsxmpp-marker-handler (comp &key from to type marker-id id &allow-other-keys)
"Handles a message marker sent to the whatsxmpp bridge."
(with-component-data-lock (comp)
@ -1994,6 +2054,7 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
:muc-resource user-resource
:result result)))
(msgid (whatscl::send-simple-text-message conn wa-jid body callback)))
(whatscl::send-presence conn :available)
(insert-user-message uid id msgid)))))))))
(defun whatsxmpp-load-users (comp)
@ -2033,6 +2094,8 @@ Returns three values: avatar data (as two values), and a generalized boolean spe
(apply #'whatsxmpp-presence-unavailable-handler ret args)))
(on :presence ret (lambda (&rest args)
(apply #'whatsxmpp-presence-handler ret args)))
(on :chat-state ret (lambda (&rest args)
(apply #'whatsxmpp-chat-state-handler ret args)))
(register-whatsxmpp-handlers ret)
(whatsxmpp-load-users ret)
(setf (component-reconnect-timer ret) (trivial-timers:make-timer

Write Preview
Loading…
Cancel
Save