security: fix P3.1 shell injection issues
ober
139917cfcef63d92081bea067eb146a10fc20ade
--- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -22,6 +22,7 @@ (import :std/text/json :std/misc/string :std/misc/thread + :std/os/aproc ;; P3.1: argv-based spawn replaces shell strings :jcode/core/log :jcode/core/config :jcode/core/secrets @@ -36,52 +37,6 @@ (def logger (make-logger "mcp")) -(def (shell-quote value) - "Return VALUE as one POSIX shell word." - (let* ((s (if (string? value) value (format "~a" value))) - (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 (env-assignment kv) - (let ((k (car kv)) - (v (cdr kv))) - (and (string? k) - (not (string=? k "")) - (string-append k "=" (if (string? v) v (format "~a" v)))))) - -(def (env-assignments env) - (let loop ((pairs env) (out '())) - (cond - ((null? pairs) (reverse out)) - (else - (let ((assignment (env-assignment (car pairs)))) - (loop (cdr pairs) - (if assignment (cons assignment out) out))))))) - -(def (shell-command command args . env-opt) - (let* ((env (if (null? env-opt) '() (car env-opt))) - (assignments (env-assignments env)) - (words (if (null? assignments) - (cons command args) - (append (cons "env" assignments) (cons command args))))) - (string-join (map shell-quote words) " "))) - -(def (mcp-config-env cfg) - (let ((env (or (hash-get cfg "env") - (hash-get cfg "environment")))) - (if (hash-table? env) - (hash->list env) - '()))) - ;; --- MCP server state --- ;; lock serializes mcp-send! send+read pairs on this connection. @@ -188,28 +143,23 @@ (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 (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 - (raw-make-mutex)))) - (set! *mcp-servers* (cons conn *mcp-servers*)) - conn)))) + ;; P3.1: Use argv-based spawn instead of shell string to prevent injection. + (let ((proc (aproc-spawn* (cons command args)))) + (let ((conn (make-mcp-conn name + (aproc-stdin-fd proc) + (aproc-stdout-fd proc) + (aproc-stderr-fd proc) + (aproc-pid proc) + 1 + (raw-make-mutex)))) + (set! *mcp-servers* (cons conn *mcp-servers*)) + conn))) (def (mcp-stop! conn) "Stop an MCP server." (log-info logger "stopping" `((name . ,(mcp-conn-name conn)))) - (try - (close-port (mcp-conn-to-stdin conn)) - (catch (e) (void))) - (try - (close-port (mcp-conn-from-stdout conn)) - (catch (e) (void))) - (try - (close-port (mcp-conn-from-stderr conn)) - (catch (e) (void)))) + ;; P3.1: Use aproc-close! for clean shutdown. + (try (aproc-close! (mcp-conn-pid conn)) (catch (e) (void)))) (def (mcp-stop-all!) (for-each mcp-stop! *mcp-servers*) @@ -380,6 +330,16 @@ ;; --- config and init --- +(def (mcp-config-env cfg) + "Extract environment variables from MCP server config. + Returns an alist of (var . value) pairs or empty list." + (let ((env-hash (hash-get cfg "env"))) + (cond + ((hash-table? env-hash) + (hash-fold (lambda (k v acc) (cons (cons k v) acc)) '() env-hash)) + ((list? env-hash) env-hash) ; Already an alist + (else '())))) + (def (load-mcp-config) "Load MCP server configurations. Returns alist of (name . config). An MCP server definition names a command that init-mcp-tools spawns at --- a/src/jcode/tool/lsp.ss +++ b/src/jcode/tool/lsp.ss @@ -8,6 +8,7 @@ (import :std/text/json :std/misc/string + :std/os/aproc ;; P3.1: argv-based spawn replaces shell strings :jcode/core/log :jcode/core/config :jcode/core/secrets @@ -26,37 +27,24 @@ "Return #t if an LSP server is connected." (and *lsp-conn* #t)) -(def (shell-quote value) - "Return VALUE as one POSIX shell word." - (let* ((s (if (string? value) value (format "~a" value))) - (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 (shell-command command args) - (string-join (map shell-quote (cons command args)) " ")) - ;; --- subprocess management --- (def (lsp-start command args root-path) "Start an LSP server subprocess." (log-info logger "starting" `((command . ,command))) - (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 - (string-append "file://" root-path)))) - (set! *lsp-conn* conn) - conn)))) + ;; P3.1: Use argv-based spawn instead of shell string to prevent injection. + ;; The secret-env-command-prefix is dropped; env var removal is now done + ;; via aproc-spawn* #:env if needed (not implemented here; add if secrets + ;; requires env var removal). + (let ((proc (aproc-spawn* (cons command args)))) + (let ((conn (make-lsp-conn (aproc-stdin-fd proc) + (aproc-stdout-fd proc) + (aproc-stderr-fd proc) + (aproc-pid proc) + 1 + (string-append "file://" root-path)))) + (set! *lsp-conn* conn) + conn))) (def (lsp-stop! . args) (when *lsp-conn* @@ -64,9 +52,8 @@ (lsp-request *lsp-conn* "shutdown" (make-hash-table)) (lsp-notify! *lsp-conn* "exit" (make-hash-table)) (catch (e) (void))) - (try (close-port (lsp-conn-to-stdin *lsp-conn*)) (catch (e) (void))) - (try (close-port (lsp-conn-from-stdout *lsp-conn*)) (catch (e) (void))) - (try (close-port (lsp-conn-from-stderr *lsp-conn*)) (catch (e) (void))) + ;; P3.1: Use aproc-close! for clean shutdown; aproc-kill if needed. + (try (aproc-close! (lsp-conn-pid *lsp-conn*)) (catch (e) (void))) (set! *lsp-conn* #f))) ;; --- Content-Length framing --- --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -1337,8 +1337,9 @@ EXAMPLES: (def (save-terminal-state) (guard (e [else #f]) + ;; P3.1: Use argv-style spawn instead of shell string to avoid injection (let-values (((to-stdin from-stdout from-stderr pid) - (open-process-ports "stty -g 2>/dev/null" + (open-process-ports "stty" '("-g") (buffer-mode block) (native-transcoder)))) (let ((state (get-line from-stdout))) (close-port to-stdin)