fix: bounds-check untrusted length fields in ECIES/protocol frames (P1 #22)
ober
39f1cd30a1e823b07873cd473d502ec598656cff
--- a/lib/secmon/crypto/ecies.sls +++ b/lib/secmon/crypto/ecies.sls @@ -33,17 +33,20 @@ out)) (define (bytevector->encrypted-payload bv) - (when (< (bytevector-length bv) 48) - (error 'bytevector->encrypted-payload "data too short" (bytevector-length bv))) - (let* ([epk (make-bytevector 32)] - [nonce (make-bytevector 12)] - [ct-len (begin - (bytevector-copy! bv 0 epk 0 32) - (bytevector-copy! bv 32 nonce 0 12) - (bytevector-u32-ref bv 44 (endianness little)))] - [ct (make-bytevector ct-len)]) - (bytevector-copy! bv 48 ct 0 ct-len) - (make-encrypted-payload epk nonce ct))) + (let ([len (bytevector-length bv)]) + (when (< len 48) + (error 'bytevector->encrypted-payload "data too short" len)) + (let ([ct-len (bytevector-u32-ref bv 44 (endianness little))]) + (unless (= (+ 48 ct-len) len) + (error 'bytevector->encrypted-payload + "ciphertext length out of bounds" ct-len len)) + (let ([epk (make-bytevector 32)] + [nonce (make-bytevector 12)] + [ct (make-bytevector ct-len)]) + (bytevector-copy! bv 0 epk 0 32) + (bytevector-copy! bv 32 nonce 0 12) + (bytevector-copy! bv 48 ct 0 ct-len) + (make-encrypted-payload epk nonce ct))))) ;; --- FFI bindings for X25519 and HKDF --- --- a/lib/secmon/server/protocol.sls +++ b/lib/secmon/server/protocol.sls @@ -86,6 +86,14 @@ (define (bv-tag tag . parts) (apply bv-append (make-bytevector 1 tag) parts)) + ;; Fail closed before any allocation or reference: the field at OFFSET + ;; spanning NEED bytes must lie wholly within BV, otherwise the frame is + ;; hostile (untrusted length fields) and is rejected. + (define (frame-check who bv offset need) + (let ([len (bytevector-length bv)]) + (when (> (+ offset need) len) + (error who "frame field out of bounds" offset need len)))) + ;; --- Message packing --- (define (pack-challenge challenge) @@ -114,14 +122,18 @@ (define (unpack-request bv) ;; bv starts after MSG-REQUEST tag (already stripped) ;; Returns: (req-tag . data) + (frame-check 'unpack-request bv 0 1) (let ([sub-tag (bytevector-u8-ref bv 0)]) (case sub-tag [(1) ;; GET-EVENTS-AFTER + (frame-check 'unpack-request bv 1 8) (list 'get-events-after (unpack-u64-le bv 1))] [(2) ;; GET-EVENTS-RANGE + (frame-check 'unpack-request bv 1 16) (list 'get-events-range (unpack-i64-le bv 1) (unpack-i64-le bv 9))] [(3) (list 'status)] [(4) ;; ACKNOWLEDGE + (frame-check 'unpack-request bv 1 8) (list 'acknowledge (unpack-u64-le bv 1))] [(5) (list 'ping)] [else (list 'unknown)]))) @@ -180,27 +192,37 @@ (define (unpack-response bv) ;; bv starts after MSG-RESPONSE tag + (frame-check 'unpack-response bv 0 1) (let ([sub-tag (bytevector-u8-ref bv 0)]) (case sub-tag [(1) ;; EVENTS + (frame-check 'unpack-response bv 1 4) (let ([count (unpack-u32-le bv 1)]) (let loop ([i 0] [offset 5] [acc '()]) (if (>= i count) (list 'events (reverse acc)) - (let* ([seq (unpack-u64-le bv offset)] - [ts (unpack-i64-le bv (+ offset 8))] - [data-len (unpack-u32-le bv (+ offset 16))] - [data (make-bytevector data-len)]) - (bytevector-copy! bv (+ offset 20) data 0 data-len) - (loop (+ i 1) (+ offset 20 data-len) - (cons (make-stored-event seq ts data) acc))))))] + (begin + ;; 20-byte fixed header (seq u64, ts i64, data-len u32) must + ;; fit before the untrusted data-len is read or honoured. + (frame-check 'unpack-response bv offset 20) + (let* ([seq (unpack-u64-le bv offset)] + [ts (unpack-i64-le bv (+ offset 8))] + [data-len (unpack-u32-le bv (+ offset 16))]) + (frame-check 'unpack-response bv (+ offset 20) data-len) + (let ([data (make-bytevector data-len)]) + (bytevector-copy! bv (+ offset 20) data 0 data-len) + (loop (+ i 1) (+ offset 20 data-len) + (cons (make-stored-event seq ts data) acc))))))))] [(2) ;; STATUS + (frame-check 'unpack-response bv 1 20) (list 'status (unpack-u32-le bv 1) (unpack-u64-le bv 5) (unpack-u64-le bv 13))] [(3) ;; ACKED + (frame-check 'unpack-response bv 1 8) (list 'acked (unpack-u64-le bv 1))] [(4) ;; PONG + (frame-check 'unpack-response bv 1 8) (list 'pong (unpack-i64-le bv 1))] [else (list 'unknown)]))) new file mode 100644 --- /dev/null +++ b/tests/protocol-bounds-test.ss @@ -0,0 +1,186 @@ +(import (chezscheme) + (secmon crypto ecies) + (secmon crypto keys) + (secmon server protocol) + (secmon buffer ring)) + +(define failures 0) +(define (check name got want) + (let ([ok (equal? got want)]) + (unless ok (set! failures (+ failures 1))) + (display (if ok "ok: " "FAIL: ")) + (display name) + (unless ok (display (format " got=~s want=~s" got want))) + (newline))) + +;; #t when THUNK raises (frame rejected, fail closed). +(define (rejected? thunk) + (guard (e [#t #t]) (thunk) #f)) + +;; Strip the leading MSG-REQUEST / MSG-RESPONSE tag, mirroring how the +;; listener/collector hand the sub-tag-prefixed body to the unpackers. +(define (strip-msg-tag bv) + (let ([out (make-bytevector (- (bytevector-length bv) 1))]) + (bytevector-copy! bv 1 out 0 (bytevector-length out)) + out)) + +;; --- ECIES: untrusted ct-len must be validated before allocating --- + +;; Required regression: a 48-byte frame with ct-len=0xFFFFFFFF is rejected +;; instead of triggering a 4 GiB allocation ahead of the AEAD check. +(let ([bv (make-bytevector 48 0)]) + (bytevector-u32-set! bv 44 #xFFFFFFFF (endianness little)) + (check "ecies ct-len=0xFFFFFFFF rejected (no 4GiB alloc)" + (rejected? (lambda () (bytevector->encrypted-payload bv))) #t)) + +;; Declared ciphertext longer than the bytes actually present is rejected. +(let ([bv (make-bytevector 48 0)]) + (bytevector-u32-set! bv 44 100 (endianness little)) + (check "ecies ct-len beyond buffer rejected" + (rejected? (lambda () (bytevector->encrypted-payload bv))) #t)) + +;; Truncated header (< 48 bytes) is rejected. +(check "ecies truncated header rejected" + (rejected? (lambda () + (bytevector->encrypted-payload (make-bytevector 47 0)))) #t) + +;; Trailing garbage (ct-len smaller than the remaining buffer) is rejected. +(let ([bv (make-bytevector 60 0)]) + (bytevector-u32-set! bv 44 4 (endianness little)) + (check "ecies trailing bytes rejected" + (rejected? (lambda () (bytevector->encrypted-payload bv))) #t)) + +;; Positive: a well-formed payload survives encrypt -> serialize -> parse -> +;; decrypt, proving the bounds check does not reject legitimate frames. +(let-values ([(priv pub) (generate-keypair)]) + (let* ([encryptor (make-ecies-encryptor pub)] + [decryptor (make-ecies-decryptor priv)] + [plaintext (string->utf8 "secmon bounds round-trip")] + [wire (encrypted-payload->bytevector (ecies-encrypt encryptor plaintext))] + [parsed (bytevector->encrypted-payload wire)]) + (check "ecies encrypt->serialize->parse->decrypt round-trip" + (ecies-decrypt decryptor parsed) plaintext))) + +;; --- unpack-request: every fixed field must be bounds-checked --- + +(check "request empty body rejected" + (rejected? (lambda () (unpack-request (make-bytevector 0 0)))) #t) + +;; Required regression: a body too short for the u64 ref is rejected. +(let ([bv (make-bytevector 5 0)]) + (bytevector-u8-set! bv 0 1) ;; GET-EVENTS-AFTER, needs 1+8 bytes + (check "request truncated get-events-after rejected" + (rejected? (lambda () (unpack-request bv))) #t)) + +(let ([bv (make-bytevector 10 0)]) + (bytevector-u8-set! bv 0 2) ;; GET-EVENTS-RANGE, needs 1+16 bytes + (check "request truncated get-events-range rejected" + (rejected? (lambda () (unpack-request bv))) #t)) + +(let ([bv (make-bytevector 3 0)]) + (bytevector-u8-set! bv 0 4) ;; ACKNOWLEDGE, needs 1+8 bytes + (check "request truncated acknowledge rejected" + (rejected? (lambda () (unpack-request bv))) #t)) + +;; Positive: request round-trips. +(check "request get-events-after round-trip" + (unpack-request + (strip-msg-tag (pack-request REQ-GET-EVENTS-AFTER (pack-u64-le 42)))) + (list 'get-events-after 42)) +(check "request get-events-range round-trip" + (unpack-request + (strip-msg-tag + (pack-request REQ-GET-EVENTS-RANGE (pack-i64-le 5) (pack-i64-le 99)))) + (list 'get-events-range 5 99)) +(check "request status round-trip" + (unpack-request (strip-msg-tag (pack-request REQ-STATUS))) + (list 'status)) +(check "request acknowledge round-trip" + (unpack-request + (strip-msg-tag (pack-request REQ-ACKNOWLEDGE (pack-u64-le 7)))) + (list 'acknowledge 7)) +(check "request ping round-trip" + (unpack-request (strip-msg-tag (pack-request REQ-PING))) + (list 'ping)) + +;; --- unpack-response: EVENTS data-len and fixed fields bounds-checked --- + +(check "response empty body rejected" + (rejected? (lambda () (unpack-response (make-bytevector 0 0)))) #t) + +;; Required regression: an EVENTS frame whose data-len exceeds the buffer is +;; rejected before make-bytevector/bytevector-copy!. +(let ([bv (make-bytevector 25 0)]) + (bytevector-u8-set! bv 0 1) ;; RESP-EVENTS + (bytevector-u32-set! bv 1 1 (endianness little)) ;; count = 1 + (bytevector-u32-set! bv 21 #xFFFFFFFF (endianness little)) ;; data-len huge + (check "response event data-len=0xFFFFFFFF rejected" + (rejected? (lambda () (unpack-response bv))) #t)) + +;; Modestly oversized data-len is also rejected. +(let ([bv (make-bytevector 25 0)]) + (bytevector-u8-set! bv 0 1) + (bytevector-u32-set! bv 1 1 (endianness little)) + (bytevector-u32-set! bv 21 100 (endianness little)) ;; 25+? > 25 + (check "response event data-len beyond buffer rejected" + (rejected? (lambda () (unpack-response bv))) #t)) + +;; Truncated 20-byte event header is rejected. +(let ([bv (make-bytevector 10 0)]) + (bytevector-u8-set! bv 0 1) + (bytevector-u32-set! bv 1 1 (endianness little)) + (check "response truncated event header rejected" + (rejected? (lambda () (unpack-response bv))) #t)) + +;; count claims more events than the buffer holds -> rejected. +(let ([bv (make-bytevector 29 0)]) ;; room for exactly one 4-byte event + (bytevector-u8-set! bv 0 1) + (bytevector-u32-set! bv 1 2 (endianness little)) ;; count = 2 + (bytevector-u32-set! bv 21 4 (endianness little)) ;; event 1 data-len = 4 + (check "response count exceeding buffer rejected" + (rejected? (lambda () (unpack-response bv))) #t)) + +;; Truncated fixed-field responses are rejected. +(let ([bv (make-bytevector 5 0)]) + (bytevector-u8-set! bv 0 2) ;; STATUS needs 1+20 bytes + (check "response truncated status rejected" + (rejected? (lambda () (unpack-response bv))) #t)) +(let ([bv (make-bytevector 4 0)]) + (bytevector-u8-set! bv 0 3) ;; ACKED needs 1+8 bytes + (check "response truncated acked rejected" + (rejected? (lambda () (unpack-response bv))) #t)) +(let ([bv (make-bytevector 4 0)]) + (bytevector-u8-set! bv 0 4) ;; PONG needs 1+8 bytes + (check "response truncated pong rejected" + (rejected? (lambda () (unpack-response bv))) #t)) + +;; Positive: response round-trips. +(let* ([evs (list (make-stored-event 1 1000 (make-bytevector 4 #xAA)) + (make-stored-event 2 2000 (make-bytevector 3 #xBB)))] + [parsed (unpack-response + (strip-msg-tag (pack-events-response evs)))] + [events (cadr parsed)]) + (check "response events round-trip tag" (car parsed) 'events) + (check "response events round-trip count" (length events) 2) + (check "response event 1 seq" (stored-event-seq (car events)) 1) + (check "response event 1 ts" (stored-event-timestamp-ms (car events)) 1000) + (check "response event 1 data" + (stored-event-encrypted-data (car events)) (make-bytevector 4 #xAA)) + (check "response event 2 seq" (stored-event-seq (cadr events)) 2) + (check "response event 2 data" + (stored-event-encrypted-data (cadr events)) (make-bytevector 3 #xBB))) + +(check "response status round-trip" + (unpack-response (strip-msg-tag (pack-status-response 5 100 9999))) + (list 'status 5 100 9999)) +(check "response acked round-trip" + (unpack-response (strip-msg-tag (pack-acked-response 42))) + (list 'acked 42)) +(check "response pong round-trip" + (unpack-response (strip-msg-tag (pack-pong-response 12345))) + (list 'pong 12345)) + +(if (= failures 0) + (begin (display "protocol-bounds-test: all bounds checks passed") (newline)) + (begin (display (format "protocol-bounds-test: ~a failures" failures)) + (newline) (exit 1)))