Browse Source

Parse contacts, chats, and new incoming messages (!); keep connected with pings

- We now actually parse the contact and chat information we get sent after
  the connection handshake.
- A massive protobuf autogenerated file has been added, which takes care of
  parsing the actual WhatsApp message objects -- i.e. the actual chat messages.
  We still need to actually translate that protobuf into something more
  usable though.
- Also, we don't disconnect now, because we actually send pings.
master
eta 3 years ago
parent
commit
7c5f57f8d5
  1. 100
      api.lisp
  2. 9
      connection.lisp
  3. 13316
      message_wire.lisp
  4. 3
      packages.lisp
  5. 24
      utils.lisp
  6. 4
      whatscl.asd
  7. 110
      whatscl.lisp

100
api.lisp

@ -0,0 +1,100 @@ @@ -0,0 +1,100 @@
;;;; Higher-level API types
(in-package :whatscl)
(defclass contact ()
((jid
:accessor contact-jid
:initarg :jid
:initform (error "A contact JID must be provided")
:documentation "JID (unique address) for this contact.")
(notify
:accessor contact-notify
:initarg :notify
:initform nil
:documentation "The name the user set for themselves on WhatsApp (i.e. the ~name).")
(name
:accessor contact-name
:initarg :name
:initform nil
:documentation "A name for this contact, as specified in the user's address book."))
(:documentation "An entry in the list of the user's WhatsApp contacts."))
(defun parse-contact (contact)
"Parse the wire-formatted CONTACT into an actual `contact' object."
(make-instance 'contact
:jid (aval :jid contact)
:notify (cassoc :notify contact)
:name (cassoc :name contact)))
(defmethod print-object ((obj contact) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (jid notify name) obj
(format stream "~A~@[ (\"~~~A\")~]~@[ (\"~A\")~]" jid notify name))))
(defclass chat-entry ()
((jid
:accessor chat-jid
:initarg :jid
:initform (error "A groupchat JID must be provided")
:documentation "JID (unique address) for this chat entry.")
(subject
:accessor chat-subject
:initarg :subject
:initform nil
:documentation "If this chat is a groupchat, the subject (topic) of the groupchat.")
(last-activity
:accessor chat-last-activity
:initarg :last-activity
:initform nil
:documentation "The Unix timestamp of the last thing which happened in this chat.")
(is-spam
:accessor chat-is-spam
:initarg :is-spam
:initform nil
:documentation "Whether the chat is marked as spam.")
(is-read-only
:accessor chat-is-read-only
:initarg :is-read-only
:initform nil
:documentation "Whether the chat is read-only (you can't send to it)")
(muted-until
:accessor chat-muted-until
:initarg :muted-until
:initform nil
:documentation "The Unix timestamp of when this chat is muted until, or NIL if the chat is not muted.")
(modify-tag
:accessor chat-modify-tag
:initarg :modify-tag
:initform nil))
(:documentation "An entry in the user's list of WhatsApp chats (i.e. private messages and groupchats)."))
(defun parse-chat-entry (entry)
"Parse the wire-formatted ENTRY into an actual `chat-entry' object."
(flet ((is-true (x) (equal x "true"))
(parse-muted (x)
(let ((ts (parse-integer x)))
(unless (eql ts 0) ts))))
(make-instance 'chat-entry
:jid (aval :jid entry)
:subject (cassoc :name entry)
:last-activity (parse-integer (aval :t entry))
:is-spam (map-when #'is-true (cassoc :spam entry))
:is-read-only (map-when #'is-true (cassoc :read_only entry))
:muted-until (map-when #'parse-muted (cassoc :mute entry))
:modify-tag (cassoc :modify_tag entry))))
(defmethod print-object ((obj chat-entry) stream)
(print-unreadable-object (obj stream :type t)
(with-slots (jid subject) obj
(format stream "~A~@[ (\"~A\")~]" jid subject))))
(defun parse-pb-object (vector class length)
"Parse a protobuf object of class CLASS from the bytes stored in VECTOR."
(let ((ret (make-instance class)))
(pb:merge-from-array ret vector 0 length)
ret))
(defun parse-web-message (vector)
"Parse a protobuf chat message stored in VECTOR."
(parse-pb-object vector 'wpb:web-message-info (length vector)))

9
connection.lisp

@ -47,7 +47,14 @@ @@ -47,7 +47,14 @@
(keypair
:initarg :keypair
:initform nil
:accessor wac-keypair))
:accessor wac-keypair)
(is-connected
:initform nil
:accessor wac-is-connected)
(ts-last
:initform 0
:accessor wac-ts-last
:documentation "The timestamp, as measured by GET-INTERNAL-REAL-TIME, of the last message received from WhatsApp."))
(:documentation "Represents a WhatsApp Web connection."))
(defmacro with-wac-lock ((wac) &body body)

13316
message_wire.lisp

File diff suppressed because it is too large Load Diff

3
packages.lisp

@ -1,2 +1,5 @@ @@ -1,2 +1,5 @@
(defpackage :whatscl
(:use :cl :event-emitter :alexandria :split-sequence))
(defpackage :whatscl/protobuf
(:nicknames :wpb))

24
utils.lisp

@ -0,0 +1,24 @@ @@ -0,0 +1,24 @@
;;;; Utility functions
(in-package :whatscl)
(defmacro cassoc (key alist)
"Macro for (CDR (ASSOC KEY ALIST))."
`(cdr (assoc ,key ,alist)))
(defmacro aval (key alist)
"Retrieves the value associated with KEY from the association list ALIST, throwing an error if the value wasn't found."
(let ((val-sym (gensym))
(key-sym (gensym)))
`(let* ((,key-sym ,key)
(,val-sym (cassoc ,key-sym ,alist)))
(unless ,val-sym
(error "Malformed WhatsApp response: missing ~A" ,key-sym))
,val-sym)))
(defmacro map-when (func value)
"If VALUE is not NIL, applies FUNC to VALUE and returns the result."
(let ((val-sym (gensym)))
`(let ((,val-sym ,value))
(when ,val-sym
(funcall ,func ,val-sym)))))

4
whatscl.asd

@ -1,9 +1,11 @@ @@ -1,9 +1,11 @@
(defsystem "whatscl"
:depends-on ("websocket-driver-client" "ironclad" "cl-qrencode" "qbase64" "cl-json" "babel" "alexandria" "split-sequence" "nibbles" "flexi-streams" "bordeaux-threads")
:depends-on ("websocket-driver-client" "ironclad" "cl-qrencode" "qbase64" "cl-json" "babel" "alexandria" "split-sequence" "nibbles" "flexi-streams" "bordeaux-threads" "com.google.base" "protobuf" "trivial-timer")
:serial t
:components
((:file "packages")
(:file "utils")
(:file "crypto")
(:file "connection")
(:file "binproto")
(:file "message_wire")
(:file "whatscl")))

110
whatscl.lisp

@ -14,6 +14,10 @@ @@ -14,6 +14,10 @@
(defparameter *websocket-headers*
'(("Origin" . "https://web.whatsapp.com"))
"Headers to use when connecting to the WebSocket.")
(defparameter *ping-interval-ms* 13000
"Milliseconds to wait between sending pings.")
(defparameter *ping-deadline-ms* 3000
"Milliseconds to wait for a pong before declaring a connection timed out.")
(defvar *last-message-tag* 0)
@ -69,6 +73,26 @@ @@ -69,6 +73,26 @@
((vector (unsigned-byte 8)) (parse-binary-ws-message conn msg))
(string (parse-string-ws-message msg))))
(defun on-response-timer (conn registered-ts delay)
"Callback for the response timer: checks whether CONN has had any new messages since REGISTERED-TS, and, if not, disconnects."
(declare (ignore delay))
(with-wac-lock (conn)
(when (> registered-ts (wac-ts-last conn))
(emit :ping-timeout conn)
(wsd:close-connection (wac-ws conn)))))
(defun on-ping-timer (conn)
"Callback for the periodic ping timer."
(with-wac-lock (conn)
(when (wac-is-connected conn)
(flet ((call-response-timer (rts dly) (on-response-timer conn rts dly))
(call-ping-timer (rts dly)
(declare (ignore rts dly))
(on-ping-timer conn)))
(wsd:send-text (wac-ws conn) "?,,")
(trivial-timer:register-timer-call *ping-deadline-ms* #'call-response-timer)
(trivial-timer:register-timer-call *ping-interval-ms* #'call-ping-timer)))))
(defun send-ws-message (conn message &optional callback)
"Send a message through the websocket of connection CONN. MESSAGE can be a string, byte vector, or other JSON-encodable object (and the appropriate type of message will be sent, depending on its type).
CALLBACK, if provided, specifies a function to run with the reply sent by WhatsApp, if one is received."
@ -88,13 +112,6 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA @@ -88,13 +112,6 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
(setf (gethash tag outgoing) callback))
tag))))
(defmacro aval (key alist)
"Retrieves the value associated with KEY from the association list ALIST, throwing an error if the value wasn't found."
`(let ((val (cdr (assoc ,key ,alist))))
(unless val
(error "Malformed WhatsApp response: missing ~A" ,key))
val))
(defun cb-check-status (conn details &optional (reason "Generic operation"))
"Verifies that the included DETAILS object contains a :status key with value 200. If not, throws an error."
(declare (ignore conn))
@ -160,14 +177,52 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA @@ -160,14 +177,52 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
(format t "Connected to WhatsApp as ~A.~%" jid)
(emit :connected conn jid)))
(defun on-server-binary-message (conn msg)
"Handles a binary message from the server that isn't a reply to something we've sent."
)
(defun on-contacts-payload (conn payload)
"Handles a wire-format PAYLOAD of contacts information for CONN."
(let ((contacts nil))
(loop
for entry in payload
when (eql (car entry) :user)
do (setf contacts (cons (parse-contact (second entry)) contacts)))
(format t "Got contacts: ~A~%" contacts)
(emit :contacts conn contacts)))
(defun on-chats-payload (conn payload)
"Handles a wire-format PAYLOAD of chats information for CONN."
(let ((chats nil))
(loop
for entry in payload
when (eql (car entry) :chat)
do (setf chats (cons (parse-chat-entry (second entry)) chats)))
(format t "Got chats: ~A~%" chats)
(emit :chats conn chats)))
(defun on-server-json-message (conn msg)
"Handles a JSON message from the server that isn't a reply to something we've sent."
(defun on-server-action (conn act)
"Handles a 'server action' message ACT."
(let ((type (first act)))
(cond
((eql type :message)
(progn
(let ((msg (parse-web-message (third act))))
(format t "Got a message: ~A~%" msg)
(emit :message conn msg))))
(t (warn "Unknown server action: ~A" type)))))
(defun on-server-message (conn msg)
"Handles a message from the server that isn't a reply to something we've sent."
(destructuring-bind (opcode &rest payload) msg
(cond
((equal opcode :response)
(progn
(let ((type (aval :type (first payload))))
(cond
((equal type "contacts") (on-contacts-payload conn (second payload)))
((equal type "chat") (on-chats-payload conn (second payload)))
(t (warn "Invalid 'response' type ~A" type))))))
((equal opcode :action)
(loop
for node in (second payload)
do (on-server-action conn node)))
((equal opcode "Conn") (on-connection-ack conn (car payload)))
((equal opcode "Cmd")
(progn
@ -182,27 +237,26 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA @@ -182,27 +237,26 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
(with-wac-lock (conn)
(format t "WebSocket connected.~%")
(emit :ws-connected conn)
(send-login-message conn)))
(setf (wac-is-connected conn) t)
(send-login-message conn)
(on-ping-timer conn)))
(defun on-ws-message (conn msg)
"Handles an incoming message (binary or JSON) from the server."
(with-wac-lock (conn)
(with-accessors ((outgoing wac-outgoing)) conn
(with-accessors ((outgoing wac-outgoing) (tsl wac-ts-last)) conn
(setf tsl (get-internal-real-time))
(let ((msg (parse-ws-message conn msg)))
(emit :raw-message conn msg)
(if (eql msg :pong)
(progn
(format t "Got a pong~%"))
(destructuring-bind (tag &rest payload) msg
(format t "--> message (tag ~A): ~S~%" tag payload)
(let ((callback (gethash tag outgoing)))
(if callback
(progn
(remhash tag outgoing)
(funcall callback conn payload))
(etypecase payload
((vector (unsigned-byte 8)) (on-server-binary-message conn payload))
(list (on-server-json-message conn payload)))))))))))
(unless (eql msg :pong)
(destructuring-bind (tag &rest payload) msg
(format t "--> message (tag ~A): ~S~%" tag payload)
(let ((callback (gethash tag outgoing)))
(if callback
(progn
(remhash tag outgoing)
(funcall callback conn payload))
(on-server-message conn payload)))))))))
(defun on-ws-error (conn err)
(format t "WebSocket error: ~A~%" err)
@ -212,6 +266,7 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA @@ -212,6 +266,7 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
(defun on-ws-close (conn &key reason code)
(format t "WebSocket closed: ~A (~A)~%" reason code)
(with-wac-lock (conn)
(setf (wac-is-connected conn) nil)
(emit :ws-close conn reason code)))
(defun make-connection (&optional old-session &rest login-options)
@ -225,6 +280,7 @@ If OLD-SESSION is provided, attempts to resume an old connection." @@ -225,6 +280,7 @@ If OLD-SESSION is provided, attempts to resume an old connection."
:login-information login-options
:client-id client-id
:keypair (multiple-value-list (crypto:generate-key-pair :curve25519)))))
(trivial-timer:initialize-timer)
(when old-session
(setf (wac-session conn) old-session))
(on :open ws (lambda (&rest args) (apply #'on-ws-open conn args)))

Loading…
Cancel
Save