Add env-overridable whitelist to config (V7)
ober
f7132554801fa8ff394a0811d510de9918716102
--- a/lib/std/config.sls +++ b/lib/std/config.sls @@ -194,8 +194,17 @@ ;; JERBOA_DB_HOST -> key (db host) (define (env-override! cfg) + ;; HARDENED: Only override config keys that are explicitly declared + ;; as env-overridable in the schema. If no schema is set, no overrides + ;; are applied (default-deny). + ;; + ;; Schema entries with env-overridable: declare which keys can be + ;; overridden. Format: ((key type default env-overridable?) ...) + ;; The env-overridable? field is the 4th element (optional, default #f). (let* ([prefix "JERBOA_"] [plen (string-length prefix)] + [schema (config-rec-schema cfg)] + [allowed (env-overridable-keys schema)] [env-strings (get-environment-strings)]) (for-each (lambda (entry) @@ -208,9 +217,29 @@ [key-path (map (lambda (p) (string->symbol (string-downcase p))) parts)] [val (cdr entry)]) - (ht-path-set! (config-rec-data cfg) key-path val))))) + ;; Only allow if key-path is in the allowed set + (when (key-path-allowed? key-path allowed) + (ht-path-set! (config-rec-data cfg) key-path val)))))) env-strings))) + (define (env-overridable-keys schema) + ;; Extract the list of key-paths that are declared env-overridable. + ;; Schema format: ((key type default) ...) or ((key type default #t) ...) + ;; The 4th element, if present and true, marks the key as overridable. + (if (null? schema) + '() ;; No schema = no overrides allowed (default-deny) + (filter-map + (lambda (entry) + (and (>= (length entry) 4) + (list-ref entry 3) + (let ([key (car entry)]) + (if (pair? key) key (list key))))) + schema))) + + (define (key-path-allowed? key-path allowed) + ;; Check if key-path matches any allowed path. + (exists (lambda (a) (equal? key-path a)) allowed)) + ;; ---- string utilities ---- (define (string-split-char s ch) new file mode 100644 --- /dev/null +++ b/tests/test-config-env.ss @@ -0,0 +1,57 @@ +#!chezscheme +;;; test-config-env.ss -- Tests for env-override! whitelist (V7) +;;; Must be run with specific env vars set: +;;; JERBOA_DB_HOST=evil.com JERBOA_DB_PORT=5433 JERBOA_SECRET=leaked scheme ... + +(import (chezscheme) (std config)) + +(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))))])) + +(define tmp "/tmp/jerboa-test-config-env.scm") + +;; Test 1: No schema = no overrides (default-deny) +(call-with-output-file tmp (lambda (p) (write '() p)) 'truncate) +(let ([cfg (load-config tmp)]) + (check (config-ref cfg 'secret) => #f)) + +;; Test 2: Schema without env-overridable flag => blocked +(call-with-output-file tmp + (lambda (p) (write '(((db host) . "localhost")) p)) 'truncate) +(let ([cfg (load-config tmp '(((db host) string "localhost")))]) + (check (config-ref cfg '(db host)) => "localhost")) + +;; Test 3: Schema WITH env-overridable #t => overridden +(call-with-output-file tmp + (lambda (p) (write '(((db port) . "5432")) p)) 'truncate) +(let ([cfg (load-config tmp '(((db port) string "5432" #t)))]) + (check (config-ref cfg '(db port)) => "5433")) + +;; Test 4: Mixed schema — only overridable keys affected +(call-with-output-file tmp + (lambda (p) (write '(((db host) . "localhost") ((db port) . "5432")) p)) 'truncate) +(let ([cfg (load-config tmp '(((db host) string "localhost") + ((db port) string "5432" #t)))]) + (check (config-ref cfg '(db host)) => "localhost") ;; blocked + (check (config-ref cfg '(db port)) => "5433")) ;; overridden + +(guard (e [#t (void)]) (delete-file tmp)) + +(display " config-env: ") +(display pass-count) (display " passed") +(when (> fail-count 0) + (display ", ") (display fail-count) (display " failed")) +(newline) +(when (> fail-count 0) (exit 1))