Browse Source

Add functions for *uploading* media (but not sending)

- This is a large part of the work toward being able to send images/video/etc.
- We can now encrypt stuff according to whatsapp's requirements, ask for an
  upload slot, and do the uploading (but the actual uploading is outsourced to
  the library consumer right now)
- Still missing, however, is the ability to stuff the necessary bits of info
  into a WhatsApp protobuf message and actually send it.
master
eta 3 years ago
parent
commit
5b14419205
  1. 49
      crypto.lisp
  2. 23
      whatscl.lisp

49
crypto.lisp

@ -14,12 +14,20 @@ @@ -14,12 +14,20 @@
-1 ; iteration count /should/ be ignored, right?
length)))
(defun sha256 (data)
"Computes the SHA256 hash of DATA."
(ironclad:digest-sequence :sha256 data))
(defun hmac-sha256 (key data)
"Computes the HMAC-SHA256 message authentication code for DATA, using the secret KEY."
(let ((mac (crypto:make-mac :hmac key :sha256)))
(crypto:update-mac mac data)
(crypto:produce-mac mac)))
(defmacro vectors-concatenate (&rest args)
"Concatenate ARGS (all of type '(VECTOR (UNSIGNED-BYTE 8))) into a vector of the same type."
`(concatenate '(vector (unsigned-byte 8)) ,@args))
(defun aes-encrypt (key iv plaintext)
"Encrypts PLAINTEXT with KEY, using the AES-CBC cipher and the provided IV."
(let* ((cipher (crypto:make-cipher :aes
@ -67,10 +75,8 @@ Returns the encKey and macKey as two values." @@ -67,10 +75,8 @@ Returns the encKey and macKey as two values."
(hmac-expected (subseq secret 32 64))
(hmac-derived (hmac-sha256
(subseq expanded-secret 32 64)
(concatenate '(vector (unsigned-byte 8))
(subseq secret 0 32) (subseq secret 64))))
(keys-encrypted (concatenate '(vector (unsigned-byte 8))
(subseq expanded-secret 64) (subseq secret 64))))
(vectors-concatenate (subseq secret 0 32) (subseq secret 64))))
(keys-encrypted (vectors-concatenate (subseq expanded-secret 64) (subseq secret 64))))
(assert (equalp hmac-derived hmac-expected) () "HMAC validation failed:~%expected ~A~%got ~A" hmac-expected hmac-derived)
(let ((keys-decrypted (aes-decrypt (subseq expanded-secret 0 32) keys-encrypted)))
(values (subseq keys-decrypted 0 32) (subseq keys-decrypted 32)))))
@ -89,11 +95,9 @@ Returns the encKey and macKey as two values." @@ -89,11 +95,9 @@ Returns the encKey and macKey as two values."
(let* ((block-length (crypto:block-length :aes))
(iv (crypto:random-data block-length))
(encrypted-message (aes-encrypt (session-enc-key session) iv message))
(iv-and-message (concatenate '(vector (unsigned-byte 8))
iv encrypted-message))
(iv-and-message (vectors-concatenate iv encrypted-message))
(signature (hmac-sha256 (session-mac-key session) iv-and-message)))
(concatenate '(vector (unsigned-byte 8))
signature iv-and-message)))
(vectors-concatenate signature iv-and-message)))
(defun get-media-app-info (type)
"Gets the HKDF application info for the media type symbol TYPE."
@ -118,11 +122,36 @@ TYPE is a symbol (one of :IMAGE, :VIDEO, :AUDIO or :DOCUMENT) specifying what ty @@ -118,11 +122,36 @@ TYPE is a symbol (one of :IMAGE, :VIDEO, :AUDIO or :DOCUMENT) specifying what ty
(mac-split (- (length data) 10))
(file-data (subseq data 0 mac-split))
(hmac-expected (subseq data mac-split))
(iv-and-file (concatenate '(vector (unsigned-byte 8))
iv file-data))
(iv-and-file (vectors-concatenate iv file-data))
(hmac-derived (hmac-sha256 mac-key iv-and-file))
(decrypted (aes-decrypt cipher-key iv-and-file)))
(assert (equalp hmac-expected (subseq hmac-derived 0 10)) ()
"HMAC validation failed~%expected ~A~%got ~A" hmac-derived hmac-expected)
decrypted))
(defun generate-media-keys (type)
"Generate a 32-byte random media key, and then expand it using the provided media TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT).
Returns (RANDOM-KEY IV CIPHER-KEY MAC-KEY), with the latter 3 values taken as subsequences of the expanded key."
(check-type type (member :image :video :audio :document))
(let* ((random-key (crypto:random-data 32))
(expanded (hkdf random-key 112 (get-media-app-info type))))
(values random-key
(subseq expanded 0 16)
(subseq expanded 16 48)
(subseq expanded 48 80))))
(defun encrypt-media-data (data type)
"Encrypt the provided DATA (a piece of encrypted media data), a piece of media of the given TYPE (one of :IMAGE, :VIDEO, :AUDIO, or :DOCUMENT).
Returns (ENCRYPTED-BLOB RANDOM-KEY FILE-SHA256 FILE-ENC-SHA256), where ENCRYPTED-BLOB should be uploaded to WhatsApp (along with a base64-encoded FILE-ENC-SHA256), and the other fields should be used to populate an instance of class FILE-INFO."
(check-type data (simple-array (unsigned-byte 8)))
(check-type type (member :image :video :audio :document))
(multiple-value-bind (random-key iv cipher-key mac-key)
(generate-media-keys type)
(let* ((enc (aes-encrypt cipher-key iv data))
(mac (subseq (hmac-sha256 mac-key
(vectors-concatenate iv enc))
0 10))
(file-sha-256 (sha256 data))
(enc-mac (vectors-concatenate enc mac))
(file-enc-sha-256 (sha256 enc-mac)))
(values enc-mac random-key file-sha-256 file-enc-sha-256))))

23
whatscl.lisp

@ -194,6 +194,29 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA @@ -194,6 +194,29 @@ CALLBACK, if provided, specifies a function to run with the reply sent by WhatsA
:presence
:callback (function-check-status :send-presence)))
(defun parse-media-conn-response (resp)
"Parse the response to START-MEDIA-UPLOAD provided (RESP). If it is valid, return the values (AUTH-TOKEN TTL HOSTNAME-LIST); else, return NIL."
(labels
;; This is the kind of thing the Maybe monad is excellent at. We don't have
;; that, so let's do things the hacky Lisp way!
((need (thing) (or thing (return-from parse-media-conn-response)))
(maybe-list (obj) (when obj (list obj)))
(extract-hostname (host) (maybe-list (cassoc :hostname host))))
(let* ((media-conn (need (cassoc :media--conn resp)))
(auth-token (need (cassoc :auth media-conn)))
(ttl (need (cassoc :ttl media-conn)))
(hosts (mapcan #'extract-hostname (need (cassoc :hosts media-conn)))))
(values auth-token ttl hosts))))
(defun start-media-upload (conn callback)
"Request a media upload slot from WhatsApp. Calls CALLBACK like (FUNCALL CALLBACK CONN AUTH-TOKEN TTL HOSTS); if the slot request fails, AUTH-TOKEN, TTL, and HOSTS will all be NIL."
(send-ws-message conn `("query" "mediaConn")
(lambda (conn resp)
(multiple-value-bind (auth-token ttl hosts)
(parse-media-conn-response resp)
(without-wac-lock (conn)
(funcall callback conn auth-token ttl hosts))))))
(defun get-profile-picture (conn jid callback)
"Try and get a profile picture thumbnail for JID. Calls CALLBACK with CONN as first argument and then a URL (or NIL if none could be found)"
(declare (type jid jid))

Loading…
Cancel
Save