security: scrub secret env from child processes + validate hex (P0)
ober
cc9894727a6651a299d38cae342877492e447db4
--- a/src/jcode/core/sandbox.ss +++ b/src/jcode/core/sandbox.ss @@ -36,6 +36,7 @@ process-result-stdout process-result-stderr) :jcode/core/config + :jcode/core/secrets :jcode/core/log) (def logger (make-logger "sandbox")) @@ -140,13 +141,15 @@ fail-closed requirements on platforms that can actually enforce them." (cond ((not (sandbox-enabled?)) - (aproc-run/status command dir: cwd timeout-ms: (sandbox-timeout-ms timeout))) + (aproc-run/status (string-append (secret-env-command-prefix) command) + dir: cwd timeout-ms: (sandbox-timeout-ms timeout))) (else (let* ((work (or cwd (current-directory))) (policy (make-bash-sandbox-policy work)) (result (sandbox-launch policy - command: (list "/bin/sh" "-c" command) + command: (list "/bin/sh" "-c" + (string-append (secret-env-command-prefix) command)) env: #f cwd: work capture-stdout?: #t --- a/src/jcode/core/secrets-import.ss +++ b/src/jcode/core/secrets-import.ss @@ -208,19 +208,23 @@ ;;; ---- env vars ---- (def (import-from-env!) - (let loop ((entries *known-providers*) (added 0)) - (cond - ((null? entries) added) - (else - (let* ((name (car (car entries))) - (var (cdr (car entries))) - (val (getenv var))) - (cond - ((and val (not (string=? val ""))) - (secret-store-set! name val) - (loop (cdr entries) (+ added 1))) - (else - (loop (cdr entries) added)))))))) + (let ((added (let loop ((entries *known-providers*) (added 0)) + (cond + ((null? entries) added) + (else + (let* ((name (car (car entries))) + (var (cdr (car entries))) + (val (getenv var))) + (cond + ((and val (not (string=? val ""))) + (secret-store-set! name val) + (loop (cdr entries) (+ added 1))) + (else + (loop (cdr entries) added))))))))) + ;; The imported keys now live encrypted in the store; drop secret-bearing + ;; vars from the process environment so children cannot inherit them. + (scrub-secret-env!) + added)) ;;; ---- interactive prompt ---- --- a/src/jcode/core/secrets.ss +++ b/src/jcode/core/secrets.ss @@ -32,7 +32,11 @@ secret-store-change-passphrase! secret-prompt-passphrase bytevector->hex - hex->bytevector) + hex->bytevector + scrub-secret-env! + register-secret-env-var! + secret-env-vars + secret-env-command-prefix) (import :std/text/json :std/misc/string @@ -65,6 +69,11 @@ (+ 10 (- (char->integer c) (char->integer #\A)))) (else (error 'hex-val "Invalid hex char" c)))) +(def (hex-char? c) + (or (and (char>=? c #\0) (char<=? c #\9)) + (and (char>=? c #\a) (char<=? c #\f)) + (and (char>=? c #\A) (char<=? c #\F)))) + (def (bytevector->hex bv) (let* ((len (bytevector-length bv)) (out (make-string (* len 2)))) @@ -77,15 +86,85 @@ (string-set! out (+ (* i 2) 1) (string-ref "0123456789abcdef" lo)))))) (def (hex->bytevector s) - (let* ((trimmed (string-trim s)) - (len (string-length trimmed)) - (out-len (quotient len 2)) - (result (make-bytevector out-len))) - (do ((i 0 (+ i 2)) (j 0 (+ j 1))) - ((>= i len) result) - (bytevector-u8-set! result j - (+ (* (hex-val (string-ref trimmed i)) 16) - (hex-val (string-ref trimmed (+ i 1)))))))) + ;; Validate even length and hex digits BEFORE allocating, so a tampered + ;; odd-length keys.enc raises a clean error instead of an out-of-bounds + ;; string-ref during conversion. + (let ((trimmed (string-trim s))) + (unless (even? (string-length trimmed)) + (error 'hex->bytevector "odd-length hex string" trimmed)) + (let ((len (string-length trimmed))) + (do ((i 0 (+ i 1))) + ((>= i len)) + (unless (hex-char? (string-ref trimmed i)) + (error 'hex->bytevector "invalid hex character" trimmed))) + (let* ((out-len (quotient len 2)) + (result (make-bytevector out-len))) + (do ((i 0 (+ i 2)) (j 0 (+ j 1))) + ((>= i len) result) + (bytevector-u8-set! result j + (+ (* (hex-val (string-ref trimmed i)) 16) + (hex-val (string-ref trimmed (+ i 1)))))))))) + +;;; ---- child-environment secret scrubbing ---- +;;; +;;; JCODE_PASSPHRASE and env-imported API keys otherwise live in the process +;;; environment inherited by every child (MCP servers, bash, LSP). A malicious +;;; MCP server could simply read the master passphrase. The command prefix +;;; below strips them from a child's environment without disturbing the parent +;;; (which still resolves provider keys from env at runtime); scrub-secret-env! +;;; removes them from the process environment once consumed. + +(def c-unsetenv (foreign-procedure "unsetenv" (string) int)) + +;; Secret-bearing environment variables: the master passphrase plus the +;; conventional provider API-key vars (the same set import-from-env! reads). +;; Listed here — the security boundary's source of truth — so child +;; environments are scrubbed regardless of module-load ordering. +(def *secret-env-vars* + '("JCODE_PASSPHRASE" + "ANTHROPIC_API_KEY" "OPENAI_API_KEY" "GOOGLE_API_KEY" + "OPENROUTER_API_KEY" "DEEPSEEK_API_KEY" "XAI_API_KEY" + "GROK_CODE_XAI_API_KEY" "GROQ_API_KEY" "MISTRAL_API_KEY" + "TOGETHER_API_KEY" "CEREBRAS_API_KEY" "PERPLEXITY_API_KEY")) + +(def (register-secret-env-var! name) + (when (and (string? name) (not (string=? name "")) + (not (member name *secret-env-vars*))) + (set! *secret-env-vars* (cons name *secret-env-vars*)))) + +(def (secret-env-vars) + *secret-env-vars*) + +(def (scrub-secret-env!) + "Remove every secret-bearing variable from the process environment. + Idempotent." + (for-each (lambda (name) (c-unsetenv name)) *secret-env-vars*)) + +(def (shell-token s) + (let ((out (open-output-string))) + (display "'" out) + (let loop ((i 0)) + (unless (= i (string-length s)) + (let ((ch (string-ref s i))) + (if (char=? ch #\') + (display "'\\''" out) + (write-char ch out))) + (loop (+ i 1)))) + (display "'" out) + (get-output-string out))) + +(def (secret-env-command-prefix) + "Return a shell prefix like `env -u 'A' -u 'B' ` that strips the secret + vars from a child command's environment, or \"\" when there are none." + (if (null? *secret-env-vars*) + "" + (let loop ((vars *secret-env-vars*) (acc '())) + (cond + ((null? vars) + (string-append "env " (string-join (reverse acc) " ") " ")) + (else + (loop (cdr vars) + (cons (shell-token (car vars)) (cons "-u" acc)))))))) ;;; ---- cache accessors ---- --- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -23,6 +23,7 @@ :std/misc/thread :jcode/core/log :jcode/core/config + :jcode/core/secrets :jcode/tool/registry :jerboa/core :jerboa/runtime @@ -186,8 +187,9 @@ (def (mcp-start name command args . env-opt) "Start an MCP server subprocess and return an mcp-conn." (log-info logger "starting" `((name . ,name) (command . ,command))) - (let ((cmd-str (shell-command command args - (if (null? env-opt) '() (car env-opt))))) + (let ((cmd-str (string-append (secret-env-command-prefix) + (shell-command command args + (if (null? env-opt) '() (car env-opt)))))) (let-values (((to-stdin from-stdout from-stderr pid) (open-process-ports cmd-str 'block (make-transcoder (utf-8-codec))))) (let ((conn (make-mcp-conn name to-stdin from-stdout from-stderr pid 1 --- a/src/jcode/tool/lsp.ss +++ b/src/jcode/tool/lsp.ss @@ -10,6 +10,7 @@ :std/misc/string :jcode/core/log :jcode/core/config + :jcode/core/secrets :jcode/tool/registry) (def logger (make-logger "lsp")) @@ -48,7 +49,8 @@ (def (lsp-start command args root-path) "Start an LSP server subprocess." (log-info logger "starting" `((command . ,command))) - (let ((cmd-str (shell-command command args))) + (let ((cmd-str (string-append (secret-env-command-prefix) + (shell-command command args)))) (let-values (((to-stdin from-stdout from-stderr pid) (open-process-ports cmd-str 'block (make-transcoder (utf-8-codec))))) (let ((conn (make-lsp-conn to-stdin from-stdout from-stderr pid 1 --- a/test/security-regression.ss +++ b/test/security-regression.ss @@ -8,6 +8,8 @@ (jcode core plugin) (jcode core mentions) (jcode proxy server) + (jcode core secrets) + (jcode core secrets-import) (std misc ports) (std misc string) (std net tcp)) @@ -230,6 +232,59 @@ (check "proxy accepts bounded Content-Length" (proxy-content-length-ok? 1024)) +(define (condition-text e) + (guard (_ [else ""]) + (cond + ((string? e) e) + ((and (condition? e) (message-condition? e)) (condition-message e)) + (else "")))) + +(define (child-sees cmd) + (let-values (((to-in from-out from-err pid) + (open-process-ports cmd 'block (make-transcoder (utf-8-codec))))) + (let ((line (string-trim (get-line from-out)))) + (close-port to-in) (close-port from-out) (close-port from-err) + line))) + +;; ── (d) env-inherited secrets + hex validation ──────────────────────── +(check "hex->bytevector odd-length raises clean validation error" + (guard (e [else (string-contains (condition-text e) "odd")]) + (hex->bytevector "abc") + #f)) +(check "hex->bytevector invalid hex char raises clean error" + (guard (e [else #t]) + (hex->bytevector "zz") + #f)) +(check "hex->bytevector even-length still converts" + (= (bytevector-length (hex->bytevector "abcd")) 2)) +(check "provider API-key vars are in the secret env scrub list" + (and (member "ANTHROPIC_API_KEY" (secret-env-vars)) #t)) + +(putenv "JCODE_PASSPHRASE" "scrub-test-secret") +(scrub-secret-env!) +(check "scrub-secret-env! removes secret from process env" + (not (getenv "JCODE_PASSPHRASE"))) +(check "scrubbed secret not inherited by spawned child" + (string=? "UNSET" + (child-sees "/bin/sh -c 'echo ${JCODE_PASSPHRASE:-UNSET}'"))) + +(putenv "JCODE_PASSPHRASE" "parent-keeps-secret") +(check "child env stripped via secret-env-command-prefix" + (string=? "UNSET" + (child-sees (string-append (secret-env-command-prefix) + "sh -c 'echo ${JCODE_PASSPHRASE:-UNSET}'")))) +(check "parent process env keeps secret after prefix spawn" + (string=? "parent-keeps-secret" (getenv "JCODE_PASSPHRASE"))) +(register-secret-env-var! "JCODE_TEST_SECRET_VAR") +(putenv "JCODE_TEST_SECRET_VAR" "child-should-not-see") +(check "registered secret var stripped from child env" + (string=? "UNSET" + (child-sees (string-append (secret-env-command-prefix) + "sh -c 'echo ${JCODE_TEST_SECRET_VAR:-UNSET}'")))) +(check "parent keeps registered secret var after prefix spawn" + (string=? "child-should-not-see" (getenv "JCODE_TEST_SECRET_VAR"))) +(scrub-secret-env!) + (when (> failures 0) (error 'security-regression (format "~a security regression test(s) failed" failures))) (printf "Security regressions passed~n")