e x t r e m e d e s i g n t h i n k i n g f a i l
- Fixed a bug in the media handling code that made everything download as "whatsapp media download thread".
This commit is contained in:
eta
parent
db402312ca
commit
8944391580
144
media.lisp
Normal file
144
media.lisp
Normal file
|
|
@ -0,0 +1,144 @@
|
||||||
|
;;;; Handling media uploading / downloading
|
||||||
|
|
||||||
|
(in-package :whatsxmpp)
|
||||||
|
|
||||||
|
(defun put-whatsapp-media-file (conn file-data media-type mime-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 a WHATSCL:FILE-INFO 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)
|
||||||
|
(make-instance 'whatscl::file-info
|
||||||
|
:media-key media-key
|
||||||
|
:url url
|
||||||
|
:sha256 file-sha256
|
||||||
|
:enc-sha256 file-enc-sha256
|
||||||
|
:length-bytes (length encrypted-blob)
|
||||||
|
:mime-type mime-type))))))))))
|
||||||
|
|
||||||
|
(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)."
|
||||||
|
(declare (type (member :image :video :audio :document) media-type))
|
||||||
|
(with-component-data-lock (comp)
|
||||||
|
(with-accessors ((url whatscl::file-info-url)
|
||||||
|
(mime-type whatscl::file-info-mime-type)
|
||||||
|
(sha256 whatscl::file-info-sha256)
|
||||||
|
(enc-sha256 whatscl::file-info-enc-sha256)
|
||||||
|
(length-bytes whatscl::file-info-length-bytes)
|
||||||
|
(media-key whatscl::file-info-media-key))
|
||||||
|
file-info
|
||||||
|
(let* ((mime-type (first (uiop:split-string mime-type :separator ";")))
|
||||||
|
(extension (or (mimes:mime-file-type mime-type) "what"))
|
||||||
|
(filename (or filename
|
||||||
|
(concatenate 'string (octets-to-lowercase-hex sha256) "." extension))))
|
||||||
|
(format *debug-io* "~&requesting an upload slot for whatsapp media (type ~A, length ~A): ~A~%" mime-type length-bytes filename)
|
||||||
|
(attach
|
||||||
|
(request-http-upload-slot comp (component-upload-component-name comp)
|
||||||
|
filename length-bytes mime-type)
|
||||||
|
(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-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)))))))))))
|
||||||
|
|
||||||
|
(defun send-qrcode (comp jid text)
|
||||||
|
"Send a QR code containing TEXT to JID."
|
||||||
|
(with-component-data-lock (comp)
|
||||||
|
(uiop:with-temporary-file (:stream stream
|
||||||
|
:pathname path
|
||||||
|
:keep t) ; Needed because async
|
||||||
|
(format *debug-io* "~&using path ~A~%" path)
|
||||||
|
(cl-qrencode:encode-png-stream text stream)
|
||||||
|
(force-output stream) ; otherwise the QR codes get chopped off?
|
||||||
|
(catcher
|
||||||
|
(let ((content-length (file-length stream)))
|
||||||
|
(attach
|
||||||
|
(request-http-upload-slot comp (component-upload-component-name comp)
|
||||||
|
"qrcode.png"
|
||||||
|
(file-length stream)
|
||||||
|
"image/png")
|
||||||
|
(lambda (slot)
|
||||||
|
(destructuring-bind ((put-url . headers) get-url) slot
|
||||||
|
(format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
|
||||||
|
(multiple-value-bind (body status-code)
|
||||||
|
(drakma:http-request put-url
|
||||||
|
:additional-headers headers
|
||||||
|
:content-type "image/png"
|
||||||
|
:content-length content-length
|
||||||
|
:method :put
|
||||||
|
:content path)
|
||||||
|
(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))
|
||||||
|
(with-component-data-lock (comp)
|
||||||
|
(let ((ajid (admin-jid comp)))
|
||||||
|
(admin-msg comp jid "WhatsApp Web registration: Scan the following QR code with your device! (Menu -> WhatsApp Web)")
|
||||||
|
(with-message (comp jid :from ajid)
|
||||||
|
(cxml:with-element "body"
|
||||||
|
(cxml:text get-url))
|
||||||
|
(cxml:with-element "x"
|
||||||
|
(cxml:attribute "xmlns" +oob-ns+)
|
||||||
|
(cxml:with-element "url"
|
||||||
|
(cxml:text get-url))))
|
||||||
|
(admin-msg comp jid "(Code expired? Be faster next time. Get a new one with `connect`.)"))))))))
|
||||||
|
(t (e)
|
||||||
|
(admin-msg comp jid (format nil "Failed to upload QR code!~%Report the following error to the bridge admin: `~A`" e)))))))
|
||||||
136
stuff.lisp
136
stuff.lisp
|
|
@ -135,142 +135,6 @@ 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)
|
|
||||||
"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)."
|
|
||||||
(declare (type (member :image :video :audio :document) media-type))
|
|
||||||
(with-component-data-lock (comp)
|
|
||||||
(with-accessors ((url whatscl::file-info-url)
|
|
||||||
(mime-type whatscl::file-info-mime-type)
|
|
||||||
(sha256 whatscl::file-info-sha256)
|
|
||||||
(enc-sha256 whatscl::file-info-enc-sha256)
|
|
||||||
(length-bytes whatscl::file-info-length-bytes)
|
|
||||||
(media-key whatscl::file-info-media-key))
|
|
||||||
file-info
|
|
||||||
(let* ((mime-type (first (uiop:split-string mime-type :separator ";")))
|
|
||||||
(extension (or (mimes:mime-file-type mime-type) "what"))
|
|
||||||
(filename (or filename
|
|
||||||
(concatenate 'string (octets-to-lowercase-hex sha256) "." extension))))
|
|
||||||
(format *debug-io* "~&requesting an upload slot for whatsapp media (type ~A, length ~A): ~A~%" mime-type length-bytes filename)
|
|
||||||
(attach
|
|
||||||
(request-http-upload-slot comp (component-upload-component-name comp)
|
|
||||||
filename length-bytes mime-type)
|
|
||||||
(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-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."
|
|
||||||
(with-component-data-lock (comp)
|
|
||||||
(uiop:with-temporary-file (:stream stream
|
|
||||||
:pathname path
|
|
||||||
:keep t) ; Needed because async
|
|
||||||
(format *debug-io* "~&using path ~A~%" path)
|
|
||||||
(cl-qrencode:encode-png-stream text stream)
|
|
||||||
(force-output stream) ; otherwise the QR codes get chopped off?
|
|
||||||
(catcher
|
|
||||||
(let ((content-length (file-length stream)))
|
|
||||||
(attach
|
|
||||||
(request-http-upload-slot comp (component-upload-component-name comp)
|
|
||||||
"qrcode.png"
|
|
||||||
(file-length stream)
|
|
||||||
"image/png")
|
|
||||||
(lambda (slot)
|
|
||||||
(destructuring-bind ((put-url . headers) get-url) slot
|
|
||||||
(format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
|
|
||||||
(multiple-value-bind (body status-code)
|
|
||||||
(drakma:http-request put-url
|
|
||||||
:additional-headers headers
|
|
||||||
:content-type "image/png"
|
|
||||||
:content-length content-length
|
|
||||||
:method :put
|
|
||||||
:content path)
|
|
||||||
(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))
|
|
||||||
(with-component-data-lock (comp)
|
|
||||||
(let ((ajid (admin-jid comp)))
|
|
||||||
(admin-msg comp jid "WhatsApp Web registration: Scan the following QR code with your device! (Menu -> WhatsApp Web)")
|
|
||||||
(with-message (comp jid :from ajid)
|
|
||||||
(cxml:with-element "body"
|
|
||||||
(cxml:text get-url))
|
|
||||||
(cxml:with-element "x"
|
|
||||||
(cxml:attribute "xmlns" +oob-ns+)
|
|
||||||
(cxml:with-element "url"
|
|
||||||
(cxml:text get-url))))
|
|
||||||
(admin-msg comp jid "(Code expired? Be faster next time. Get a new one with `connect`.)"))))))))
|
|
||||||
(t (e)
|
|
||||||
(admin-msg comp jid (format nil "Failed to upload QR code!~%Report the following error to the bridge admin: `~A`" e)))))))
|
|
||||||
|
|
||||||
(defparameter *user-jid-scanner*
|
(defparameter *user-jid-scanner*
|
||||||
(cl-ppcre:create-scanner "u([0-9]+)"))
|
(cl-ppcre:create-scanner "u([0-9]+)"))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -15,4 +15,5 @@
|
||||||
(:file "xep-0115")
|
(:file "xep-0115")
|
||||||
(:file "sqlite")
|
(:file "sqlite")
|
||||||
(:file "db")
|
(:file "db")
|
||||||
|
(:file "media")
|
||||||
(:file "stuff")))
|
(:file "stuff")))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue