From 28a6303371168df5bca79054bbefc654d65e3830 Mon Sep 17 00:00:00 2001 From: eta Date: Thu, 6 Aug 2020 17:18:09 +0100 Subject: [PATCH] Add function for uploading (but not sending) media, clean up threads - 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. --- stuff.lisp | 98 ++++++++++++++++++++++++++++++++++++--------------- utils.lisp | 11 ++++++ whatsxmpp.asd | 1 + 3 files changed, 81 insertions(+), 29 deletions(-) diff --git a/stuff.lisp b/stuff.lisp index 8b5a2c3..35a2445 100644 --- a/stuff.lisp +++ b/stuff.lisp @@ -135,6 +135,51 @@ Commands: do (handle-setup-user comp user)) (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) "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)." @@ -158,35 +203,30 @@ MEDIA-TYPE is one of (:image :video :audio :document)." (lambda (slot) (destructuring-bind ((put-url . headers) get-url) slot (format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url) - (with-promise (resolve reject) - (bt:make-thread - (lambda () - (handler-case - (progn - (format *debug-io* "~&fetching whatsapp media url: ~A~%" url) - (multiple-value-bind (file-data status-code) - (drakma:http-request url) - (unless (eql status-code 200) - (format *debug-io* "~&couldn't fetch whatsapp media! status ~A, body ~A~%" status-code file-data) - (error "Downloading media failed with status ~A" status-code)) - (format *debug-io* "~&got ~A bytes, decrypting~%" (length file-data)) - (let ((sha256-expected (ironclad:digest-sequence :sha256 file-data)) - (decrypted-file (whatscl::decrypt-media-data media-key file-data media-type))) - (unless (equalp enc-sha256 sha256-expected) - (error "Encrypted SHA256 mismatch")) - (multiple-value-bind (body status-code) - (drakma:http-request put-url - :additional-headers headers - :content-length (length decrypted-file) - :content-type mime-type - :method :put - :content decrypted-file) - (unless (and (>= status-code 200) (< status-code 300)) - (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"))))))))) + (with-promise-from-thread () + (format *debug-io* "~&fetching whatsapp media url: ~A~%" url) + (multiple-value-bind (file-data status-code) + (drakma:http-request url) + (unless (eql status-code 200) + (format *debug-io* "~&couldn't fetch whatsapp media! status ~A, body ~A~%" status-code file-data) + (error "Downloading media failed with status ~A" status-code)) + (format *debug-io* "~&got ~A bytes, decrypting~%" (length file-data)) + (let ((sha256-expected (ironclad:digest-sequence :sha256 file-data)) + (decrypted-file (whatscl::decrypt-media-data media-key file-data media-type))) + (unless (equalp enc-sha256 sha256-expected) + (error "Encrypted SHA256 mismatch")) + (multiple-value-bind (body status-code) + (drakma:http-request put-url + :additional-headers headers + :content-length (length decrypted-file) + :content-type mime-type + :method :put + :content decrypted-file) + (unless (and (>= status-code 200) (< status-code 300)) + (format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body) + (error "HTTP upload failed with status ~A" status-code)) + get-url)))) + :name "whatsapp media download thread")))))))) (defun send-qrcode (comp jid text) "Send a QR code containing TEXT to JID." diff --git a/utils.lisp b/utils.lisp index 5c695a8..c576cdd 100644 --- a/utils.lisp +++ b/utils.lisp @@ -16,3 +16,14 @@ (defun child-elements (node) "Returns the child elements (excluding text nodes) of the CXML DOM node 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)))))))) diff --git a/whatsxmpp.asd b/whatsxmpp.asd index d07e209..c52fc7c 100644 --- a/whatsxmpp.asd +++ b/whatsxmpp.asd @@ -12,6 +12,7 @@ (:file "xmpp") (:file "xep-0030") (:file "xep-0363") + (:file "xep-0115") (:file "sqlite") (:file "db") (:file "stuff")))