test(logdb): add negative regression tests for container crypto (P1 #38)
ober
e8a8553c66b88fdd1072c1f30cdfd5f19fd1736d
--- a/Makefile +++ b/Makefile @@ -92,6 +92,7 @@ test: binary native-test-stage $(JEXEC) tests/test-tui-send-async.ss $(JEXEC) tests/test-bounded-line.ss $(JEXEC) tests/test-logdb-jsqlite.ss + $(JEXEC) tests/test-logdb-crypto.ss $(JEXEC) tests/test-secret-input.ss $(JEXEC) tests/test-attachments.ss $(JEXEC) tests/test-native-loader.ss new file mode 100644 --- /dev/null +++ b/tests/test-logdb-crypto.ss @@ -0,0 +1,148 @@ +#!chezscheme +;;; Negative regression tests for the encrypted jsqlite container crypto: +;;; deterministic counter nonces, anti-rollback, fail-closed authentication, +;;; and derived-key zeroing. + +(import (except (scheme) + 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) + (except (jerboa prelude) meta atom?) + (only (std security taint) safe-delete-file) + (signal logdb)) + +(def (check label pred) + (unless pred + (error 'test-logdb-crypto label))) + +(def (delete-if-exists! p) + (when (file-exists? p) (safe-delete-file p))) + +(def (read-file-bytevector p) + (let ([in (open-file-input-port p)]) + (let ([bv (get-bytevector-all in)]) + (close-port in) + (if (eof-object? bv) (make-bytevector 0 0) bv)))) + +(def (write-file-bytevector! p bv) + (let ([out (open-file-output-port p (file-options no-fail))]) + (put-bytevector out bv) + (close-port out))) + +(def (clean! p) + (delete-if-exists! p) + (delete-if-exists! (string-append p ".tmp")) + (delete-if-exists! (string-append p ".gen"))) + +;; Container layout: magic(13) || salt(16) || generation(8 BE) || sealed. +(def *magic-len* (bytevector-length (string->utf8 "JSQLITELOGv1\n"))) +(def *gen-offset* (+ *magic-len* 16)) + +(def (container-generation bv) + (bytevector-u64-ref bv *gen-offset* (endianness big))) + +;; Immediate persistence reseals the container on every put so each write is +;; observable on disk. +(putenv "JERBOA_SIGNAL_LOG_PERSIST" "immediate") + +(check "logdb backend available" (logdb-available?)) + +;; (a) Deterministic counter nonce: consecutive persists advance the generation +;; by exactly one, so the derived (key, nonce) pair is never reused. +(let ([p "/tmp/jerboa-signal-logdb-nonce-test.db"]) + (clean! p) + (let ([h (logdb-open p "nonce horse")]) + (check "nonce open" h) + (check "nonce put 1" + (logdb-put h "a" "in" "c" "s" 1 "data" "one" "{}")) + (let ([gen1 (container-generation (read-file-bytevector p))]) + (check "nonce put 2" + (logdb-put h "a" "in" "c" "s" 2 "data" "two" "{}")) + (let ([gen2 (container-generation (read-file-bytevector p))]) + (check "generation is positive" (> gen1 0)) + (check "persist advances counter nonce (no reuse)" + (= gen2 (+ gen1 1))))) + (logdb-close h)) + (clean! p)) + +;; (b) Rollback: restoring an older-generation container is rejected. +(let ([p "/tmp/jerboa-signal-logdb-rollback-test.db"]) + (clean! p) + (let ([h (logdb-open p "rollback horse")]) + (check "rollback open" h) + (check "rollback put 1" + (logdb-put h "a" "in" "c" "s" 1 "data" "old" "{}")) + (logdb-close h)) + (let ([old-container (read-file-bytevector p)]) + (let ([h (logdb-open p "rollback horse")]) + (check "rollback reopen" h) + (check "rollback put 2" + (logdb-put h "a" "in" "c" "s" 2 "data" "new" "{}")) + (logdb-close h)) + (check "generation advanced past saved container" + (> (container-generation (read-file-bytevector p)) + (container-generation old-container))) + (write-file-bytevector! p old-container) + (check "restored older container rejected (fail closed)" + (guard (e [(condition? e) #t]) + (let ([h (logdb-open p "rollback horse")]) + (when h (logdb-close h)) + #f)))) + (clean! p)) + +;; (b) Truncation: a zero-byte container is rejected when a prior generation +;; exists, instead of being treated as a fresh empty log. +(let ([p "/tmp/jerboa-signal-logdb-truncate-test.db"]) + (clean! p) + (let ([h (logdb-open p "truncate horse")]) + (check "truncate open" h) + (check "truncate put" + (logdb-put h "a" "in" "c" "s" 1 "data" "body" "{}")) + (logdb-close h)) + (write-file-bytevector! p (make-bytevector 0 0)) + (check "truncated-to-zero container rejected when prior generation exists" + (guard (e [(condition? e) #t]) + (let ([h (logdb-open p "truncate horse")]) + (when h (logdb-close h)) + #f))) + (clean! p)) + +;; (b) Wrong passphrase: a wrong non-blank passphrase yields a distinct +;; auth-failure condition, not #f and not a silent unencrypted fallback. +(let ([p "/tmp/jerboa-signal-logdb-authfail-test.db"]) + (clean! p) + (let ([h (logdb-open p "right horse")]) + (check "authfail open" h) + (check "authfail put" + (logdb-put h "a" "in" "c" "s" 1 "data" "secret" "{}")) + (logdb-close h)) + (check "wrong passphrase raises distinct auth error (fail closed)" + (guard (e [(condition? e) + (and (who-condition? e) + (eq? (condition-who e) 'logdb-passphrase-mismatch))]) + (let ([h (logdb-open p "wrong horse")]) + (when h (logdb-close h)) + #f))) + (clean! p)) + +;; Key zeroing: jlog-close! zeroes the derived AEAD key bytevector. +(let ([p "/tmp/jerboa-signal-logdb-keyzero-test.db"]) + (clean! p) + (let ([h (logdb-open p "zero horse")]) + (check "keyzero open" h) + (check "derived key live before close" + (not (logdb-handle-key-zeroed? h))) + (logdb-close h) + (check "derived key zeroed after close" + (logdb-handle-key-zeroed? h))) + (clean! p)) + +(putenv "JERBOA_SIGNAL_LOG_PERSIST" "") + +(display "logdb crypto regression ok") +(newline) --- a/tests/test-logdb-jsqlite.ss +++ b/tests/test-logdb-jsqlite.ss @@ -120,7 +120,15 @@ 1000 "data" "hello")))) (logdb-close h)) -(check "wrong key rejected" (not (logdb-open path "wrong horse"))) +;; A wrong passphrase must fail closed with a distinct auth error, not return +;; #f (which auto-mode would treat as "no log" and silently run unencrypted). +(check "wrong key fails closed with distinct auth error" + (guard (e [(condition? e) + (and (who-condition? e) + (eq? (condition-who e) 'logdb-passphrase-mismatch))]) + (let ([h (logdb-open path "wrong horse")]) + (when h (logdb-close h)) + #f))) ;; Reaching a batch threshold persists once, without waiting for close. (let ([batch-path (fresh-path "batch-threshold")])