Add (std crypto random) — CSPRNG module
ober
88b87fd3267bec831056aeb656c669b8ca0b45c8
new file mode 100644 --- /dev/null +++ b/lib/std/crypto/random.sls @@ -0,0 +1,92 @@ +#!chezscheme +;;; (std crypto random) — Cryptographically secure random number generation +;;; +;;; Reads from /dev/urandom for all random values. Never uses Chez's +;;; (random N) for security-relevant operations. + +(library (std crypto random) + (export + ;; Core + random-bytes random-bytes! + ;; Convenience + random-u64 random-token random-uuid) + + (import (chezscheme)) + + ;; ========== Core: /dev/urandom ========== + + (define (random-bytes n) + ;; Return a fresh bytevector of N cryptographically random bytes. + (let ([bv (make-bytevector n)]) + (when (> n 0) + (random-bytes! bv)) + bv)) + + (define (random-bytes! bv) + ;; Fill BV with cryptographically random bytes from /dev/urandom. + (let ([len (bytevector-length bv)]) + (when (> len 0) + (let ([port (open-file-input-port "/dev/urandom" + (file-options) + (buffer-mode block))]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let loop ([offset 0]) + (when (< offset len) + (let ([got (get-bytevector-n! port bv offset (- len offset))]) + (when (eof-object? got) + (error 'random-bytes! "unexpected EOF from /dev/urandom")) + (loop (+ offset got)))))) + (lambda () (close-port port))))))) + + ;; ========== Convenience ========== + + (define (random-u64) + ;; Return a random exact non-negative integer in [0, 2^64). + (let ([bv (random-bytes 8)]) + (bytevector-u64-ref bv 0 (endianness little)))) + + (define (random-token . args) + ;; Return a hex-encoded random string. Default 16 bytes = 32 hex chars. + (let* ([n (if (pair? args) (car args) 16)] + [bv (random-bytes n)]) + (bytevector->hex-string bv))) + + (define (random-uuid) + ;; Return a RFC 4122 version 4 UUID string. + (let ([bv (random-bytes 16)]) + ;; Set version: byte 6, high nibble = 0100 (version 4) + (bytevector-u8-set! bv 6 + (bitwise-ior #x40 (bitwise-and (bytevector-u8-ref bv 6) #x0f))) + ;; Set variant: byte 8, high 2 bits = 10 (RFC 4122) + (bytevector-u8-set! bv 8 + (bitwise-ior #x80 (bitwise-and (bytevector-u8-ref bv 8) #x3f))) + (format-uuid bv))) + + ;; ========== Helpers ========== + + (define hex-chars "0123456789abcdef") + + (define (bytevector->hex-string bv) + (let* ([len (bytevector-length bv)] + [out (make-string (* len 2))]) + (do ([i 0 (+ i 1)]) + ((= i len) out) + (let ([b (bytevector-u8-ref bv i)]) + (string-set! out (* i 2) + (string-ref hex-chars (bitwise-arithmetic-shift-right b 4))) + (string-set! out (+ (* i 2) 1) + (string-ref hex-chars (bitwise-and b #xf))))))) + + (define (format-uuid bv) + ;; Format 16-byte bytevector as 8-4-4-4-12 UUID string. + (let ([hex (bytevector->hex-string bv)]) + (string-append + (substring hex 0 8) "-" + (substring hex 8 12) "-" + (substring hex 12 16) "-" + (substring hex 16 20) "-" + (substring hex 20 32)))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-crypto-random.ss @@ -0,0 +1,90 @@ +#!chezscheme +;;; test-crypto-random.ss -- Tests for (std crypto random) + +(import (chezscheme) (std crypto random)) + +(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))))])) + +;; random-bytes returns correct length +(check (bytevector-length (random-bytes 0)) => 0) +(check (bytevector-length (random-bytes 1)) => 1) +(check (bytevector-length (random-bytes 16)) => 16) +(check (bytevector-length (random-bytes 32)) => 32) +(check (bytevector-length (random-bytes 256)) => 256) + +;; random-bytes returns bytevectors +(check (bytevector? (random-bytes 8)) => #t) + +;; Two calls produce different results (with overwhelming probability) +(let ([a (random-bytes 32)] + [b (random-bytes 32)]) + (check (equal? a b) => #f)) + +;; random-bytes! fills an existing bytevector +(let ([bv (make-bytevector 16 0)]) + (random-bytes! bv) + ;; At least some bytes should be non-zero (with overwhelming probability) + (check (for-all zero? (bytevector->u8-list bv)) => #f)) + +;; random-u64 returns a non-negative exact integer +(let ([n (random-u64)]) + (check (integer? n) => #t) + (check (exact? n) => #t) + (check (>= n 0) => #t)) + +;; Two random-u64 calls produce different results +(let ([a (random-u64)] + [b (random-u64)]) + (check (= a b) => #f)) + +;; random-token default is 32 hex chars (16 bytes) +(let ([tok (random-token)]) + (check (string-length tok) => 32) + ;; All characters are hex + (check (for-all (lambda (c) + (or (char<=? #\0 c #\9) + (char<=? #\a c #\f))) + (string->list tok)) + => #t)) + +;; random-token with explicit size +(let ([tok (random-token 8)]) + (check (string-length tok) => 16)) + +;; random-uuid format: 8-4-4-4-12 = 36 chars +(let ([uuid (random-uuid)]) + (check (string-length uuid) => 36) + ;; Dashes at correct positions + (check (char=? (string-ref uuid 8) #\-) => #t) + (check (char=? (string-ref uuid 13) #\-) => #t) + (check (char=? (string-ref uuid 18) #\-) => #t) + (check (char=? (string-ref uuid 23) #\-) => #t) + ;; Version nibble is 4 + (check (char=? (string-ref uuid 14) #\4) => #t) + ;; Variant nibble is 8, 9, a, or b + (check (and (member (string-ref uuid 19) '(#\8 #\9 #\a #\b)) #t) => #t)) + +;; Two UUIDs are different +(let ([a (random-uuid)] + [b (random-uuid)]) + (check (string=? a b) => #f)) + +(display " crypto-random: ") +(display pass-count) (display " passed") +(when (> fail-count 0) + (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1))