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

whoops

Browse source
This commit is contained in:
eta 2020-06-19 12:55:48 +01:00
parent 26620cf36b
commit 6c0e61f2a5
1 changed files with 31 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
stuff.lisp
View file

@ -774,7 +774,7 @@ MEDIA-TYPE is one of (:image :video :audio :document)."
(multiple-value-bind (body status-code) (multiple-value-bind (body status-code)
(drakma:http-request put-url (drakma:http-request put-url
:additional-headers headers :additional-headers headers
:content-length (file-length file-data) :content-length (length decrypted-file)
:content-type mime-type :content-type mime-type
:method :put :method :put
:content decrypted-file) :content decrypted-file)
@ -794,35 +794,36 @@ MEDIA-TYPE is one of (:image :video :audio :document)."
(format *debug-io* "~&using path ~A~%" path) (format *debug-io* "~&using path ~A~%" path)
(cl-qrencode:encode-png-stream text stream) (cl-qrencode:encode-png-stream text stream)
(catcher (catcher
(attach (let ((content-length (file-length stream)))
(request-http-upload-slot comp (component-upload-component-name comp) (attach
"qrcode.png" (request-http-upload-slot comp (component-upload-component-name comp)
(file-length stream) "qrcode.png"
"image/png") (file-length stream)
(lambda (slot) "image/png")
(destructuring-bind ((put-url . headers) get-url) slot (lambda (slot)
(format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url) (destructuring-bind ((put-url . headers) get-url) slot
(multiple-value-bind (body status-code) (format *debug-io* "~&got put-url: ~A~% get-url: ~A~%" put-url get-url)
(drakma:http-request put-url (multiple-value-bind (body status-code)
:additional-headers headers (drakma:http-request put-url
:content-type "image/png" :additional-headers headers
:content-length (file-length stream) :content-type "image/png"
:method :put :content-length content-length
:content path) :method :put
(unless (and (>= status-code 200) (< status-code 300)) :content path)
(format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body) (unless (and (>= status-code 200) (< status-code 300))
(error "HTTP upload failed with status ~A" status-code)) (format *debug-io* "~&upload failed! status ~A, body ~A~%" status-code body)
(with-component-data-lock (comp) (error "HTTP upload failed with status ~A" status-code))
(let ((ajid (admin-jid comp))) (with-component-data-lock (comp)
(admin-msg comp jid "WhatsApp Web registration: Scan the following QR code with your device! (Menu -> WhatsApp Web)") (let ((ajid (admin-jid comp)))
(with-message (comp jid :from ajid) (admin-msg comp jid "WhatsApp Web registration: Scan the following QR code with your device! (Menu -> WhatsApp Web)")
(cxml:with-element "body" (with-message (comp jid :from ajid)
(cxml:text get-url)) (cxml:with-element "body"
(cxml:with-element "x" (cxml:text get-url))
(cxml:attribute "xmlns" +oob-ns+) (cxml:with-element "x"
(cxml:with-element "url" (cxml:attribute "xmlns" +oob-ns+)
(cxml:text get-url)))) (cxml:with-element "url"
(admin-msg comp jid "(Code expired? Be faster next time. Get a new one with `connect`.)"))))))) (cxml:text get-url))))
(admin-msg comp jid "(Code expired? Be faster next time. Get a new one with `connect`.)"))))))))
(t (e) (t (e)
(admin-msg comp jid (format nil "Failed to upload QR code!~%Report the following error to the bridge admin: `~A`" e))))))) (admin-msg comp jid (format nil "Failed to upload QR code!~%Report the following error to the bridge admin: `~A`" e)))))))