content-hash: widen segment-store ids to full SHA-256 and detect value-store collisions
ober
ccb2c786578b6e5193445812c6917968e991ee96
--- a/lib/jerboa-db/encoding.ss +++ b/lib/jerboa-db/encoding.ss @@ -23,7 +23,7 @@ encode-f64-sortable decode-f64-sortable ;; Content hashing for variable-length values - content-hash-bytes) + content-hash-bytes content-hash-full-bytes) (import (except (chezscheme) make-hash-table hash-table? @@ -156,15 +156,26 @@ (bitwise-xor (bytevector-u8-ref bv i) #xFF))) (bytevector-ieee-double-ref out 0 (endianness big)))))) - ;; ---- Content hashing (SHA-256, truncated to 8 bytes) ---- - ;; Used for variable-length values in index keys and content-addressed - ;; storage. SHA-256 (FIPS 180-4) replaces the previous non-cryptographic - ;; FNV-1a 64-bit hash so content addressing is collision-resistant. + ;; ---- Content hashing (SHA-256) ---- + ;; content-hash-bytes is the 8-byte (64-bit) truncation of SHA-256 used in + ;; the fixed 8-byte value-hash slot baked into the 28-byte index key format, + ;; the LevelDB range-scan sentinels, and elsewhere a compact, sortable value + ;; fingerprint is required. Its birthday bound is ~2^32 distinct values + ;; before a 50 % collision chance, so it is NOT collision-resistant against + ;; an attacker who can submit chosen values. The 28-byte index key keeps the + ;; 8-byte slot because widening it would corrupt on-disk key ordering and + ;; segment names; instead the query layer's `(equal? spec actual)` datom + ;; filter rejects any 8-byte collision candidates an AVET scan returns, so an + ;; index-key collision is a performance issue, not a correctness or security + ;; issue. ;; - ;; The digest is truncated to 8 bytes to match the fixed 8-byte value-hash - ;; slot baked into the 28-byte index key format, the LevelDB range-scan - ;; sentinels, and the segment-store segment ids — widening it would corrupt - ;; key ordering and on-disk segment names. + ;; Content-addressed storage (the segment store, and the in-memory value + ;; store) uses content-hash-full-bytes, the full 32-byte SHA-256 digest, so + ;; content addressing is collision-resistant (birthday bound ~2^128). The + ;; segment store's verified-segment-bytes re-computes the full digest on + ;; read and rejects any mismatch; the value store stores the full digest + ;; alongside each value and rejects an 8-byte collision on put. Index keys + ;; keep the 8-byte slot but never trust it for content addressing. (def (content-hash-bytes value) (let* ([data (cond @@ -177,6 +188,20 @@ (bytevector-copy! digest 0 bv 0 8) bv)) + (def (content-hash-full-bytes value) + ;; Full 32-byte SHA-256 digest of a value's canonical encoding. Use this + ;; for content addressing (segment ids, value-store verification); use + ;; content-hash-bytes only for index sort-key slots. + (let* ([data (cond + [(string? value) (string->utf8 value)] + [(bytevector? value) value] + [(symbol? value) (string->utf8 (symbol->string value))] + [else (string->utf8 (format "~a" value))])] + [digest (sha256-bytevector data)] + [bv (make-bytevector 32)]) + (bytevector-copy! digest 0 bv 0 32) + bv)) + ;; ---- Full 28-byte index key construction ---- (def (encode-eavt-key e a v-hash tx added?) --- a/lib/jerboa-db/index/leveldb.ss +++ b/lib/jerboa-db/index/leveldb.ss @@ -67,6 +67,15 @@ ;; ---- Key encoding per index ---- + ;; The 8-byte content hash fills the value-hash slot of the 28-byte index + ;; key (see encoding.ss). Its birthday bound is ~2^32 distinct values before + ;; a 50 % collision chance, so it is NOT collision-resistant against an + ;; attacker who can submit chosen values. A collision only causes the AVET + ;; scan to return extra candidate datoms; the query layer's + ;; `(equal? spec actual)` datom filter rejects any 8-byte mismatch, so an + ;; index-key collision is a performance issue, not a correctness or security + ;; issue. Content-addressed storage (segment store, value store) uses the + ;; full 32-byte digest (content-hash-full-bytes) and is collision-resistant. (def (datom-value-hash d) (content-hash-bytes (datom-v d))) --- a/lib/jerboa-db/index/segtree.ss +++ b/lib/jerboa-db/index/segtree.ss @@ -50,7 +50,8 @@ (def +segtree-default-seg-size+ 1024) (def +fs-segstore-max-dir-chars+ 4096) - (def +fs-segstore-segment-id-bytes+ 8) + (def +fs-segstore-segment-id-bytes+ 32) + (def +fs-segstore-segment-hex-chars+ (* 2 +fs-segstore-segment-id-bytes+)) (def +segtree-max-root-bytes+ (* 16 1024 1024)) (def +segtree-max-root-leaves+ 1000000) (def +segtree-max-root-objects+ 1000000) @@ -60,7 +61,10 @@ ;; A segstore is a set of operation closures, so the backing (memory or disk) ;; is pluggable. put -> content-hash id; get id -> bytes|#f; gc live-ids -> - ;; #removed; size -> count. + ;; #removed; size -> count. Segment ids are the FULL 32-byte SHA-256 of the + ;; segment bytes (content-hash-full-bytes), so content addressing is + ;; collision-resistant (birthday bound ~2^128); the previous 8-byte + ;; truncation only reached ~2^32. (define-record-type segstore (fields put-fn get-fn gc-fn size-fn)) (def (segstore-put! ss bytes) ((segstore-put-fn ss) bytes)) (def (segstore-get ss id) ((segstore-get-fn ss) id)) @@ -72,7 +76,7 @@ (let ([table (make-hashtable equal-hash equal?)]) (make-segstore (lambda (bytes) - (let ([id (content-hash-bytes bytes)]) + (let ([id (content-hash-full-bytes bytes)]) (unless (hashtable-contains? table id) (hashtable-set! table id bytes)) id)) (lambda (id) (hashtable-ref table id #f)) @@ -133,12 +137,12 @@ (def (segment-file-name? fname) (and (string? fname) - (= (string-length fname) 20) + (= (string-length fname) (+ +fs-segstore-segment-hex-chars+ 4)) (has-suffix? ".seg" fname) (let loop ([i 0]) - (cond [(= i 16) #t] - [(hex-char? (string-ref fname i)) (loop (+ i 1))] - [else #f])))) + (cond [(= i +fs-segstore-segment-hex-chars+) #t] + [(hex-char? (string-ref fname i)) (loop (+ i 1))] + [else #f])))) (def (checked-segment-path dir fname who) (unless (segment-file-name? fname) @@ -180,7 +184,7 @@ (def (verified-segment-bytes id bytes) (unless (bytevector? bytes) (error 'make-fs-segstore "missing segment file" (bytes->hex id))) - (unless (equal? (content-hash-bytes bytes) id) + (unless (equal? (content-hash-full-bytes bytes) id) (error 'make-fs-segstore "segment content hash mismatch" (bytes->hex id))) bytes) @@ -193,7 +197,7 @@ 'make-fs-segstore))]) (make-segstore (lambda (bytes) - (let* ([id (content-hash-bytes bytes)] [p (id->path id)]) + (let* ([id (content-hash-full-bytes bytes)] [p (id->path id)]) (unless (file-exists? p) (write-segment-file! p bytes)) id)) @@ -210,7 +214,7 @@ (for-each (lambda (fname) (when (segment-file-name? fname) - (let ([hex (substring fname 0 16)]) + (let ([hex (substring fname 0 +fs-segstore-segment-hex-chars+)]) (unless (hashtable-ref keep hex #f) (safe-delete-file (checked-segment-path dir fname 'segstore-gc!)) (set! removed (+ removed 1)))))) --- a/lib/jerboa-db/value-store.ss +++ b/lib/jerboa-db/value-store.ss @@ -11,25 +11,27 @@ (export make-value-store value-store? value-store-put! value-store-get value-store-has? - value-store-close value-store-stats) + value-store-close value-store-stats + value-store-test-inject-entry!) (import (except (chezscheme) - make-hash-table hash-table? - sort sort! - printf fprintf - path-extension path-absolute? - with-input-from-string with-output-to-string - iota 1+ 1- - partition - make-date make-time - atom? meta) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time + atom? meta) (jerboa prelude) + (std crypto compare) (jerboa-db encoding)) ;; ---- Record ---- (defstruct vs-rec - (table ;; equal-hash hashtable: bv-hash -> value + (table ;; equal-hash hashtable: 8-byte content hash -> (full-hash . value) hit-count miss-count dedup-count)) @@ -41,22 +43,57 @@ ;; ---- Operations ---- + ;; The 8-byte content hash is the table key (shared with the index-key slot) + ;; but is only collision-resistant to ~2^32 distinct values. The full 32-byte + ;; SHA-256 digest is stored alongside each value and checked on every put + ;; and get, so two distinct values that collide in 8 bytes are detected and + ;; rejected rather than silently deduplicated; a stored value whose contents + ;; no longer match its full digest is rejected on read. + (def (value-store-put! vs value) - ;; Returns 8-byte hash bytevector. Deduplicates on second call. - (let ([hash-bv (content-hash-bytes value)]) - (if (hashtable-contains? (vs-rec-table vs) hash-bv) - (begin - (vs-rec-dedup-count-set! vs (+ (vs-rec-dedup-count vs) 1)) - hash-bv) - (begin - (hashtable-set! (vs-rec-table vs) hash-bv value) - hash-bv)))) + ;; Returns the 8-byte hash bytevector. Deduplicates on a second put of the + ;; same value. Raises if an existing entry shares the 8-byte hash but has a + ;; different full digest (a content-hash collision) or if the stored entry + ;; fails its own digest check (corruption / tampering). + (let ([hash-bv (content-hash-bytes value)] + [full-bv (content-hash-full-bytes value)]) + (let ([existing (hashtable-ref (vs-rec-table vs) hash-bv #f)]) + (cond + [(not existing) + (hashtable-set! (vs-rec-table vs) hash-bv (cons full-bv value)) + hash-bv] + [(not (and (pair? existing) + (bytevector? (car existing)) + (= (bytevector-length (car existing)) 32))) + (error 'value-store-put! + "stored value-store entry is corrupt" + (bytevector-length hash-bv))] + [(timing-safe-equal? (car existing) full-bv) + (vs-rec-dedup-count-set! vs (+ (vs-rec-dedup-count vs) 1)) + hash-bv] + [else + (error 'value-store-put! + "content-hash collision detected (8-byte slot)" + hash-bv)])))) (def (value-store-get vs hash-bv) - (let ([v (hashtable-ref (vs-rec-table vs) hash-bv #f)]) - (if v - (begin (vs-rec-hit-count-set! vs (+ (vs-rec-hit-count vs) 1)) v) - (begin (vs-rec-miss-count-set! vs (+ (vs-rec-miss-count vs) 1)) #f)))) + (let ([entry (hashtable-ref (vs-rec-table vs) hash-bv #f)]) + (cond + [(not entry) + (vs-rec-miss-count-set! vs (+ (vs-rec-miss-count vs) 1)) + #f] + [(not (and (pair? entry) + (bytevector? (car entry)) + (= (bytevector-length (car entry)) 32))) + (error 'value-store-get "stored value-store entry is corrupt" hash-bv)] + [(timing-safe-equal? (car entry) + (content-hash-full-bytes (cdr entry))) + (vs-rec-hit-count-set! vs (+ (vs-rec-hit-count vs) 1)) + (cdr entry)] + [else + (error 'value-store-get + "stored value fails full-digest verification (collision or corruption)" + hash-bv)]))) (def (value-store-has? vs hash-bv) (hashtable-contains? (vs-rec-table vs) hash-bv)) @@ -71,4 +108,11 @@ (cons 'misses (vs-rec-miss-count vs)) (cons 'dedup-saves (vs-rec-dedup-count vs)))) -) ;; end library + (def (value-store-test-inject-entry! vs hash-bv full-bv value) + ;; Test-only: install a (8-byte-hash -> (full-hash . value)) entry with a + ;; caller-chosen full digest so a self-test can simulate a content-hash + ;; collision that the put/get paths would otherwise never observe against + ;; real SHA-256. + (hashtable-set! (vs-rec-table vs) hash-bv (cons full-bv value))) + + ) ;; end library --- a/tests/test-core.ss +++ b/tests/test-core.ss @@ -9,6 +9,7 @@ (jerboa-db entity) (jerboa-db spec) (jerboa-db value-store) + (jerboa-db encoding) (jerboa-db index protocol) (jerboa-db index memory) (jerboa-db segment) @@ -756,6 +757,55 @@ (assert-equal (value-store-get vs hash1) "hello world") (assert-equal (value-store-get vs hash3) "different value"))) +(test "content-hash-full-bytes returns a 32-byte collision-resistant digest" + (let ([full (content-hash-full-bytes "content-addressed payload")] + [full2 (content-hash-full-bytes "content-addressed payload")] + [full3 (content-hash-full-bytes "content-addressed payload!")]) + ;; The full content-addressing digest is at least 16 bytes (2^64 birthday + ;; bound); SHA-256 gives 32 bytes (2^128 birthday bound). + (assert-true (>= (bytevector-length full) 16)) + (assert-equal (bytevector-length full) 32) + ;; Deterministic for equal input. + (assert-true (equal? full full2)) + ;; Distinct inputs hash to distinct digests. + (assert-true (not (equal? full full3))) + ;; The 8-byte index-key slot is a strict prefix of the full digest so the + ;; two views never disagree on the first 8 bytes. + (let ([short (content-hash-bytes "content-addressed payload")] + [prefix (make-bytevector 8)]) + (bytevector-copy! full 0 prefix 0 8) + (assert-true (equal? prefix short))))) + +(test "value store rejects an 8-byte content-hash collision on put" + ;; SHA-256 collisions are infeasible to find, so simulate one with the + ;; test-only injector: two distinct values share an 8-byte hash slot but + ;; carry different full digests. The put path must raise instead of + ;; silently deduplicating one value as the other. + (let* ([vs (make-value-store)] + [real "real-value"] + [real-full (content-hash-full-bytes real)] + [real-short (content-hash-bytes real)] + [forged-full (make-bytevector 32 0)] + [forged-value "forged-value"]) + ;; Real SHA-256 cannot be all-zero for a non-empty value, so the forged + ;; full digest is guaranteed to differ. + (assert-true (not (equal? real-full forged-full))) + (value-store-test-inject-entry! vs real-short forged-full forged-value) + (assert-raises (value-store-put! vs real)) + ;; The store still refuses to hand back the forged value under the + ;; colliding 8-byte key: the get path re-verifies the full digest. + (assert-raises (value-store-get vs real-short)))) + +(test "value store rejects a stored value whose full digest no longer matches" + ;; Tamper with the stored value behind a correct 8-byte key + full digest + ;; pair. The get path recomputes the full digest and rejects the mismatch. + (let* ([vs (make-value-store)] + [real "real-value"] + [real-short (value-store-put! vs real)] + [real-full (content-hash-full-bytes real)]) + (value-store-test-inject-entry! vs real-short real-full "tampered-value") + (assert-raises (value-store-get vs real-short)))) + (test "index cursor streams in order with early-exit" (let* ([is (make-mem-index-set)] [eavt (index-set-eavt is)] @@ -1143,6 +1193,63 @@ (assert-raises (segtree->list t ss)))) +(test "segment store ids are 32-byte content addresses and round-trip" + ;; The segment store is the durable content-addressed surface. Segment ids + ;; must be the full SHA-256 (32 bytes, >= 16) so a collision that lets one + ;; content-addressed value substitute for another is infeasible (~2^128 + ;; birthday bound); the previous 8-byte truncation only reached ~2^32. + (let* ([ss (make-mem-segstore)] + [cmp compare-datoms-eavt] + [ds (for/collect ([i (in-range 10)]) (make-datom i 1 i 1 #t))] + [t (segtree-build ss ds cmp 4)] + [ids (segtree-live-ids t)]) + ;; Every live segment id is the full 32-byte digest, not the 8-byte + ;; truncation, and the content-addressed round-trip returns the original + ;; datoms in order. + (assert-true (> (length ids) 0)) + (for-each + (lambda (id) + (assert-true (>= (bytevector-length id) 16)) + (assert-equal (bytevector-length id) 32)) + ids) + (assert-equal (map datom-e (segtree->list t ss)) (for/collect ([i (in-range 10)]) i))) + ;; The widened id is what reaches disk: each segment filename is 64 hex + ;; chars (32 bytes) plus ".seg", not the legacy 16 hex chars (8 bytes), and + ;; a fresh store handle over the directory still resolves the same ids. + (let* ([dir "/tmp/jdb-segtree-id-width-test"] + [_ (cleanup-dir-files dir)] + [_ (unless (file-exists? dir) (mkdir dir))] + [ss (make-fs-segstore dir)] + [cmp compare-datoms-eavt] + [ds (for/collect ([i (in-range 8)]) (make-datom i 1 i 1 #t))] + [t (segtree-build ss ds cmp 4)] + [ids (segtree-live-ids t)] + [fnames (directory-list dir)]) + (for-each + (lambda (id) (assert-equal (bytevector-length id) 32)) + ids) + ;; One segment file per live id, each named by the 64-hex-char id. + (assert-equal (length fnames) (length ids)) + (for-each + (lambda (fname) + (assert-equal (string-length fname) 68) ;; 64 hex + ".seg" + (assert-true (string=? (substring fname 64 68) ".seg")) + (let loop ([i 0]) + (cond [(= i 64) #t] + [(let ([c (string-ref fname i)]) + (or (and (char>=? c #\0) (char<=? c #\9)) + (and (char>=? c #\a) (char<=? c #\f)))) + (loop (+ i 1))] + [else (error 'segtree-id-width + "expected hex segment filename" fname)]))) + fnames) + ;; Content-addressed round-trip from a fresh store handle over the same + ;; directory resolves the persisted 32-byte ids back to the original + ;; datoms. + (let ([ss2 (make-fs-segstore dir)]) + (assert-equal (map datom-e (segtree->list t ss2)) + (for/collect ([i (in-range 8)]) i))))) + (test "transaction log uses framed safe records and rejects trailing truncation" (let* ([dir "/tmp/jdb-tx-log-safe-test"] [_ (unless (file-exists? dir) (mkdir dir))]