a3x/whatsxmpp
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add function for uploading (but not sending) media, clean up threads

Browse source 
- The new PUT-WHATSAPP-MEDIA-FILE can encrypt and upload a blob of file data to
  WhatsApp, and returns everything we'd need to make a protobuf message out of
  that.
- However, important functionality is still absent: whatscl needs to gain some
  support for sending protobuf messages for file uploads, and we'd also need to
  integrate with some image/video libraries in order to do related processing
  tasks.
  - For example, uploading an image requires producing a JPEG thumbnail for it,
    as well as figuring out its size.
  - Uploading audio would require conversion to Opus.
  - Maybe we could attempt to integrate with ffmpeg or something? This is likely
    to get tricky.
This commit is contained in:
eta 2020-08-06 17:18:09 +01:00
parent efbda1a002
commit 28a6303371
3 changed files with 81 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
stuff.lisp
View file

@ -135,6 +135,51 @@ Commands:
do (handle-setup-user comp user)) do (handle-setup-user comp user))
(trivial-timers:schedule-timer (component-reconnect-timer comp) *reconnect-every-secs*)))) (trivial-timers:schedule-timer (component-reconnect-timer comp) *reconnect-every-secs*))))
(defun put-whatsapp-media-file (conn file-data media-type)
"Encrypts and uploads FILE-DATA (an octet vector), a WhatsApp media file of type MEDIA-TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT) to WhatsApp, returning a promise that resolves with (URL MEDIA-KEY FILE-SHA256 FILE-ENC-SHA256 ENCRYPTED-LENGTH) when done."
(check-type file-data (simple-array (unsigned-byte 8)))
(check-type media-type (member :image :video :audio :document))
(attach
(with-promise (resolve reject)
(format *debug-io* "~&requesting WhatsApp upload slot~%")
(whatscl::start-media-upload
conn
(lambda (conn auth-token ttl hosts)
(declare (ignore conn))
(if auth-token
(resolve auth-token ttl hosts)
(reject (make-condition 'error
"WhatsApp upload slot request rejected"))))))
(lambda (auth-token ttl hosts)
(declare (ignore ttl))
(with-promise-from-thread ()
(multiple-value-bind (encrypted-blob media-key file-sha256 file-enc-sha256)
(whatscl::encrypt-media-data file-data media-type)
(let* ((token (qbase64:encode-bytes file-enc-sha256 :scheme :uri))
(url-to-use (format nil "https://~A/mms/~(~A~)/~A"
(first hosts) (symbol-name media-type) token))
(headers `(("Origin" . "https://web.whatsapp.com")
("Referer" . "https://web.whatsapp.com")))
(qs-params `(("auth" . ,auth-token) ("token" . ,token))))
(format *debug-io* "~&uploading encrypted media file (length ~A) to ~A"
(length encrypted-blob) url-to-use)
(multiple-value-bind (response status-code)
(drakma:http-request url-to-use
:method :post
:content encrypted-blob
:content-type "application/octet-stream"
:parameters qs-params
:additional-headers headers)
(let ((response (babel:octets-to-string response)))
(unless (eql status-code 200)
(format *debug-io* "~&whatsapp upload failed! status ~A / ~A" status-code response)
(error "Downloading media failed with status ~A / ~A" status-code response))
(let* ((json-response (cl-json:decode-json-from-string response))
(url (or (whatscl::cassoc :url json-response)
(error "No :URL field in upload response ~A" json-response))))
(format *debug-io* "~&got whatsapp uploaded media url ~A~%" url)
(values url media-key file-sha256 file-enc-sha256 (length encrypted-blob)))))))))))
(defun upload-whatsapp-media-file (comp file-info media-type &optional filename) (defun upload-whatsapp-media-file (comp file-info media-type &optional filename)
"Downloads the WhatsApp media file specified by FILE-INFO, uploads it via COMP, and returns a promise which resolves to the URL of the uploaded media. "Downloads the WhatsApp media file specified by FILE-INFO, uploads it via COMP, and returns a promise which resolves to the URL of the uploaded media.
MEDIA-TYPE is one of (:image :video :audio :document)." MEDIA-TYPE is one of (:image :video :audio :document)."
@ -158,35 +203,30 @@ MEDIA-TYPE is one of (:image :video :audio :document)."
(lambda (slot) (lambda (slot)
(destructuring-bind ((put-url . headers) get-url) slot (destructuring-bind ((put-url . headers) get-url) slot
(format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url) (format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
(with-promise (resolve reject) (with-promise-from-thread ()
(bt:make-thread (format *debug-io* "~&fetching whatsapp media url: ~A~%" url)
(lambda () (multiple-value-bind (file-data status-code)
(handler-case (drakma:http-request url)
(progn (unless (eql status-code 200)
(format *debug-io* "~&fetching whatsapp media url: ~A~%" url) (format *debug-io* "~&couldn't fetch whatsapp media! status ~A, body ~A~%" status-code file-data)
(multiple-value-bind (file-data status-code) (error "Downloading media failed with status ~A" status-code))
(drakma:http-request url) (format *debug-io* "~&got ~A bytes, decrypting~%" (length file-data))
(unless (eql status-code 200) (let ((sha256-expected (ironclad:digest-sequence :sha256 file-data))
(format *debug-io* "~&couldn't fetch whatsapp media! status ~A, body ~A~%" status-code file-data) (decrypted-file (whatscl::decrypt-media-data media-key file-data media-type)))
(error "Downloading media failed with status ~A" status-code)) (unless (equalp enc-sha256 sha256-expected)
(format *debug-io* "~&got ~A bytes, decrypting~%" (length file-data)) (error "Encrypted SHA256 mismatch"))
(let ((sha256-expected (ironclad:digest-sequence :sha256 file-data)) (multiple-value-bind (body status-code)
(decrypted-file (whatscl::decrypt-media-data media-key file-data media-type))) (drakma:http-request put-url
(unless (equalp enc-sha256 sha256-expected) :additional-headers headers
(error "Encrypted SHA256 mismatch")) :content-length (length decrypted-file)
(multiple-value-bind (body status-code) :content-type mime-type
(drakma:http-request put-url :method :put
:additional-headers headers :content decrypted-file)
:content-length (length decrypted-file) (unless (and (>= status-code 200) (< status-code 300))
:content-type mime-type (format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
:method :put (error "HTTP upload failed with status ~A" status-code))
:content decrypted-file) get-url))))
(unless (and (>= status-code 200) (< status-code 300)) :name "whatsapp media download thread"))))))))
(format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
(error "HTTP upload failed with status ~A" status-code))
(resolve get-url)))))
(error (e) (reject e))))
:name "whatsapp media download thread")))))))))
(defun send-qrcode (comp jid text) (defun send-qrcode (comp jid text)
"Send a QR code containing TEXT to JID." "Send a QR code containing TEXT to JID."

11
utils.lisp
View file

@ -16,3 +16,14 @@
(defun child-elements (node) (defun child-elements (node)
"Returns the child elements (excluding text nodes) of the CXML DOM node NODE." "Returns the child elements (excluding text nodes) of the CXML DOM node NODE."
(remove-if-not #'dom:element-p (dom:child-nodes node))) (remove-if-not #'dom:element-p (dom:child-nodes node)))
(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))))))))

1
whatsxmpp.asd
View file

@ -12,6 +12,7 @@
(:file "xmpp") (:file "xmpp")
(:file "xep-0030") (:file "xep-0030")
(:file "xep-0363") (:file "xep-0363")
(:file "xep-0115")
(:file "sqlite") (:file "sqlite")
(:file "db") (:file "db")
(:file "stuff"))) (:file "stuff")))