-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmedia.lisp
197 lines (190 loc) · 11.7 KB
/
media.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
;;;; Handling media uploading / downloading
(in-package :whatsxmpp)
(defun squonch-image-to-jpeg-thumbnail (opticl-image)
"Resize the provided OPTICL-IMAGE to a small 640x480 thumbnail and return an octet vector of JPEG data for this thumbnail."
(check-type opticl-image opticl:image)
(let* ((image-out-stream (flexi-streams:make-in-memory-output-stream))
(resized-image (opticl:resize-image opticl-image 480 640))
(useless (opticl:write-jpeg-stream image-out-stream resized-image)) ; squonch
(image-thumbnail (flexi-streams:get-output-stream-sequence image-out-stream)))
(declare (ignore useless))
(concatenate '(vector (unsigned-byte 8)) image-thumbnail)))
(defun maybe-upload-whatsapp-media (conn media-url)
"If the media at MEDIA-URL can be sent natively as a WhatsApp upload, download it and re-host it on WhatsApp.
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)."
(check-type media-url string)
(let ((opticl-function (opticl::get-image-stream-reader (pathname-type media-url))))
(if opticl-function
(attach
(download-remote-media media-url)
(lambda (media-data)
(let* ((image-stream (flexi-streams:make-in-memory-input-stream media-data))
(image-mime (or (trivial-mimes:mime-lookup media-url)
(error "Couldn't guess image MIME type for ~A" media-url)))
(parsed-image (funcall opticl-function image-stream))
(squonched-image (squonch-image-to-jpeg-thumbnail parsed-image)))
(opticl:with-image-bounds (image-y image-x) parsed-image
(attach
(put-whatsapp-media-file conn media-data :image image-mime)
(lambda (file-info)
(make-instance 'whatscl::message-contents-image
:file-info file-info
:width-px image-x
:height-px image-y
:jpeg-thumbnail squonched-image)))))))
(promisify media-url))))
(defun download-remote-media (media-url)
"Returns a promise that downloads the remote MEDIA-URL and resolves with an octet vector of the downloaded data."
;; FIXME FIXME FIXME: this function is a trivial DoS vector, if you provide an infinite file like time.gif,
;; or a file that's like 1GB.
(check-type media-url string)
(with-promise-from-thread ()
(format *debug-io* "~&downloading remote media: ~A~%" media-url)
(multiple-value-bind (response status-code)
(drakma:http-request media-url
:force-binary t)
(unless (eql status-code 200)
(format *error-output* "~&downloading failed! status ~A~%" status-code)
(error "Remote media download failed with status code ~A~~%%" status-code))
(check-type response (simple-array (unsigned-byte 8)))
(format *debug-io* "~&downloaded ~A (length: ~A)~%" media-url (length response))
response)))
(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 (pb:string-field url)
:sha256 file-sha256
:enc-sha256 file-enc-sha256
:length-bytes (length encrypted-blob)
:mime-type (pb:string-field 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)
(with-promise-from-thread ()
(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)))))))