Harden crypto boundaries and native loading
ober
77a010d5b52643e7b547216c0963ea796f89628e
--- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -17,7 +17,7 @@ jobs: build-test-audit: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Install system tools run: | --- a/.github/workflows/security-baseline.yml +++ b/.github/workflows/security-baseline.yml @@ -13,7 +13,7 @@ jobs: baseline: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Required release files run: | --- a/Makefile +++ b/Makefile @@ -1,6 +1,7 @@ JERBOA_VERSION ?= v0.2.3 JERBOA_TOOL_DIR ?= $(CURDIR)/.jerboa/bin JERBUILD ?= $(shell if [ -x "$(CURDIR)/../jerboa/dist/jerbuild" ]; then printf '%s\n' "$(CURDIR)/../jerboa/dist/jerbuild"; elif command -v jerbuild >/dev/null 2>&1; then command -v jerbuild; else printf '%s\n' "$(JERBOA_TOOL_DIR)/jerbuild"; fi) +JERBUILD_ABS = $(abspath $(JERBUILD)) JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) LIBDIRS = lib:$(JH)/lib @@ -17,6 +18,14 @@ HARDEN_LDFLAGS ?= # patched Homebrew line available. UNAME := $(shell uname -s) ifeq ($(UNAME),Darwin) +# Apple ASan can hang before main when a Homebrew crypto dylib is involved; +# execute UBSan locally and leave ASan runtime execution to Linux target CI. +DEFAULT_SANITIZER_CFLAGS := -O1 -g -fno-omit-frame-pointer -fsanitize=undefined +else +DEFAULT_SANITIZER_CFLAGS := -O1 -g -fno-omit-frame-pointer -fsanitize=address,undefined +endif +SANITIZER_CFLAGS ?= $(DEFAULT_SANITIZER_CFLAGS) +ifeq ($(UNAME),Darwin) OPENSSL_PREFIX ?= $(shell brew --prefix openssl@4 2>/dev/null || brew --prefix openssl@3 2>/dev/null) ifneq ($(OPENSSL_PREFIX),) OPENSSL_CFLAGS := -I$(OPENSSL_PREFIX)/include @@ -36,7 +45,7 @@ CFLAGS ?= -shared -fPIC -O2 $(WARN_CFLAGS) $(HARDEN_CFLAGS) $(OPENSSL_CFLAGS) LIBS ?= $(HARDEN_LDFLAGS) $(OPENSSL_LIBS) SHIM = jerboa_crypto_shim.so -.PHONY: all build transpile test clean shim ensure-jerboa-tools security audit openssl-advisory-check sbom reproducibility-report target-evidence verify release-evidence +.PHONY: all build transpile test test-loader test-native scrypt-benchmark clean shim ensure-jerboa-tools security audit openssl-advisory-check sbom reproducibility-report target-evidence verify release-evidence all: build @@ -58,10 +67,26 @@ build: shim transpile test: build @JERBOA_CRYPTO_LIB=$(CURDIR) \ - DYLD_LIBRARY_PATH=$(CURDIR) \ - LD_LIBRARY_PATH=$(CURDIR) \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ $(JERBUILD) exec --libdirs "$(LIBDIRS)" tests/crypto-test.ss +test-loader: build + @JERBUILD="$(JERBUILD_ABS)" CC="$(CC)" sh scripts/loader-policy-test.sh + +test-native: + @tmp=$$(mktemp -d); trap 'rm -rf "$$tmp"' EXIT; \ + $(CC) $(WARN_CFLAGS) $(SANITIZER_CFLAGS) $(OPENSSL_CFLAGS) \ + -o "$$tmp/shim-security-test" \ + tests/shim-security-test.c jerboa_crypto_shim.c \ + $(OPENSSL_LIBS); \ + "$$tmp/shim-security-test" + +scrypt-benchmark: build + @JERBOA_CRYPTO_LIB=$(CURDIR) \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + /usr/bin/time -p $(JERBUILD) exec --libdirs "$(LIBDIRS)" \ + tests/scrypt-benchmark.ss + security: scripts/security-check.sh @sh scripts/security-check.sh @@ -81,9 +106,9 @@ reproducibility-report: target-evidence: scripts/target-evidence.sh @REPO_ROOT="$(CURDIR)" TARGET_EVIDENCE_DIR="$(TARGET_EVIDENCE_DIR)" sh scripts/target-evidence.sh -verify: security test audit sbom reproducibility-report target-evidence +verify: security test test-loader test-native audit sbom reproducibility-report target-evidence -release-evidence: security test audit target-evidence +release-evidence: security test test-loader test-native audit target-evidence rm -rf "$(DIST_DIR)" mkdir -p "$(DIST_DIR)" OPENSSL="$(OPENSSL_BIN)" scripts/openssl-advisory-check.sh "$(DIST_DIR)/openssl-advisory-check.txt" @@ -100,6 +125,8 @@ release-evidence: security test audit target-evidence "$(OPENSSL_BIN)" version -a > "$(DIST_DIR)/openssl-version.txt" $(MAKE) security > "$(DIST_DIR)/security.log" 2>&1 $(MAKE) test > "$(DIST_DIR)/test.log" 2>&1 + $(MAKE) test-loader > "$(DIST_DIR)/loader-policy.log" 2>&1 + $(MAKE) test-native > "$(DIST_DIR)/native-security.log" 2>&1 $(MAKE) audit > "$(DIST_DIR)/audit.log" 2>&1 @if command -v otool >/dev/null 2>&1; then \ otool -L "$(SHIM)" > "$(DIST_DIR)/native-linkage.txt"; \ --- a/README.md +++ b/README.md @@ -19,6 +19,9 @@ gates in `SECURITY.md` are complete. ```bash make make test +make test-loader +make test-native +make scrypt-benchmark make audit make sbom make reproducibility-report @@ -68,7 +71,25 @@ Production consumers should use the default allowlist in - `(ed25519-verify pubkey message signature)` → #t/#f ### KDF -- `(scrypt password salt size [N r p])` → derived key bytevector +- `(scrypt password salt size [N r p])` → derived key bytevector. The + three-argument form uses version-1 policy `N=65536, r=8, p=2` (64 MiB). +- `(scrypt-memory-bytes N r)` and `(scrypt-work-factor N r p)` expose concrete + cost estimates; `(scrypt-parameters-acceptable? N r p)` checks policy. +- `(scrypt-password-hash password)` creates a random-salt, parameter-encoded + record; `(scrypt-password-verify? password record)` verifies it in constant + time and `(scrypt-password-needs-rehash? record)` signals policy upgrades. + +The explicit form still enforces power-of-two `N`, salt/output/input bounds, +8–256 MiB estimated memory, and bounded work. It does not provide an escape +hatch for the former `N=1024, r=8, p=16` profile. + +Dynamic development loading is disabled unless both +`JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1` and an exact canonical absolute +`JERBOA_CRYPTO_LIB` directory are supplied. Production binaries should +pre-register the shim symbols; CWD, bare-name, relative, symlinked, writable, +and privileged-process overrides are rejected. +Inherited DYLD/LD search overrides are also rejected before any development +load, and every provider must expose the JCR1 ABI canary and symbol closure. ## License --- a/SECURITY.md +++ b/SECURITY.md @@ -39,12 +39,19 @@ must be cut from a clean checkout after: construction and padding behavior review is recorded. - Cipher APIs validate key, IV, nonce, tag, and Ed25519 key lengths before crossing the native boundary. +- The default scrypt policy is versioned and encoded with stored password + records. Structural, memory, work, salt, password, and output limits are + enforced in Scheme and C; parameter changes require target benchmarking and + an explicit policy-version review. - See `docs/ffi-boundary.md` for ownership, lifetime, and release-review notes. ## FFI Expectations -- Native symbols are loaded lazily through `(jerboa ffi)` so imports and static - binaries do not crash before the caller needs crypto functionality. +- Native symbols are loaded lazily through `(jerboa ffi)`. Production uses + pre-registered symbols; dynamic development loading requires an explicit + trusted absolute path and is forbidden for privileged processes. Never add + CWD, relative, bare-name, symlink, writable-directory, or ambient DYLD/LD + search fallbacks. Require the JCR1 ABI canary before binding functions. - Scheme owns all bytevector inputs and outputs. C functions must treat pointers as borrowed for the duration of the call. - C entry points must reject null pointers and negative lengths even when the --- a/docs/algorithm-policy.md +++ b/docs/algorithm-policy.md @@ -13,8 +13,42 @@ Use these names for new designs unless a protocol standard requires otherwise: - HMAC: `hmac-sha256`, `hmac-sha384`, `hmac-sha512`. - AEAD encryption: `chacha20-poly1305`, `aes-256-gcm`, or `aes-128-gcm`. - Signatures: Ed25519. -- Password KDF: `scrypt` with parameters selected by the calling protocol and - documented in that protocol's release evidence. +- Password KDF: version-1 `scrypt` with `N=65536, r=8, p=2`, a 16-byte random + salt, and a 32-byte stored verifier. This is the 64 MiB tradeoff profile from + the OWASP Password Storage guidance. The local release host measured one + derivation at 0.30 seconds with `make scrypt-benchmark`; deployment targets + must benchmark independently and retain sub-second verification latency. + +## Scrypt Parameter And Record Policy + +The three-argument `scrypt` API uses the version-1 profile above. Explicit +parameters are accepted only when all of these hold: + +- `N` is a power of two, greater than one, and no larger than 262144. +- `1 <= r <= 32` and `1 <= p <= 16`. +- estimated memory `128*N*r` is between 8 MiB and 256 MiB. +- work estimate `N*r*p` is between 655360 and 4194304. +- salt is 16–1024 bytes, output is 1–1024 bytes, and password input is at most + 1 MiB. + +These bounds cover OWASP's documented scrypt tradeoffs while rejecting the old +1 MiB profile. RFC 7914's structural power-of-two rule is enforced before the +native call, and the C shim independently repeats the policy and sets an +OpenSSL `maxmem_bytes` ceiling. + +`scrypt-password-hash` emits this strict record: + +```text +$jerboa-scrypt$v=1$N=65536,r=8,p=2$<salt-hex>$<hash-hex> +``` + +Verification rejects malformed, duplicate/reordered, oversized, unknown- +version, structurally invalid, or below-policy records. Successful logins can +call `scrypt-password-needs-rehash?` and replace older accepted profiles with +the version-1 default. See the [OWASP Password Storage Cheat +Sheet](https://cheatsheetseries.owasp.org/cheatsheets/Password_Storage_Cheat_Sheet.html), +[RFC 7914](https://www.rfc-editor.org/rfc/rfc7914), and the [OpenSSL scrypt +controls](https://docs.openssl.org/3.0/man3/EVP_PKEY_CTX_set_scrypt_N/). ## Legacy Or Compatibility Only @@ -47,5 +81,7 @@ Every release candidate should record: toolchain/linkage. - Reproducibility evidence for the native shim and generated library. - Any protocol-specific deviations from the default allowlist above. +- The `make scrypt-benchmark` result for every supported release target and any + decision to introduce a new encoded policy version. - Marker-complete target proof for external crypto/FFI review and downstream protocol integration review before production support is claimed. --- a/docs/ffi-boundary.md +++ b/docs/ffi-boundary.md @@ -11,8 +11,13 @@ names and names containing NUL before passing them to C. - Native pointers are borrowed. C must not retain Scheme-owned bytevectors after returning. -- The shared object is loaded lazily through `(jerboa ffi)` to avoid import-time - crashes in static binaries or feature probes. +- The shared object is loaded lazily through `(jerboa ffi)`. Pre-registered + symbols are preferred. Dynamic loading is development-only and requires an + explicit canonical absolute path whose file and every parent are root- or + user-owned, regular/directory as appropriate, and not group/world writable. + CWD, bare names, symlinks, privileged-process overrides, and inherited + DYLD/LD search paths are rejected. The JCR1 ABI canary and representative + symbol closure are mandatory after either static or dynamic discovery. ## Memory And Lifetime Rules @@ -23,6 +28,10 @@ before passing pointers to `EVP_*` APIs. - C entry points reject null pointers, negative lengths, and unsupported tag or Ed25519 key sizes as a second line of defense. +- Scrypt parameters are checked on both sides of the FFI boundary for + power-of-two structure, input/output bounds, 8–256 MiB estimated memory, and + bounded work. OpenSSL receives an explicit 320 MiB `maxmem_bytes` ceiling so + the accepted 256 MiB policy maximum has room for implementation overhead. - Streaming context pointers returned by OpenSSL must be freed with the matching `free-*` procedure. @@ -54,3 +63,5 @@ Before production release: - OpenSSL CVE status and platform support must be documented in release notes or `docs/openssl-advisory-review.md`. - Algorithm-policy exceptions must be documented. +- Loader adversarial tests, native policy tests, stored-password record tests, + and the target scrypt benchmark must accompany policy changes. --- a/jerboa_crypto_shim.c +++ b/jerboa_crypto_shim.c @@ -8,9 +8,26 @@ #include <openssl/err.h> #include <openssl/kdf.h> #include <openssl/crypto.h> +#include <stdint.h> #include <stdlib.h> #include <string.h> +#define JERBOA_SCRYPT_MIN_MEMORY_BYTES (8ULL * 1024ULL * 1024ULL) +#define JERBOA_SCRYPT_MAX_MEMORY_BYTES (256ULL * 1024ULL * 1024ULL) +#define JERBOA_SCRYPT_OPENSSL_MAXMEM_BYTES (320ULL * 1024ULL * 1024ULL) +#define JERBOA_SCRYPT_MIN_WORK 655360ULL +#define JERBOA_SCRYPT_MAX_WORK 4194304ULL +#define JERBOA_SCRYPT_MAX_N 262144ULL +#define JERBOA_SCRYPT_MAX_R 32 +#define JERBOA_SCRYPT_MAX_P 16 +#define JERBOA_SCRYPT_MAX_PASSWORD_BYTES (1024 * 1024) +#define JERBOA_SCRYPT_MIN_SALT_BYTES 16 +#define JERBOA_SCRYPT_MAX_SALT_BYTES 1024 +#define JERBOA_SCRYPT_MAX_OUTPUT_BYTES 1024 + +/* Native loader ABI canary: "JCR1". */ +uint32_t jerboa_crypto_abi_version(void) { return 0x4a435231u; } + static int bad_len(int len) { return len < 0; } @@ -19,6 +36,25 @@ static int missing_input(const void *ptr, int len) { return len > 0 && ptr == NULL; } +static int valid_scrypt_parameters(uint64_t n, int r, int p) { + uint64_t memory; + uint64_t work; + + if (n <= 1 || n > JERBOA_SCRYPT_MAX_N || (n & (n - 1)) != 0 || + r <= 0 || r > JERBOA_SCRYPT_MAX_R || + p <= 0 || p > JERBOA_SCRYPT_MAX_P) { + return 0; + } + if (n > UINT64_MAX / (128ULL * (uint64_t)r)) return 0; + memory = 128ULL * n * (uint64_t)r; + if (n > UINT64_MAX / ((uint64_t)r * (uint64_t)p)) return 0; + work = n * (uint64_t)r * (uint64_t)p; + return memory >= JERBOA_SCRYPT_MIN_MEMORY_BYTES && + memory <= JERBOA_SCRYPT_MAX_MEMORY_BYTES && + work >= JERBOA_SCRYPT_MIN_WORK && + work <= JERBOA_SCRYPT_MAX_WORK; +} + /* ---- Error handling ---- */ int jerboa_crypto_err_get(char *buf, int buflen) { @@ -445,14 +481,17 @@ int jerboa_bn_bytes(const unsigned char *bin, int binlen) { /* ---- Scrypt KDF ---- */ -int jerboa_scrypt(const unsigned char *pass, int passlen, +int jerboa_crypto_scrypt(const unsigned char *pass, int passlen, const unsigned char *salt, int saltlen, unsigned long long N, int r, int p, unsigned char *out, int outlen) { - if (out == NULL || outlen <= 0 || + if (out == NULL || outlen <= 0 || outlen > JERBOA_SCRYPT_MAX_OUTPUT_BYTES || bad_len(passlen) || bad_len(saltlen) || + passlen > JERBOA_SCRYPT_MAX_PASSWORD_BYTES || + saltlen < JERBOA_SCRYPT_MIN_SALT_BYTES || + saltlen > JERBOA_SCRYPT_MAX_SALT_BYTES || missing_input(pass, passlen) || missing_input(salt, saltlen) || - N <= 1 || r <= 0 || p <= 0) { + !valid_scrypt_parameters((uint64_t)N, r, p)) { return -10; } EVP_PKEY_CTX *pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_SCRYPT, NULL); @@ -465,6 +504,8 @@ int jerboa_scrypt(const unsigned char *pass, int passlen, EVP_PKEY_CTX_set_scrypt_N(pctx, N) == 1 && EVP_PKEY_CTX_set_scrypt_r(pctx, r) == 1 && EVP_PKEY_CTX_set_scrypt_p(pctx, p) == 1 && + EVP_PKEY_CTX_set_scrypt_maxmem_bytes( + pctx, JERBOA_SCRYPT_OPENSSL_MAXMEM_BYTES) == 1 && EVP_PKEY_derive(pctx, out, &derived_len) == 1) { rc = (int)derived_len; } new file mode 100755 --- /dev/null +++ b/scripts/loader-policy-test.sh @@ -0,0 +1,109 @@ +#!/bin/sh +set -eu + +root=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +jerbuild=${JERBUILD:-"$root/../jerboa/dist/jerbuild"} +jerboa_home=$($jerbuild --jerboa-home) +libdirs="$root/lib:$jerboa_home/lib" +probe="$root/tests/loader-probe.ss" +tmp=$(mktemp -d) +trap 'chmod -R u+w "$tmp" 2>/dev/null || true; rm -rf "$tmp"' EXIT HUP INT TERM +chmod 700 "$tmp" + +attacker="$tmp/attacker" +mkdir -m 700 "$attacker" +sentinel="$attacker/jerboa_crypto_shim.so" +marker="$tmp/sentinel-loaded" +${CC:-cc} -shared -fPIC -Wall -Wextra -Werror \ + -o "$sentinel" "$root/tests/loader-sentinel.c" + +run_probe() { + ( + cd "$attacker" + env -i \ + HOME="${HOME:-}" \ + PATH="$PATH" \ + TMPDIR="${TMPDIR:-/tmp}" \ + JERBOA_SENTINEL_MARKER="$marker" \ + "$@" \ + "$jerbuild" exec --libdirs "$libdirs" "$probe" + ) +} + +expect_failure() { + label=$1 + shift + if run_probe "$@" >"$tmp/$label.out" 2>"$tmp/$label.err"; then + printf 'loader policy test unexpectedly succeeded: %s\n' "$label" >&2 + exit 1 + fi + if [ -e "$marker" ]; then + printf 'loader policy test executed sentinel: %s\n' "$label" >&2 + exit 1 + fi +} + +expect_failure cwd-search +expect_failure relative-override \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB=. + +ln -s "$root" "$tmp/symlink-base" +expect_failure symlink-base \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB="$tmp/symlink-base" + +mkdir -m 700 "$tmp/symlink-final" +ln -s "$root/jerboa_crypto_shim.so" \ + "$tmp/symlink-final/jerboa_crypto_shim.so" +expect_failure symlink-final \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB="$tmp/symlink-final" + +mkdir -m 700 "$tmp/writable-base" +cp "$sentinel" "$tmp/writable-base/jerboa_crypto_shim.so" +chmod 777 "$tmp/writable-base" +expect_failure writable-base \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB="$tmp/writable-base" + +expect_failure ambient-loader-environment \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB="$root" \ + DYLD_LIBRARY_PATH="$root" \ + LD_LIBRARY_PATH="$root" + +valid_output=$(run_probe \ + JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE=1 \ + JERBOA_CRYPTO_LIB="$root") +if [ "$valid_output" != "1" ]; then + printf 'trusted loader probe returned unexpected output: %s\n' "$valid_output" >&2 + exit 1 +fi +if [ -e "$marker" ]; then + printf '%s\n' 'trusted loader probe executed the CWD sentinel' >&2 + exit 1 +fi + +case $(uname -s) in + Darwin) + preloaded_output=$(run_probe DYLD_INSERT_LIBRARIES="$root/jerboa_crypto_shim.so") + ;; + Linux|FreeBSD) + preloaded_output=$(run_probe LD_PRELOAD="$root/jerboa_crypto_shim.so") + ;; + *) + preloaded_output=1 + ;; +esac +if [ "$preloaded_output" != "1" ]; then + printf 'pre-registered-symbol probe returned unexpected output: %s\n' \ + "$preloaded_output" >&2 + exit 1 +fi +if [ -e "$marker" ]; then + printf '%s\n' 'pre-registered-symbol probe executed the CWD sentinel' >&2 + exit 1 +fi + +printf '%s\n' 'loader-policy-test: ok' --- a/scripts/security-check.sh +++ b/scripts/security-check.sh @@ -34,6 +34,11 @@ require_file scripts/reproducibility-report.sh require_file scripts/sbom.sh require_file scripts/target-evidence.sh require_file scripts/sanitize-evidence.sh +require_file scripts/loader-policy-test.sh +require_file tests/loader-probe.ss +require_file tests/loader-sentinel.c +require_file tests/shim-security-test.c +require_file tests/scrypt-benchmark.ss if ! grep -q 'JCRYPTO_TARGET_PROOF_FILE' .jerboa/security.json || ! grep -q 'JCRYPTO_TARGET_PROOF_FILE' SECURITY.md docs/release-evidence.md README.md || @@ -57,11 +62,42 @@ check_empty "raw foreign-procedure in Scheme" \ rg -n -e 'foreign-procedure' --glob '*.ss' src tests if ! grep -q 'load-shared-object[*]' src/jerboa-crypto.ss || - ! grep -q '(jerboa ffi)' src/jerboa-crypto.ss; then + ! grep -q '(jerboa ffi)' src/jerboa-crypto.ss || + ! grep -q 'foreign-entry?' src/jerboa-crypto.ss || + ! grep -q 'JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE' src/jerboa-crypto.ss || + ! grep -q 'trusted-loader-parent-chain?' src/jerboa-crypto.ss || + ! grep -q 'native-loader-require-clean-environment!' src/jerboa-crypto.ss || + ! grep -q 'jerboa_crypto_abi_version' src/jerboa-crypto.ss || + ! grep -q 'jerboa_crypto_abi_version' jerboa_crypto_shim.c; then printf '%s\n' "crypto native loading must use the lazy Jerboa FFI helper" >&2 fail=1 fi +check_empty "unsafe native shim search path" \ + rg -n -e '"[.]/jerboa_crypto_shim' \ + -e '"jerboa_crypto_shim[.](so|dylib)"' \ + -e '"libcrypto[.](so|dylib)' \ + src/jerboa-crypto.ss + +for marker in \ + 'scrypt-default-N 65536' \ + 'scrypt-default-r 8' \ + 'scrypt-default-p 2' \ + 'power-of-two?' \ + 'scrypt-password-needs-rehash?' \ + 'JERBOA_SCRYPT_MAX_MEMORY_BYTES' \ + 'EVP_PKEY_CTX_set_scrypt_maxmem_bytes'; do + if ! grep -Fq "$marker" src/jerboa-crypto.ss jerboa_crypto_shim.c; then + printf 'missing scrypt policy marker: %s\n' "$marker" >&2 + fail=1 + fi +done + +if [ ! -x scripts/loader-policy-test.sh ]; then + printf '%s\n' "scripts/loader-policy-test.sh must be executable" >&2 + fail=1 +fi + check_empty "custom primitive implementation marker" \ rg -n -i -e 'custom cryptographic primitive|homegrown crypto|roll your own crypto' src jerboa_crypto_shim.c --- a/src/jerboa-crypto.ss +++ b/src/jerboa-crypto.ss @@ -22,21 +22,75 @@ constant-time-compare? ;; KDF scrypt + scrypt-default-policy-version scrypt-default-parameters + scrypt-memory-bytes scrypt-work-factor scrypt-parameters-acceptable? + scrypt-password-hash scrypt-password-verify? + scrypt-password-needs-rehash? ;; Error crypto-error-string) (import (jerboa prelude) - (only (jerboa ffi) c-lambda load-shared-object*)) + (only (jerboa ffi) c-lambda load-shared-object*) + (only (std os exec-id) exec-id-realpath-of) + (only (std os platform) platform-macos?) + (only (std os posix) posix-getuid posix-geteuid) + (only (std native-loader) + native-loader-require-clean-environment!) + (only (chezscheme) + foreign-entry? make-mutex mutex-acquire mutex-release)) ;; Load native objects lazily so importing this module does not crash static ;; binaries or feature probes that do not need crypto at startup. (def *native-loaded?* #f) + (def +native-abi-version+ #x4a435231) ; JCR1 (def *bindings-ready?* #f) + (def *native-lock* (make-mutex)) + + (def (call-with-mutex mutex proc) + (dynamic-wind + (lambda () (mutex-acquire mutex)) + proc + (lambda () (mutex-release mutex)))) + + (def loader-macos? (platform-macos?)) + (def c-loader-lstat (c-lambda (string u8*) int "lstat")) + + (def (trusted-loader-component? path expected-type) + (let ([stat-buffer (make-bytevector 256 0)]) + (and (= 0 (c-loader-lstat path stat-buffer)) + (let* ([mode (if loader-macos? + (bytevector-u16-native-ref stat-buffer 4) + (bytevector-u32-native-ref stat-buffer 24))] + [uid (bytevector-u32-native-ref stat-buffer + (if loader-macos? 16 28))] + [kind (bitwise-and mode #o170000)]) + (and (= kind (if (eq? expected-type 'directory) + #o040000 #o100000)) + (or (= uid 0) (= uid (posix-getuid))) + (= 0 (bitwise-and mode #o022))))))) + + (def (trusted-loader-parent-chain? path) + (let loop ([directory (path-directory path)]) + (and (trusted-loader-component? directory 'directory) + (let ([parent (path-directory directory)]) + (or (string=? parent directory) (loop parent)))))) + + (def (trusted-loader-path? path) + (and (not (file-symbolic-link? path)) + (let ([canonical (exec-id-realpath-of path)]) + (and (string=? canonical path) + (trusted-loader-component? canonical 'regular) + (trusted-loader-parent-chain? canonical))))) (def (try-load-one! path) - (guard (e [(condition? e) #f]) - (load-shared-object* path) - #t)) + (and (file-exists? path) + (begin + (unless (trusted-loader-path? path) + (error 'jerboa-crypto-loader + "untrusted native library path" path)) + (guard (e [(condition? e) #f]) + (load-shared-object* path) + #t)))) (def (try-load-any! paths) (let loop ([paths paths]) @@ -45,25 +99,58 @@ [(try-load-one! (car paths)) #t] [else (loop (cdr paths))]))) + (def (native-search-paths) + (let ([base (getenv "JERBOA_CRYPTO_LIB")] + [dynamic? (getenv "JERBOA_CRYPTO_ALLOW_DYNAMIC_NATIVE")]) + (cond + [(not base) '()] + [(not (string=? (or dynamic? "") "1")) + (error 'jerboa-crypto-loader + "dynamic native loading is disabled; use a statically linked binary")] + [(or (= (posix-geteuid) 0) + (not (= (posix-getuid) (posix-geteuid)))) + (error 'jerboa-crypto-loader + "dynamic native loading is forbidden in privileged processes")] + [(not (path-absolute? base)) + (error 'jerboa-crypto-loader + "JERBOA_CRYPTO_LIB must be an absolute trusted directory" base)] + [else + (list + (string-append base "/jerboa_crypto_shim.so") + (string-append base "/jerboa_crypto_shim.dylib"))]))) + + (def (native-provider-visible?) + (or (foreign-entry? "jerboa_crypto_abi_version") + (foreign-entry? "jerboa_constant_time_compare") + (foreign-entry? "jerboa_rand_bytes") + (foreign-entry? "jerboa_crypto_scrypt"))) + + (def (require-compatible-native!) + (unless (foreign-entry? "jerboa_crypto_abi_version") + (error 'jerboa-crypto-loader "crypto shim ABI canary is unavailable")) + (let ([version + ((c-lambda () unsigned-32 "jerboa_crypto_abi_version"))]) + (unless (= version +native-abi-version+) + (error 'jerboa-crypto-loader "incompatible crypto shim ABI" + version +native-abi-version+))) + (unless (and (foreign-entry? "jerboa_constant_time_compare") + (foreign-entry? "jerboa_rand_bytes") + (foreign-entry? "jerboa_crypto_scrypt")) + (error 'jerboa-crypto-loader "crypto shim symbol closure is incomplete")) + #t) + (def (try-load-native!) (or *native-loaded?* + (and (native-provider-visible?) + (require-compatible-native!) + (begin + (set! *native-loaded?* #t) + #t)) (begin - ;; Loading the shim is the required step; it is linked against - ;; libcrypto. Loading common libcrypto names first improves behavior - ;; on hosts where the shim dependency is not on the loader path. - (try-load-any! - '("/opt/homebrew/opt/openssl@4/lib/libcrypto.dylib" - "/usr/local/opt/openssl@4/lib/libcrypto.dylib" - "/opt/homebrew/opt/openssl@3/lib/libcrypto.dylib" - "/usr/local/opt/openssl@3/lib/libcrypto.dylib" - "libcrypto.so.3" - "libcrypto.so" - "libcrypto.dylib")) - (and (try-load-any! - '("./jerboa_crypto_shim.so" - "jerboa_crypto_shim.so" - "./jerboa_crypto_shim.dylib" - "jerboa_crypto_shim.dylib")) + (native-loader-require-clean-environment! + 'jerboa-crypto-loader) + (and (try-load-any! (native-search-paths)) + (require-compatible-native!) (begin (set! *native-loaded?* #t) #t))))) @@ -100,7 +187,7 @@ (def c-aead-decrypt #f) (def c-constant-time-compare #f) - (def (ensure-bindings!) + (def (initialize-bindings!) (when (and (try-load-native!) (not *bindings-ready?*)) (set! c-err-get (c-lambda (u8* int) int "jerboa_crypto_err_get")) (set! c-rand-bytes (c-lambda (u8* int) int "jerboa_rand_bytes")) @@ -128,7 +215,7 @@ (set! c-ed25519-keygen (c-lambda (u8* u8* u8* u8*) int "jerboa_ed25519_keygen")) (set! c-ed25519-sign (c-lambda (u8* int u8* int u8* u8*) int "jerboa_ed25519_sign")) (set! c-ed25519-verify (c-lambda (u8* int u8* int u8* int) int "jerboa_ed25519_verify")) - (set! c-scrypt (c-lambda (u8* int u8* int unsigned-64 int int u8* int) int "jerboa_scrypt")) + (set! c-scrypt (c-lambda (u8* int u8* int unsigned-64 int int u8* int) int "jerboa_crypto_scrypt")) (set! c-aead-encrypt (c-lambda (string u8* u8* int u8* int u8* int u8* u8* u8* int) int @@ -142,6 +229,12 @@ (set! *bindings-ready?* #t)) *bindings-ready?*) + (def (ensure-bindings!) + (or *bindings-ready?* + (call-with-mutex *native-lock* + (lambda () + (or *bindings-ready?* (initialize-bindings!)))))) + (def (require-bindings! who) (unless (ensure-bindings!) (error who "unable to load jerboa_crypto_shim.so/libcrypto")) @@ -459,18 +552,101 @@ signature (bytevector-length signature))))) ;; ---- Scrypt KDF ---- + ;; Policy version 1 follows the OWASP 64 MiB scrypt profile. The accepted + ;; range also covers OWASP's other memory/parallelism tradeoffs while + ;; rejecting the former 1 MiB convenience profile. + (def scrypt-default-policy-version 1) + (def scrypt-default-N 65536) + (def scrypt-default-r 8) + (def scrypt-default-p 2) + (def scrypt-min-memory-bytes (* 8 1024 1024)) + (def scrypt-max-memory-bytes (* 256 1024 1024)) + (def scrypt-min-work-factor 655360) + (def scrypt-max-work-factor 4194304) + (def scrypt-max-r 32) + (def scrypt-max-p 16) + (def scrypt-max-output-bytes 1024) + (def scrypt-max-password-bytes (* 1024 1024)) + (def scrypt-min-salt-bytes 16) + (def scrypt-max-salt-bytes 1024) + (def scrypt-stored-salt-bytes 16) + (def scrypt-stored-key-bytes 32) + + (def (scrypt-default-parameters) + (values scrypt-default-N scrypt-default-r scrypt-default-p)) + + (def (positive-integer? value) + (and (integer? value) (> value 0))) + + (def (power-of-two? value) + (and (positive-integer? value) + (= 0 (bitwise-and value (- value 1))))) + + (def (scrypt-memory-bytes N r) + (unless (and (positive-integer? N) (positive-integer? r)) + (assertion-violation 'scrypt-memory-bytes + "N and r must be positive integers" N r)) + (* 128 N r)) + + (def (scrypt-work-factor N r p) + (unless (and (positive-integer? N) + (positive-integer? r) + (positive-integer? p)) + (assertion-violation 'scrypt-work-factor + "N, r, and p must be positive integers" N r p)) + (* N r p)) + + (def (validate-scrypt-parameters who N r p) + (unless (and (power-of-two? N) (> N 1) (<= N 262144)) + (assertion-violation who + "scrypt N must be a power of two from 2 through 262144" + N)) + (unless (and (positive-integer? r) (<= r scrypt-max-r) + (positive-integer? p) (<= p scrypt-max-p)) + (assertion-violation who "scrypt r/p exceed policy bounds" r p)) + (let ([memory (scrypt-memory-bytes N r)] + [work (scrypt-work-factor N r p)]) + (unless (and (>= memory scrypt-min-memory-bytes) + (<= memory scrypt-max-memory-bytes)) + (assertion-violation who + "scrypt memory estimate outside policy bounds" + memory)) + (unless (and (>= work scrypt-min-work-factor) + (<= work scrypt-max-work-factor)) + (assertion-violation who + "scrypt work factor outside policy bounds" + work))) + #t) + + (def (scrypt-parameters-acceptable? N r p) + (guard (e [(condition? e) #f]) + (validate-scrypt-parameters 'scrypt-parameters-acceptable? N r p))) + + (def (bounded-scrypt-bytes who name value min-size max-size) + (let ([bytes (as-bytes value)]) + (unless (and (>= (bytevector-length bytes) min-size) + (<= (bytevector-length bytes) max-size)) + (assertion-violation who "scrypt input length outside policy bounds" + name (bytevector-length bytes))) + bytes)) + (def scrypt (case-lambda - [(pass salt size) (scrypt pass salt size 1024 8 16)] + [(pass salt size) + (scrypt pass salt size + scrypt-default-N scrypt-default-r scrypt-default-p)] [(pass salt size N r p) (require-bindings! 'scrypt) - (unless (and (integer? N) (> N 1)) - (assertion-violation 'scrypt "invalid scrypt N" N)) - (unless (and (integer? r) (> r 0) (<= r max-c-int) - (integer? p) (> p 0) (<= p max-c-int)) - (assertion-violation 'scrypt "invalid scrypt r/p" r p)) - (let* ([pass (as-bytes pass)] - [salt (as-bytes salt)] + (validate-scrypt-parameters 'scrypt N r p) + (unless (and (positive-integer? size) + (<= size scrypt-max-output-bytes)) + (assertion-violation 'scrypt + "derived-key size outside policy bounds" size)) + (let* ([pass (bounded-scrypt-bytes + 'scrypt 'password pass 0 scrypt-max-password-bytes)] + [salt (bounded-scrypt-bytes + 'scrypt 'salt salt + scrypt-min-salt-bytes scrypt-max-salt-bytes)] [size (ensure-size 'scrypt 'size size)] [out (make-bytevector size 0)] [rc (c-scrypt pass (byte-length 'scrypt 'password pass) @@ -479,6 +655,154 @@ (check-rc 'scrypt rc) out)])) + (def hex-digits "0123456789abcdef") + + (def (bytevector->lower-hex bytes) + (let loop ([i 0] [result ""]) + (if (= i (bytevector-length bytes)) + result + (let ([byte (bytevector-u8-ref bytes i)]) + (loop (+ i 1) + (string-append + result + (string (string-ref hex-digits (quotient byte 16))) + (string (string-ref hex-digits (remainder byte 16))))))))) + + (def (hex-digit-value char) + (let ([code (char->integer char)]) + (cond + [(and (>= code (char->integer #\0)) + (<= code (char->integer #\9))) + (- code (char->integer #\0))] + [(and (>= code (char->integer #\a)) + (<= code (char->integer #\f))) + (+ 10 (- code (char->integer #\a)))] + [(and (>= code (char->integer #\A)) + (<= code (char->integer #\F))) + (+ 10 (- code (char->integer #\A)))] + [else #f]))) + + (def (lower-hex->bytevector who input max-bytes) + (unless (and (string? input) + (= 0 (remainder (string-length input) 2)) + (<= (quotient (string-length input) 2) max-bytes)) + (assertion-violation who "invalid or oversized hexadecimal field")) + (let ([result (make-bytevector (quotient (string-length input) 2) 0)]) + (let loop ([i 0]) + (if (= i (bytevector-length result)) + result + (let ([high (hex-digit-value (string-ref input (* i 2)))] + [low (hex-digit-value (string-ref input (+ (* i 2) 1)))]) + (unless (and high low) + (assertion-violation who "invalid hexadecimal field")) + (bytevector-u8-set! result i (+ (* high 16) low)) + (loop (+ i 1))))))) + + (def (split-on-char input separator) + (let loop ([i 0] [start 0] [parts '()]) + (cond + [(= i (string-length input)) + (reverse (cons (substring input start i) parts))] + [(char=? (string-ref input i) separator) + (loop (+ i 1) (+ i 1) (cons (substring input start i) parts))] + [else (loop (+ i 1) start parts)]))) + + (def (parse-prefixed-decimal who input prefix) + (unless (and (> (string-length input) (string-length prefix)) + (string=? (substring input 0 (string-length prefix)) prefix) + (<= (- (string-length input) (string-length prefix)) 20)) + (assertion-violation who "invalid scrypt parameter field" input)) + (let* ([digits (substring input (string-length prefix) (string-length input))] + [value (string->number digits 10)]) + (unless (and value (integer? value) (>= value 0) + (let loop ([i 0]) + (or (= i (string-length digits)) + (and (char-numeric? (string-ref digits i)) + (loop (+ i 1)))))) + (assertion-violation who "invalid decimal scrypt parameter" input)) + value)) + + ;; Returns (version N r p salt hash). Parsing is deliberately strict so a + ;; record cannot smuggle duplicate, reordered, oversized, or unknown fields. + (def (parse-scrypt-password-record who encoded) + (unless (and (string? encoded) (<= (string-length encoded) 4096)) + (assertion-violation who "invalid or oversized scrypt password record")) + (let ([parts (split-on-char encoded #\$)]) + (unless (= (length parts) 6) + (assertion-violation who "invalid scrypt password record field count")) + (unless (and (string=? (car parts) "") + (string=? (cadr parts) "jerboa-scrypt")) + (assertion-violation who "invalid scrypt password record prefix")) + (let* ([version (parse-prefixed-decimal who (caddr parts) "v=")] + [params (split-on-char (cadddr parts) #\,)]) + (unless (and (= version scrypt-default-policy-version) + (= (length params) 3)) + (assertion-violation who "unsupported scrypt password record policy")) + (let* ([N (parse-prefixed-decimal who (car params) "N=")] + [r (parse-prefixed-decimal who (cadr params) "r=")] + [p (parse-prefixed-decimal who (caddr params) "p=")] + [salt (lower-hex->bytevector who (car (cddddr parts)) 64)] + [hash (lower-hex->bytevector who (cadr (cddddr parts)) + scrypt-max-output-bytes)]) + (validate-scrypt-parameters who N r p) + (unless (and (>= (bytevector-length salt) scrypt-min-salt-bytes) + (<= (bytevector-length salt) 64) + (>= (bytevector-length hash) scrypt-stored-key-bytes)) + (assertion-violation who "scrypt password record field is too short")) + (list version N r p salt hash))))) + + (def scrypt-password-hash + (case-lambda + [(password) + (scrypt-password-hash password + (random-bytes scrypt-stored-salt-bytes) + scrypt-default-N + scrypt-default-r + scrypt-default-p)] + [(password salt N r p) + (validate-scrypt-parameters 'scrypt-password-hash N r p) + (let* ([salt (bounded-scrypt-bytes + 'scrypt-password-hash 'salt salt + scrypt-min-salt-bytes 64)] + [hash (scrypt password salt scrypt-stored-key-bytes N r p)]) + (string-append + "$jerboa-scrypt$v=" + (number->string scrypt-default-policy-version) + "$N=" (number->string N) + ",r=" (number->string r) + ",p=" (number->string p) + "$" (bytevector->lower-hex salt) + "$" (bytevector->lower-hex hash)))])) + + (def (scrypt-password-verify? password encoded) + (guard (e [(condition? e) #f]) + (let* ([record (parse-scrypt-password-record + 'scrypt-password-verify? encoded)] + [N (cadr record)] + [r (caddr record)] + [p (cadddr record)] + [salt (car (cddddr record))] + [expected (cadr (cddddr record))] + [actual (scrypt password salt (bytevector-length expected) N r p)]) + (constant-time-compare? actual expected)))) + + (def (scrypt-password-needs-rehash? encoded) + (guard (e [(condition? e) #t]) + (let* ([record (parse-scrypt-password-record + 'scrypt-password-needs-rehash? encoded)] + [version (car record)] + [N (cadr record)] + [r (caddr record)] + [p (cadddr record)] + [salt (car (cddddr record))] + [hash (cadr (cddddr record))]) + (or (not (= version scrypt-default-policy-version)) + (not (= N scrypt-default-N)) + (not (= r scrypt-default-r)) + (not (= p scrypt-default-p)) + (< (bytevector-length salt) scrypt-stored-salt-bytes) + (not (= (bytevector-length hash) scrypt-stored-key-bytes)))))) + ;; ---- AEAD (Authenticated Encryption with Associated Data) ---- ;; aead-encrypt: encrypt plaintext with AEAD cipher. --- a/tests/crypto-test.ss +++ b/tests/crypto-test.ss @@ -189,15 +189,44 @@ (chk (constant-time-compare? a (string->utf8 "hi")) => #f)) ;; different lengths ;;; ---- Scrypt ---- -(let ([key (scrypt "password" "salt" 32)]) +(let-values ([(N r p) (scrypt-default-parameters)]) + (chk scrypt-default-policy-version => 1) + (chk N => 65536) + (chk r => 8) + (chk p => 2) + (chk (scrypt-memory-bytes N r) => 67108864) + (chk (scrypt-work-factor N r p) => 1048576)) + +(chk (scrypt-parameters-acceptable? 65536 8 2) => #t) +(chk (scrypt-parameters-acceptable? 8192 8 10) => #t) +(chk (scrypt-parameters-acceptable? 1024 8 16) => #f) +(chk (scrypt-parameters-acceptable? 3 8 1) => #f) +(chk (scrypt-parameters-acceptable? 524288 8 1) => #f) +(chk (raises? (lambda () (scrypt "password" "0123456789abcdef" 32 3 8 1))) => #t) +(chk (raises? (lambda () (scrypt "password" "short-salt" 32 65536 8 2))) => #t) + +(let ([key (scrypt "password" "0123456789abcdef" 32)]) (chk (= (bytevector-length key) 32) => #t) ;; Same inputs should produce same output - (let ([key2 (scrypt "password" "salt" 32)]) + (let ([key2 (scrypt "password" "0123456789abcdef" 32)]) (chk (equal? key key2) => #t)) ;; Different password → different key - (let ([key3 (scrypt "other" "salt" 32)]) + (let ([key3 (scrypt "other" "0123456789abcdef" 32)]) (chk (not (equal? key key3)) => #t))) +(let ([record (scrypt-password-hash "correct horse battery staple")]) + (chk (scrypt-password-verify? "correct horse battery staple" record) => #t) + (chk (scrypt-password-verify? "wrong" record) => #f) + (chk (scrypt-password-needs-rehash? record) => #f)) + +(let ([record (scrypt-password-hash + "password" "0123456789abcdef" 32768 8 3)]) + (chk (scrypt-password-verify? "password" record) => #t) + (chk (scrypt-password-needs-rehash? record) => #t)) +