Add (std crypto compare) — timing-safe comparison
ober
77f548b33705644bebdc33fb24d8dac30d16900f
new file mode 100644 --- /dev/null +++ b/lib/std/crypto/compare.sls @@ -0,0 +1,34 @@ +#!chezscheme +;;; (std crypto compare) — Timing-safe comparison for secret material +;;; +;;; string=? and equal? short-circuit on first difference, leaking +;;; information via timing side channels. These functions always examine +;;; every byte, preventing timing attacks on password hashes, HMAC +;;; verification, API keys, and session tokens. + +(library (std crypto compare) + (export timing-safe-equal? timing-safe-string=?) + + (import (chezscheme)) + + (define (timing-safe-equal? a b) + ;; Constant-time bytevector comparison. + ;; Returns #t iff A and B have the same length and contents. + ;; Always examines every byte — no early exit on mismatch. + (let ([alen (bytevector-length a)] + [blen (bytevector-length b)]) + (if (not (= alen blen)) + #f + (let loop ([i 0] [acc 0]) + (if (>= i alen) + (zero? acc) + (loop (+ i 1) + (bitwise-ior acc + (bitwise-xor (bytevector-u8-ref a i) + (bytevector-u8-ref b i))))))))) + + (define (timing-safe-string=? a b) + ;; Constant-time string comparison via UTF-8 encoding. + (timing-safe-equal? (string->utf8 a) (string->utf8 b))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-crypto-compare.ss @@ -0,0 +1,78 @@ +#!chezscheme +;;; test-crypto-compare.ss -- Tests for (std crypto compare) + +(import (chezscheme) (std crypto compare)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax check + (syntax-rules (=>) + [(_ expr => expected) + (let ([result expr] [exp expected]) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin + (set! fail-count (+ fail-count 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write result) + (display " expected ") (write exp) (newline))))])) + +;; Equal bytevectors +(check (timing-safe-equal? #vu8(1 2 3) #vu8(1 2 3)) => #t) + +;; Different bytevectors (same length) +(check (timing-safe-equal? #vu8(1 2 3) #vu8(1 2 4)) => #f) + +;; Different lengths +(check (timing-safe-equal? #vu8(1 2 3) #vu8(1 2)) => #f) +(check (timing-safe-equal? #vu8(1 2) #vu8(1 2 3)) => #f) + +;; Empty bytevectors +(check (timing-safe-equal? #vu8() #vu8()) => #t) + +;; Single byte +(check (timing-safe-equal? #vu8(0) #vu8(0)) => #t) +(check (timing-safe-equal? #vu8(0) #vu8(1)) => #f) + +;; Single-byte difference in long bytevectors +(let ([a (make-bytevector 256 42)] + [b (make-bytevector 256 42)]) + (check (timing-safe-equal? a b) => #t) + (bytevector-u8-set! b 255 43) + (check (timing-safe-equal? a b) => #f)) + +;; All zeros vs all ones +(check (timing-safe-equal? (make-bytevector 32 0) (make-bytevector 32 255)) => #f) + +;; String comparison — equal +(check (timing-safe-string=? "hello" "hello") => #t) + +;; String comparison — different +(check (timing-safe-string=? "hello" "world") => #f) + +;; String comparison — different lengths +(check (timing-safe-string=? "hi" "hello") => #f) + +;; String comparison — empty +(check (timing-safe-string=? "" "") => #t) + +;; String comparison — unicode +(check (timing-safe-string=? "caf\x00e9;" "caf\x00e9;") => #t) +(check (timing-safe-string=? "caf\x00e9;" "cafe") => #f) + +;; Typical use case: HMAC comparison +(let ([expected (string->utf8 "a3f2b8c9d4e5f6a7")] + [received (string->utf8 "a3f2b8c9d4e5f6a7")]) + (check (timing-safe-equal? expected received) => #t)) + +(let ([expected (string->utf8 "a3f2b8c9d4e5f6a7")] + [received (string->utf8 "a3f2b8c9d4e5f6a8")]) + (check (timing-safe-equal? expected received) => #f)) + +(display " crypto-compare: ") +(display pass-count) (display " passed") +(when (> fail-count 0) + (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1))