A WhatsApp (Web) transport for XMPP.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

198 lines
12KB

  1. ;;;; Handling media uploading / downloading
  2. (in-package :whatsxmpp)
  3. (defun squonch-image-to-jpeg-thumbnail (opticl-image)
  4. "Resize the provided OPTICL-IMAGE to a small 640x480 thumbnail and return an octet vector of JPEG data for this thumbnail."
  5. (check-type opticl-image opticl:image)
  6. (let* ((image-out-stream (flexi-streams:make-in-memory-output-stream))
  7. (resized-image (opticl:resize-image opticl-image 480 640))
  8. (useless (opticl:write-jpeg-stream image-out-stream resized-image)) ; squonch
  9. (image-thumbnail (flexi-streams:get-output-stream-sequence image-out-stream)))
  10. (declare (ignore useless))
  11. (concatenate '(vector (unsigned-byte 8)) image-thumbnail)))
  12. (defun maybe-upload-whatsapp-media (conn media-url)
  13. "If the media at MEDIA-URL can be sent natively as a WhatsApp upload, download it and re-host it on WhatsApp.
  14. Returns a promise that resolves with either a STRING (if the media could not be rehosted or is ineligible) or WHATSCL:MESSAGE-CONTENTS-IMAGE (if the media pointed to is an image and it's been successfully re-uploaded)."
  15. (check-type media-url string)
  16. (let ((opticl-function (opticl::get-image-stream-reader (pathname-type media-url))))
  17. (if opticl-function
  18. (attach
  19. (download-remote-media media-url)
  20. (lambda (media-data)
  21. (let* ((image-stream (flexi-streams:make-in-memory-input-stream media-data))
  22. (image-mime (or (trivial-mimes:mime-lookup media-url)
  23. (error "Couldn't guess image MIME type for ~A" media-url)))
  24. (parsed-image (funcall opticl-function image-stream))
  25. (squonched-image (squonch-image-to-jpeg-thumbnail parsed-image)))
  26. (opticl:with-image-bounds (image-y image-x) parsed-image
  27. (attach
  28. (put-whatsapp-media-file conn media-data :image image-mime)
  29. (lambda (file-info)
  30. (make-instance 'whatscl::message-contents-image
  31. :file-info file-info
  32. :width-px image-x
  33. :height-px image-y
  34. :jpeg-thumbnail squonched-image)))))))
  35. (promisify media-url))))
  36. (defun download-remote-media (media-url)
  37. "Returns a promise that downloads the remote MEDIA-URL and resolves with an octet vector of the downloaded data."
  38. ;; FIXME FIXME FIXME: this function is a trivial DoS vector, if you provide an infinite file like time.gif,
  39. ;; or a file that's like 1GB.
  40. (check-type media-url string)
  41. (with-promise-from-thread ()
  42. (format *debug-io* "~&downloading remote media: ~A~%" media-url)
  43. (multiple-value-bind (response status-code)
  44. (drakma:http-request media-url
  45. :force-binary t)
  46. (unless (eql status-code 200)
  47. (format *error-output* "~&downloading failed! status ~A~%" status-code)
  48. (error "Remote media download failed with status code ~A~~%%" status-code))
  49. (check-type response (simple-array (unsigned-byte 8)))
  50. (format *debug-io* "~&downloaded ~A (length: ~A)~%" media-url (length response))
  51. response)))
  52. (defun put-whatsapp-media-file (conn file-data media-type mime-type)
  53. "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."
  54. (check-type file-data (simple-array (unsigned-byte 8)))
  55. (check-type media-type (member :image :video :audio :document))
  56. (attach
  57. (with-promise (resolve reject)
  58. (format *debug-io* "~&requesting WhatsApp upload slot~%")
  59. (whatscl::start-media-upload
  60. conn
  61. (lambda (conn auth-token ttl hosts)
  62. (declare (ignore conn))
  63. (if auth-token
  64. (resolve auth-token ttl hosts)
  65. (reject (make-condition 'error
  66. "WhatsApp upload slot request rejected"))))))
  67. (lambda (auth-token ttl hosts)
  68. (declare (ignore ttl))
  69. (with-promise-from-thread ()
  70. (multiple-value-bind (encrypted-blob media-key file-sha256 file-enc-sha256)
  71. (whatscl::encrypt-media-data file-data media-type)
  72. (let* ((token (qbase64:encode-bytes file-enc-sha256 :scheme :uri))
  73. (url-to-use (format nil "https://~A/mms/~(~A~)/~A"
  74. (first hosts) (symbol-name media-type) token))
  75. (headers `(("Origin" . "https://web.whatsapp.com")
  76. ("Referer" . "https://web.whatsapp.com")))
  77. (qs-params `(("auth" . ,auth-token) ("token" . ,token))))
  78. (format *debug-io* "~&uploading encrypted media file (length ~A) to ~A"
  79. (length encrypted-blob) url-to-use)
  80. (multiple-value-bind (response status-code)
  81. (drakma:http-request url-to-use
  82. :method :post
  83. :content encrypted-blob
  84. :content-type "application/octet-stream"
  85. :parameters qs-params
  86. :additional-headers headers)
  87. (let ((response (babel:octets-to-string response)))
  88. (unless (eql status-code 200)
  89. (format *debug-io* "~&whatsapp upload failed! status ~A / ~A" status-code response)
  90. (error "Downloading media failed with status ~A / ~A" status-code response))
  91. (let* ((json-response (cl-json:decode-json-from-string response))
  92. (url (or (whatscl::cassoc :url json-response)
  93. (error "No :URL field in upload response ~A" json-response))))
  94. (format *debug-io* "~&got whatsapp uploaded media url ~A~%" url)
  95. (make-instance 'whatscl::file-info
  96. :media-key media-key
  97. :url (pb:string-field url)
  98. :sha256 file-sha256
  99. :enc-sha256 file-enc-sha256
  100. :length-bytes (length encrypted-blob)
  101. :mime-type (pb:string-field mime-type)))))))))))
  102. (defun upload-whatsapp-media-file (comp file-info media-type &optional filename)
  103. "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.
  104. MEDIA-TYPE is one of (:image :video :audio :document)."
  105. (declare (type (member :image :video :audio :document) media-type))
  106. (with-component-data-lock (comp)
  107. (with-accessors ((url whatscl::file-info-url)
  108. (mime-type whatscl::file-info-mime-type)
  109. (sha256 whatscl::file-info-sha256)
  110. (enc-sha256 whatscl::file-info-enc-sha256)
  111. (length-bytes whatscl::file-info-length-bytes)
  112. (media-key whatscl::file-info-media-key))
  113. file-info
  114. (let* ((mime-type (first (uiop:split-string mime-type :separator ";")))
  115. (extension (or (mimes:mime-file-type mime-type) "what"))
  116. (filename (or filename
  117. (concatenate 'string (octets-to-lowercase-hex sha256) "." extension))))
  118. (format *debug-io* "~&requesting an upload slot for whatsapp media (type ~A, length ~A): ~A~%" mime-type length-bytes filename)
  119. (attach
  120. (request-http-upload-slot comp (component-upload-component-name comp)
  121. filename length-bytes mime-type)
  122. (lambda (slot)
  123. (destructuring-bind ((put-url . headers) get-url) slot
  124. (format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
  125. (with-promise-from-thread ()
  126. (format *debug-io* "~&fetching whatsapp media url: ~A~%" url)
  127. (multiple-value-bind (file-data status-code)
  128. (drakma:http-request url)
  129. (unless (eql status-code 200)
  130. (format *debug-io* "~&couldn't fetch whatsapp media! status ~A, body ~A~%" status-code file-data)
  131. (error "Downloading media failed with status ~A" status-code))
  132. (format *debug-io* "~&got ~A bytes, decrypting~%" (length file-data))
  133. (let ((sha256-expected (ironclad:digest-sequence :sha256 file-data))
  134. (decrypted-file (whatscl::decrypt-media-data media-key file-data media-type)))
  135. (unless (equalp enc-sha256 sha256-expected)
  136. (error "Encrypted SHA256 mismatch"))
  137. (multiple-value-bind (body status-code)
  138. (drakma:http-request put-url
  139. :additional-headers headers
  140. :content-length (length decrypted-file)
  141. :content-type mime-type
  142. :method :put
  143. :content decrypted-file)
  144. (unless (and (>= status-code 200) (< status-code 300))
  145. (format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
  146. (error "HTTP upload failed with status ~A" status-code))
  147. get-url)))))))))))
  148. (defun send-qrcode (comp jid text)
  149. "Send a QR code containing TEXT to JID."
  150. (with-component-data-lock (comp)
  151. (uiop:with-temporary-file (:stream stream
  152. :pathname path
  153. :keep t) ; Needed because async
  154. (format *debug-io* "~&using path ~A~%" path)
  155. (cl-qrencode:encode-png-stream text stream)
  156. (force-output stream) ; otherwise the QR codes get chopped off?
  157. (catcher
  158. (let ((content-length (file-length stream)))
  159. (attach
  160. (request-http-upload-slot comp (component-upload-component-name comp)
  161. "qrcode.png"
  162. (file-length stream)
  163. "image/png")
  164. (lambda (slot)
  165. (with-promise-from-thread ()
  166. (destructuring-bind ((put-url . headers) get-url) slot
  167. (format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
  168. (multiple-value-bind (body status-code)
  169. (drakma:http-request put-url
  170. :additional-headers headers
  171. :content-type "image/png"
  172. :content-length content-length
  173. :method :put
  174. :content path)
  175. (unless (and (>= status-code 200) (< status-code 300))
  176. (format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
  177. (error "HTTP upload failed with status ~A" status-code))
  178. (with-component-data-lock (comp)
  179. (let ((ajid (admin-jid comp)))
  180. (admin-msg comp jid "WhatsApp Web registration: Scan the following QR code with your device! (Menu -> WhatsApp Web)")
  181. (with-message (comp jid :from ajid)
  182. (cxml:with-element "body"
  183. (cxml:text get-url))
  184. (cxml:with-element "x"
  185. (cxml:attribute "xmlns" +oob-ns+)
  186. (cxml:with-element "url"
  187. (cxml:text get-url))))
  188. (admin-msg comp jid "(Code expired? Be faster next time. Get a new one with `connect`.)")))))))))
  189. (t (e)
  190. (admin-msg comp jid (format nil "Failed to upload QR code!~%Report the following error to the bridge admin: `~A`" e)))))))