Add (std crypto native) — direct libcrypto FFI, complete Phase 2
ober
ee603e6ca0dce69f51961d43b86fb1dc6d2e1809
--- a/Makefile +++ b/Makefile @@ -247,7 +247,13 @@ test-security: @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-crypto-random.ss @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-crypto-compare.ss @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-crypto-digest.ss + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-crypto-native.ss @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-security-capability.ss + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-restrict-hardened.ss + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-process-exec.ss + @JERBOA_DB_HOST=evil.com JERBOA_DB_PORT=5433 JERBOA_SECRET=leaked $(SCHEME) --libdirs $(LIBDIRS) --script tests/test-config-env.ss + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-audit.ss + @$(SCHEME) --libdirs $(LIBDIRS) --script tests/test-sanitize.ss test-all: test test-features test-wrappers test-security --- a/docs/security.md +++ b/docs/security.md @@ -360,19 +360,18 @@ Typed configuration management. - Revocation table in `(std capability)` uses `equal-hash`/`equal?` hashtable for bytevector nonce keys - 23 tests verify CSPRNG correctness (length, non-determinism, UUID format, hex encoding) -### V4. Sandbox Escape Vectors — HIGH +### V4. Sandbox Escape Vectors — ~~HIGH~~ FIXED **File**: `lib/std/security/restrict.sls` -The sandbox copies the full `scheme-environment` and then blocks dangerous bindings. This is a blocklist — inherently incomplete. +**Status**: FIXED on `hardened` branch. -**Escape vectors**: -- `syntax-case` / `syntax-rules` can construct code that references blocked bindings indirectly -- `record-type-descriptor` access could reach runtime internals -- Any binding added in a future Chez version is automatically available -- `call/cc` (in safe list) can capture continuations that escape dynamic scope - -**Fix**: Create a bare `(environment)` and add only the 29 safe bindings. Nothing else exists. This is defense-in-depth: even if a safe binding is accidentally dangerous, the attack surface is bounded. +**What was fixed**: +- Replaced blocklist approach with allowlist-only: `(environment '(only (chezscheme) ...))` creates an environment with ONLY approved bindings +- Removed `call/cc` and `call-with-current-continuation` (can escape dynamic scope) +- No `eval`/`compile`/`load` available (no self-escape) +- Future Chez additions cannot leak into the sandbox +- 30 tests verify safe operations work and all dangerous operations are blocked ### V5. Weak Distributed Actor Authentication — HIGH @@ -391,33 +390,31 @@ The sandbox copies the full `scheme-environment` and then blocks dangerous bindi **Fix**: HMAC-SHA256 authentication with random nonce per connection. Mandatory TLS for all inter-node communication. Add timestamp + sequence number for replay protection. -### V6. Shell Injection in Process Execution — HIGH +### V6. Shell Injection in Process Execution — ~~HIGH~~ FIXED **File**: `lib/std/misc/process.sls` -```scheme -(define (build-command-string args) - ;; shell-quote attempts to escape, but relies on single-quote wrapping - ...) -``` - -**Issues**: -- `run-process` passes through shell — any metacharacter not in the escape set is dangerous -- `directory:` keyword is shell-interpolated — untrusted values exploitable -- Environment variables inherited by child process may contain secrets +**Status**: FIXED on `hardened` branch. -**Fix**: Add `run-process/exec` that uses `execvp` via FFI with an argv array — no shell involved. Make it the default. Keep `run-process/shell` as an explicit opt-in for cases that genuinely need shell features. +**What was fixed**: +- Added `run-process/exec` which requires args as a list of strings +- Each argument is individually strict-shell-quoted (single quotes with escaping) +- Shell metacharacters (`$(...)`, backticks, pipes, semicolons, `&&`) are treated as literal text +- Input validation rejects non-list, empty list, and non-string elements +- `run-process` (shell-based) retained for backward compatibility but `run-process/exec` is the safe default +- 15 tests verify injection prevention -### V7. Environment Variable Injection in Config — MEDIUM +### V7. Environment Variable Injection in Config — ~~MEDIUM~~ FIXED **File**: `lib/std/config.sls` -```scheme -;; env-override! reads /proc/self/environ and overrides ANY config key -;; matching JERBOA_* prefix — no validation, no whitelist -``` +**Status**: FIXED on `hardened` branch. -**Fix**: Add an `env-overridable` list to the schema that explicitly declares which keys can be overridden from environment. Default: empty (no overrides). +**What was fixed**: +- `env-override!` now checks schema for `env-overridable` flag (4th element in schema entry) +- Default-deny: no schema = no environment overrides allowed +- Only keys explicitly declared as overridable (4th element = `#t`) accept env var overrides +- 5 tests verify default-deny, blocking, and selective override behavior ### V8. WebSocket Handshake Stub — MEDIUM new file mode 100644 --- /dev/null +++ b/lib/std/crypto/native.sls @@ -0,0 +1,223 @@ +#!chezscheme +;;; (std crypto native) — Direct FFI bindings to OpenSSL libcrypto +;;; +;;; Replaces shell-based crypto with direct C library calls. +;;; Zero temp files, zero shell invocation, zero race conditions. + +(library (std crypto native) + (export + ;; Digest + native-md5 native-sha1 native-sha256 native-sha384 native-sha512 + native-digest + + ;; CSPRNG + native-random-bytes + native-random-bytes! + + ;; HMAC + native-hmac-sha256 + + ;; Timing-safe comparison + native-crypto-memcmp) + + (import (chezscheme)) + + ;; Load libcrypto + (define _libcrypto-loaded + (guard (e [#t #f]) + (load-shared-object "libcrypto.so") + #t)) + + (define _libcrypto-loaded-alt + (if _libcrypto-loaded #t + (guard (e [#t #f]) + (load-shared-object "libcrypto.so.3") + #t))) + + (define libcrypto-available? + (or _libcrypto-loaded _libcrypto-loaded-alt)) + + ;; ========== EVP Digest Functions ========== + + (define c-EVP_MD_CTX_new + (if libcrypto-available? + (foreign-procedure "EVP_MD_CTX_new" () uptr) + (lambda () 0))) + + (define c-EVP_MD_CTX_free + (if libcrypto-available? + (foreign-procedure "EVP_MD_CTX_free" (uptr) void) + (lambda (ctx) (void)))) + + (define c-EVP_DigestInit_ex + (if libcrypto-available? + (foreign-procedure "EVP_DigestInit_ex" (uptr uptr uptr) int) + (lambda (ctx md impl) 0))) + + (define c-EVP_DigestUpdate + (if libcrypto-available? + (foreign-procedure "EVP_DigestUpdate" (uptr u8* int) int) + (lambda (ctx data len) 0))) + + (define c-EVP_DigestFinal_ex + (if libcrypto-available? + (foreign-procedure "EVP_DigestFinal_ex" (uptr u8* u8*) int) + (lambda (ctx md s) 0))) + + (define c-EVP_md5 + (if libcrypto-available? + (foreign-procedure "EVP_md5" () uptr) + (lambda () 0))) + + (define c-EVP_sha1 + (if libcrypto-available? + (foreign-procedure "EVP_sha1" () uptr) + (lambda () 0))) + + (define c-EVP_sha256 + (if libcrypto-available? + (foreign-procedure "EVP_sha256" () uptr) + (lambda () 0))) + + (define c-EVP_sha384 + (if libcrypto-available? + (foreign-procedure "EVP_sha384" () uptr) + (lambda () 0))) + + (define c-EVP_sha512 + (if libcrypto-available? + (foreign-procedure "EVP_sha512" () uptr) + (lambda () 0))) + + ;; ========== RAND Functions ========== + + (define c-RAND_bytes + (if libcrypto-available? + (foreign-procedure "RAND_bytes" (u8* int) int) + (lambda (buf n) 0))) + + ;; ========== HMAC Function ========== + + (define c-HMAC + (if libcrypto-available? + (foreign-procedure "HMAC" (uptr u8* int u8* int u8* u8*) uptr) + (lambda args 0))) + + ;; ========== CRYPTO_memcmp ========== + + (define c-CRYPTO_memcmp + (if libcrypto-available? + (foreign-procedure "CRYPTO_memcmp" (u8* u8* int) int) + (lambda (a b n) -1))) + + ;; ========== High-Level API ========== + + (define (ensure-libcrypto! who) + (unless libcrypto-available? + (error who "libcrypto not available — install OpenSSL"))) + + (define (evp-digest md-func digest-size data) + (ensure-libcrypto! 'native-digest) + (let ([input (if (bytevector? data) data (string->utf8 data))] + [md-buf (make-bytevector digest-size)] + [len-buf (make-bytevector 4 0)] + [ctx (c-EVP_MD_CTX_new)]) + (when (= ctx 0) + (error 'native-digest "EVP_MD_CTX_new failed")) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([r1 (c-EVP_DigestInit_ex ctx (md-func) 0)]) + (when (= r1 0) + (error 'native-digest "EVP_DigestInit_ex failed")) + (let ([r2 (c-EVP_DigestUpdate ctx input (bytevector-length input))]) + (when (= r2 0) + (error 'native-digest "EVP_DigestUpdate failed")) + (let ([r3 (c-EVP_DigestFinal_ex ctx md-buf len-buf)]) + (when (= r3 0) + (error 'native-digest "EVP_DigestFinal_ex failed")) + md-buf)))) + (lambda () + (c-EVP_MD_CTX_free ctx))))) + + (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)] + [hi (bitwise-arithmetic-shift-right b 4)] + [lo (bitwise-and b #xf)]) + (string-set! out (* i 2) (hex-digit hi)) + (string-set! out (+ (* i 2) 1) (hex-digit lo)))))) + + (define (hex-digit n) + (string-ref "0123456789abcdef" n)) + + ;; Public digest API — returns hex string + (define (native-md5 data) + (bytevector->hex-string (native-digest 'md5 data))) + (define (native-sha1 data) + (bytevector->hex-string (native-digest 'sha1 data))) + (define (native-sha256 data) + (bytevector->hex-string (native-digest 'sha256 data))) + (define (native-sha384 data) + (bytevector->hex-string (native-digest 'sha384 data))) + (define (native-sha512 data) + (bytevector->hex-string (native-digest 'sha512 data))) + + (define (native-digest algo data) + ;; Returns raw bytevector digest. + (case algo + [(md5) (evp-digest c-EVP_md5 16 data)] + [(sha1) (evp-digest c-EVP_sha1 20 data)] + [(sha256) (evp-digest c-EVP_sha256 32 data)] + [(sha384) (evp-digest c-EVP_sha384 48 data)] + [(sha512) (evp-digest c-EVP_sha512 64 data)] + [else (error 'native-digest "unknown algorithm" algo)])) + + ;; CSPRNG + (define (native-random-bytes n) + (ensure-libcrypto! 'native-random-bytes) + (let ([bv (make-bytevector n)]) + (when (> n 0) + (let ([r (c-RAND_bytes bv n)]) + (when (not (= r 1)) + (error 'native-random-bytes "RAND_bytes failed")))) + bv)) + + (define (native-random-bytes! bv) + (ensure-libcrypto! 'native-random-bytes!) + (let ([n (bytevector-length bv)]) + (when (> n 0) + (let ([r (c-RAND_bytes bv n)]) + (when (not (= r 1)) + (error 'native-random-bytes! "RAND_bytes failed")))))) + + ;; HMAC-SHA256 + (define (native-hmac-sha256 key data) + ;; key and data are bytevectors. Returns 32-byte bytevector. + (ensure-libcrypto! 'native-hmac-sha256) + (let ([key-bv (if (string? key) (string->utf8 key) key)] + [data-bv (if (string? data) (string->utf8 data) data)] + [out (make-bytevector 32)] + [len-buf (make-bytevector 4 0)]) + (let ([r (c-HMAC (c-EVP_sha256) + key-bv (bytevector-length key-bv) + data-bv (bytevector-length data-bv) + out len-buf)]) + (when (= r 0) + (error 'native-hmac-sha256 "HMAC failed")) + out))) + + ;; Timing-safe comparison + (define (native-crypto-memcmp a b) + ;; Compare two bytevectors in constant time. Returns #t if equal. + (ensure-libcrypto! 'native-crypto-memcmp) + (let ([a-bv (if (string? a) (string->utf8 a) a)] + [b-bv (if (string? b) (string->utf8 b) b)]) + (if (not (= (bytevector-length a-bv) (bytevector-length b-bv))) + #f + (= 0 (c-CRYPTO_memcmp a-bv b-bv (bytevector-length a-bv)))))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-crypto-native.ss @@ -0,0 +1,110 @@ +#!chezscheme +;;; test-crypto-native.ss -- Tests for (std crypto native) — libcrypto FFI + +(import (chezscheme) (std crypto native)) + +(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))))])) + +;; === Digest Tests (NIST vectors) === + +(check (native-sha256 "") + => "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855") +(check (native-sha256 "hello") + => "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824") +(check (native-sha256 "The quick brown fox jumps over the lazy dog") + => "d7a8fbb307d7809469ca9abcb0082e4f8d5651e46d3cdb762d02d0bf37c9e592") + +(check (native-md5 "") + => "d41d8cd98f00b204e9800998ecf8427e") +(check (native-md5 "hello") + => "5d41402abc4b2a76b9719d911017c592") + +(check (native-sha1 "") + => "da39a3ee5e6b4b0d3255bfef95601890afd80709") + +(check (native-sha384 "") + => "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b") + +(check (native-sha512 "") + => "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e") + +;; Bytevector input +(check (native-sha256 #vu8(104 101 108 108 111)) + => "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824") + +;; Raw digest returns bytevector +(let ([bv (native-digest 'sha256 "hello")]) + (check (bytevector? bv) => #t) + (check (bytevector-length bv) => 32)) + +(let ([bv (native-digest 'md5 "hello")]) + (check (bytevector-length bv) => 16)) + +;; === CSPRNG Tests === + +(check (bytevector-length (native-random-bytes 0)) => 0) +(check (bytevector-length (native-random-bytes 16)) => 16) +(check (bytevector-length (native-random-bytes 32)) => 32) +(check (bytevector? (native-random-bytes 8)) => #t) + +;; Two calls produce different results +(let ([a (native-random-bytes 32)] + [b (native-random-bytes 32)]) + (check (equal? a b) => #f)) + +;; native-random-bytes! fills existing bytevector +(let ([bv (make-bytevector 16 0)]) + (native-random-bytes! bv) + (check (for-all zero? (bytevector->u8-list bv)) => #f)) + +;; === HMAC-SHA256 Tests === + +;; Known test vector (RFC 4231 Test Case 2) +(let ([hmac (native-hmac-sha256 + (string->utf8 "Jefe") + (string->utf8 "what do ya want for nothing?"))]) + (check (bytevector? hmac) => #t) + (check (bytevector-length hmac) => 32)) + +;; String convenience +(let ([hmac (native-hmac-sha256 "key" "message")]) + (check (bytevector-length hmac) => 32)) + +;; Same key+data produces same HMAC +(let ([a (native-hmac-sha256 "key" "data")] + [b (native-hmac-sha256 "key" "data")]) + (check (equal? a b) => #t)) + +;; Different key produces different HMAC +(let ([a (native-hmac-sha256 "key1" "data")] + [b (native-hmac-sha256 "key2" "data")]) + (check (equal? a b) => #f)) + +;; === Timing-Safe Comparison Tests === + +(check (native-crypto-memcmp #vu8(1 2 3) #vu8(1 2 3)) => #t) +(check (native-crypto-memcmp #vu8(1 2 3) #vu8(1 2 4)) => #f) +(check (native-crypto-memcmp #vu8(1 2) #vu8(1 2 3)) => #f) +(check (native-crypto-memcmp #vu8() #vu8()) => #t) +(check (native-crypto-memcmp "hello" "hello") => #t) +(check (native-crypto-memcmp "hello" "world") => #f) + +(display " crypto-native: ") +(display pass-count) (display " passed") +(when (> fail-count 0) + (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1))