From a02c0fdc7933f84b42ad8e338812a6ea2f4e05e1 Mon Sep 17 00:00:00 2001 From: eta Date: Sun, 2 Aug 2020 12:59:59 +0100 Subject: [PATCH] Handle chats being modified; allow the user to refresh all groups - We now handle the :chat-modified event from whatscl, and re-fetch group metadata when we receive it. - Of course, this doesn't actually help for resources which are in the MUC at update time; they'll need to reconnect until we have code to handle message stubs properly. - Chat metadata reception now generates a message to the user, both for ease of debugging, and also to let them know that something happened to a groupchat they're in which they would otherwise not be aware of at all. (A handy link is also provided, if you missed the invite and want to join a MUC you're not in.) - The new `refresh-chats` admin command forces a refresh of all group metadata in one big go. (Also, the help text now displays the current version.) --- db.lisp | 2 +- stuff.lisp | 53 ++++++++++++++++++++++++++++++++++++++++------------- 2 files changed, 41 insertions(+), 14 deletions(-) diff --git a/db.lisp b/db.lisp index c8615f7..b4eb944 100644 --- a/db.lisp +++ b/db.lisp @@ -94,7 +94,7 @@ (defun insert-user-chat (uid wa-id) "Inserts a user chat with localpart WA-ID into the database for the user with UID." (with-prepared-statements - ((insert-stmt "INSERT INTO user_chats (user_id, wa_jid) VALUES (?, ?)")) + ((insert-stmt "INSERT INTO user_chats (user_id, wa_jid) VALUES (?, ?) ON CONFLICT DO NOTHING")) (bind-parameters insert-stmt uid wa-id) (sqlite:step-statement insert-stmt))) diff --git a/stuff.lisp b/stuff.lisp index 860ef14..ad562b7 100644 --- a/stuff.lisp +++ b/stuff.lisp @@ -89,14 +89,17 @@ (concatenate 'string "admin@" (component-name comp) "/adminbot")) (defparameter *admin-help-text* - "This is a very beta WhatsApp to XMPP bridge! + (format nil + "** whatsxmpp, version ~A, a theta.eu.org project ** Commands: - register: set up the bridge - connect: manually connect to WhatsApp - stop: disconnect from WhatsApp, and disable automatic reconnections - status: get your current status - getroster: trigger an XEP-0144 roster item exchange (in some clients, this'll pop up a window asking to add contacts to your roster) -- help: view this help text") +- help: view this help text +- refresh-chats: force the bridge to update member lists + subject for all of your group chats" + +version+)) (defparameter *reconnect-every-secs* 5 "Interval between calls to WA-RESETUP-USERS.") @@ -634,6 +637,13 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (format *debug-io* "~&got contact ~A for ~A~%" contact jid) (add-wa-contact comp conn jid contact))) +(defun request-wa-chat-metadata (comp conn jid wx-localpart) + "Request chat metadata for WX-LOCALPART (a MUC localpart) for the user with JID." + (format *debug-io* "~&requesting chat metadata for ~A from ~A~%" wx-localpart jid) + (whatscl::get-group-metadata conn (whatsxmpp-localpart-to-wa-jid wx-localpart) + (lambda (conn meta) + (wa-handle-group-metadata comp conn jid wx-localpart meta)))) + (defun handle-wa-chat-invitation (comp conn jid uid localpart &key noretry) "Checks to see whether the group chat LOCALPART has any metadata; if not, requests some. If it does, and the user hasn't been invited to that group chat yet, send them an invitation." (unless (uiop:string-prefix-p "g" localpart) @@ -661,12 +671,7 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (bind-parameters update-stmt "invited" chat-id) (sqlite:step-statement update-stmt)) (unless noretry - (format *debug-io* "~&requesting chat metadata for ~A from ~A~%" localpart jid) - (whatscl::get-group-metadata conn (whatsxmpp-localpart-to-wa-jid localpart) - (lambda (conn meta) - (wa-handle-group-metadata comp conn jid localpart meta))))))))) - - + (request-wa-chat-metadata comp conn jid localpart))))))) (defun add-wa-chat (comp conn jid ct-jid) "Adds the JID CT-JID to the list of the user's groupchats, if it is a groupchat." @@ -827,9 +832,13 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (defun wa-handle-group-metadata (comp conn jid localpart data) (with-wa-handler-context (comp conn jid) (let* ((uid (get-user-id jid)) - (cid (get-user-chat-id uid localpart))) + (cid (get-user-chat-id uid localpart)) + (subject (whatscl::cassoc :subject data))) + (unless cid + (setf cid (insert-user-chat uid localpart))) (format *debug-io* "~&got group metadata for ~A from ~A~%" localpart jid) - (unless (whatscl::cassoc :subject data) + (unless subject + (admin-msg comp jid (format nil "Warning: Failed to update group ~A: received ~A~%This warning usually appears when trying to get information for a group you're no longer in, and can be safely ignored." localpart data)) (warn "Received incomplete group metadata for ~A from ~A: ~A" localpart jid data) (return-from wa-handle-group-metadata)) (when cid @@ -838,8 +847,7 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (delete-members-stmt "DELETE FROM user_chat_members WHERE chat_id = ?") (insert-member-stmt "INSERT INTO user_chat_members (chat_id, wa_jid, resource, affiliation) VALUES (?, ?, ?, ?)")) (with-transaction - (let ((subject (whatscl::cassoc :subject data))) - (bind-parameters update-subject-stmt subject cid)) + (bind-parameters update-subject-stmt subject cid) (sqlite:step-statement update-subject-stmt) (sqlite:step-statement delete-members-stmt) (loop @@ -859,6 +867,7 @@ Returns three values: avatar data (as two values), and a generalized boolean spe "member")))) (sqlite:step-statement insert-member-stmt) (sqlite:reset-statement insert-member-stmt))) + (admin-msg comp jid (format nil "New or updated WhatsApp group chat: \"~A\" (xmpp:~A@~A?join)" subject localpart (component-name comp))) (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) @@ -880,12 +889,19 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (cxml:with-element chat-state (cxml:attribute "xmlns" +chat-states-ns+)))))))) +(defun wa-handle-chat-modified (comp conn jid chat-jid) + (with-wa-handler-context (comp conn jid) + (let ((wx-localpart (wa-jid-to-whatsxmpp-localpart chat-jid))) + (format *debug-io* "~&chat-modified: ~A for ~A~&" wx-localpart jid) + (request-wa-chat-metadata comp conn jid wx-localpart)))) + (defun bind-wa-handlers (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 :chat-modified conn (lambda (k) (wa-handle-chat-modified 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))) @@ -1021,6 +1037,16 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (reply "WhatsApp connections disabled.")) (when conn (whatscl::close-connection conn)))) + ((equal body "refresh-chats") + (let ((conn (gethash stripped (component-whatsapps comp)))) + (if conn + (let ((chats (get-user-groupchats uid))) + (reply (format nil "Refreshing metadata for ~A groupchats...~%When the metadata refresh is complete, you'll need to rejoin all of your groupchats (most easily accomplished by reconnecting yourself to XMPP)." + (length chats))) + (loop + for (localpart . subject) in chats + do (request-wa-chat-metadata comp conn stripped localpart))) + (reply "You're not connected to WhatsApp.")))) (t (reply "Unknown command. Try `help` for a list of supported commands.")))))) @@ -1272,7 +1298,8 @@ Returns three values: avatar data (as two values), and a generalized boolean spe (unless wa-jid (return-from whatsxmpp-chat-state-handler)) (unless conn - (warn "Can't send chat state, since user connection is offline")) + (warn "Can't send chat state, since user connection is offline") + (return-from whatsxmpp-chat-state-handler)) (whatscl::send-presence conn presence-type (unless (eql presence-type :active) wa-jid))))))