drive: verify content-key-packet, block, and manifest signatures on read
ober
91aee489ca2d547b6bc1252bbb73f3d8c74f936b
--- a/protonstorage/drive/client.ss +++ b/protonstorage/drive/client.ss @@ -355,12 +355,17 @@ value (error who "missing block field" key)))) - (def (download-decrypt-block session content-key block) + (def (download-decrypt-block session content-key block file-key address-key) (let* ([encrypted (proton-drive-get-block-bytes (block-field 'download-decrypt-block block "BareURL") (block-field 'download-decrypt-block block "Token"))]) - (proton-drive-decrypt-revision-block content-key block encrypted))) + (proton-drive-decrypt-revision-block + content-key + block + encrypted + file-key + address-key))) (def (concat-bytevectors bvs) (if (null? bvs) @@ -376,31 +381,34 @@ (bytevector-copy! bv s out 0 len) out)) - (def (proton-drive-read-file-bytes session share-id parent-key file-link) + (def (proton-drive-read-file-bytes session share-id parent-key file-link address-key) (unless (proton-drive-link-file? file-link) (error 'proton-drive-read-file-bytes "link is not a file")) (let* ([file-key (proton-drive-unlocked-node-key parent-key file-link)] [content-key - (proton-drive-decrypt-content-session-key file-key file-link)] + (proton-drive-decrypt-content-session-key file-key file-link address-key)] [revision (proton-drive-active-file-revision session share-id file-link)] [blocks (sort-blocks (revision-blocks revision))]) + (proton-drive-verify-manifest-signature! address-key revision blocks) (concat-bytevectors (map (lambda (block) - (download-decrypt-block session content-key block)) + (download-decrypt-block session content-key block file-key address-key)) blocks)))) - (def (proton-drive-read-file-range session share-id parent-key file-link size offset) + (def (proton-drive-read-file-range session share-id parent-key file-link size offset + address-key) (let* ([all (proton-drive-read-file-bytes session share-id parent-key - file-link)] + file-link + address-key)] [start (if (and (number? offset) (> offset 0)) offset 0)] [count (if (and (number? size) (>= size 0)) size (bytevector-length all))]) - (bv-slice all start (+ start count)))) + (bv-slice all start (+ start count)))) (def (link-state link) (let ([value (jmaybe link "State" 0)]) @@ -692,8 +700,11 @@ (proton-drive-unlocked-node-key (proton-drive-folder-context-key parent-context) file-link)] - [content-key - (proton-drive-decrypt-content-session-key file-key file-link)] + [content-key + (proton-drive-decrypt-content-session-key + file-key + file-link + (proton-drive-root-context-address-key root-context))] [replace-existing-draft? (getopt opts 'replace-existing-draft: #f)]) (let loop ([attempt 1]) @@ -1094,13 +1105,14 @@ (error 'proton-drive-root-fs "missing parent key for Drive file link" link-id)) - (proton-drive-read-file-range - session - share-id - parent-key - link - size - offset)))]) + (proton-drive-read-file-range + session + share-id + parent-key + link + size + offset + (proton-drive-root-context-address-key root-context))))]) (if writeable? (proton-drive-fs-from-links session --- a/protonstorage/drive/crypto.ss +++ b/protonstorage/drive/crypto.ss @@ -63,7 +63,14 @@ proton-drive-block-hash-valid? proton-drive-assert-block-hash! proton-drive-decrypt-content-block - proton-drive-decrypt-revision-block) + proton-drive-decrypt-revision-block + proton-drive-current-content-key-packet-signature-verifier + proton-drive-current-block-signature-verifier + proton-drive-current-manifest-signature-verifier + proton-drive-verify-content-key-packet-signature! + proton-drive-verify-block-signature! + proton-drive-verify-manifest-signature! + proton-drive-manifest-signature-data) (import (rnrs) (rnrs mutable-strings) @@ -166,6 +173,23 @@ (bytevector-copy! bv start out 0 n) out)) + (def (bytevectors-length bvs) + (let loop ([xs bvs] [n 0]) + (if (null? xs) + n + (loop (cdr xs) (+ n (bytevector-length (car xs))))))) + + (def (bytevector-append . bvs) + (let* ([total (bytevectors-length bvs)] + [out (make-bytevector total 0)]) + (let outer ([xs bvs] [offset 0]) + (unless (null? xs) + (let* ([bv (car xs)] + [len (bytevector-length bv)]) + (bytevector-copy! bv 0 out offset len) + (outer (cdr xs) (+ offset len))))) + out)) + (def drive-content-key-magic #vu8(80 68 67 49)) (def (bytevector-prefix=? bv prefix) @@ -496,6 +520,103 @@ (error 'proton-drive-current-content-block-decryptor "expected zero or one argument")])) + (def (default-content-key-packet-signature-verifier address-key packet signature) + (error 'proton-drive-verify-content-key-packet-signature! + "native Drive content-key-packet signature verification is disabled until the Proton OpenPGP backend is RustSec-clean")) + + (def (default-block-signature-verifier address-key file-key enc-signature plaintext) + (error 'proton-drive-verify-block-signature! + "native Drive block signature verification is disabled until the Proton OpenPGP backend is RustSec-clean")) + + (def (default-manifest-signature-verifier address-key manifest-signature manifest-data) + (error 'proton-drive-verify-manifest-signature! + "native Drive manifest signature verification is disabled until the Proton OpenPGP backend is RustSec-clean")) + + (define *current-content-key-packet-signature-verifier* + default-content-key-packet-signature-verifier) + (define *current-block-signature-verifier* + default-block-signature-verifier) + (define *current-manifest-signature-verifier* + default-manifest-signature-verifier) + + (define (proton-drive-current-content-key-packet-signature-verifier . maybe-value) + (cond + [(null? maybe-value) *current-content-key-packet-signature-verifier*] + [(null? (cdr maybe-value)) + (set! *current-content-key-packet-signature-verifier* (car maybe-value))] + [else + (error 'proton-drive-current-content-key-packet-signature-verifier + "expected zero or one argument")])) + + (define (proton-drive-current-block-signature-verifier . maybe-value) + (cond + [(null? maybe-value) *current-block-signature-verifier*] + [(null? (cdr maybe-value)) + (set! *current-block-signature-verifier* (car maybe-value))] + [else + (error 'proton-drive-current-block-signature-verifier + "expected zero or one argument")])) + + (define (proton-drive-current-manifest-signature-verifier . maybe-value) + (cond + [(null? maybe-value) *current-manifest-signature-verifier*] + [(null? (cdr maybe-value)) + (set! *current-manifest-signature-verifier* (car maybe-value))] + [else + (error 'proton-drive-current-manifest-signature-verifier + "expected zero or one argument")])) + + (def (proton-drive-verify-content-key-packet-signature! address-key packet signature) + (unless (bytevector? packet) + (error 'proton-drive-verify-content-key-packet-signature! + "content key packet must be a bytevector")) + (unless (nonempty-string signature) + (error 'proton-drive-verify-content-key-packet-signature! + "content key packet has no ContentKeyPacketSignature")) + (unless ((proton-drive-current-content-key-packet-signature-verifier) + address-key packet signature) + (error 'proton-drive-verify-content-key-packet-signature! + "content key packet signature verification failed")) + #t) + + (def (block-enc-signature block) + (or (nonempty-string (jmaybe block "EncSignature" "")) + (error 'proton-drive-verify-block-signature! + "block has no EncSignature field" + (jmaybe block "Index" #f)))) + + (def (proton-drive-verify-block-signature! address-key file-key block plaintext) + (unless (bytevector? plaintext) + (error 'proton-drive-verify-block-signature! "plaintext must be a bytevector")) + (let ([enc-signature (block-enc-signature block)]) + (unless ((proton-drive-current-block-signature-verifier) + address-key file-key enc-signature plaintext) + (error 'proton-drive-verify-block-signature! + "encrypted block signature verification failed" + (jmaybe block "Index" #f))) + #t)) + + (def (revision-manifest-signature revision) + (or (nonempty-string (jmaybe revision "ManifestSignature" "")) + (error 'proton-drive-verify-manifest-signature! + "revision has no ManifestSignature field"))) + + (def (proton-drive-manifest-signature-data blocks) + (apply bytevector-append + (map + (lambda (block) + (base64-string->u8vector (block-hash block))) + blocks))) + + (def (proton-drive-verify-manifest-signature! address-key revision blocks) + (let ([manifest-signature (revision-manifest-signature revision)] + [manifest-data (proton-drive-manifest-signature-data blocks)]) + (unless ((proton-drive-current-manifest-signature-verifier) + address-key manifest-signature manifest-data) + (error 'proton-drive-verify-manifest-signature! + "revision manifest signature verification failed")) + #t)) + (def (proton-drive-content-backend-available?) #f) @@ -610,11 +731,14 @@ (proton-drive-content-session-key-data content-session-key) plaintext-bv))) - (def (proton-drive-decrypt-content-session-key node-key file-link) - ((proton-drive-current-content-session-key-decryptor) - node-key - (proton-drive-file-content-key-packet file-link) - (proton-drive-file-content-key-packet-signature file-link))) + (def (proton-drive-decrypt-content-session-key node-key file-link address-key) + (let ([packet (proton-drive-file-content-key-packet file-link)] + [signature (proton-drive-file-content-key-packet-signature file-link)]) + (proton-drive-verify-content-key-packet-signature! address-key packet signature) + ((proton-drive-current-content-session-key-decryptor) + node-key + packet + signature))) (def (proton-drive-content-hash encrypted-block) (sha256 encrypted-block)) @@ -643,8 +767,12 @@ content-session-key encrypted-block)) - (def (proton-drive-decrypt-revision-block content-session-key block encrypted-block) + (def (proton-drive-decrypt-revision-block content-session-key block encrypted-block + file-key address-key) (proton-drive-assert-block-hash! block encrypted-block) - (proton-drive-decrypt-content-block content-session-key encrypted-block)) + (let ([plaintext + (proton-drive-decrypt-content-block content-session-key encrypted-block)]) + (proton-drive-verify-block-signature! address-key file-key block plaintext) + plaintext)) )