Harden process launch and secret store permissions
ober
f947a7879552eae54db8bf1fb662aa65136f0c7b
--- a/src/jcode/core/secrets.ss +++ b/src/jcode/core/secrets.ss @@ -193,7 +193,7 @@ (put-string p (bytevector->hex salt)) (newline p) (put-string p (bytevector->hex cipher)) (newline p)))) ;; Tighten permissions — umask may have left this 0644. - (system (format "chmod 600 ~a 2>/dev/null" path))) + (chmod path #o600)) (def (read-store-with-passphrase path passphrase) (call-with-input-file path --- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -33,6 +33,24 @@ (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 (shell-command command args) + (string-join (map shell-quote (cons command args)) " ")) + ;; --- MCP server state --- ;; lock serializes mcp-send! send+read pairs on this connection. @@ -113,7 +131,7 @@ (def (mcp-start name command args) "Start an MCP server subprocess and return an mcp-conn." (log-info logger "starting" `((name . ,name) (command . ,command))) - (let ((cmd-str (string-join (cons command args) " "))) + (let ((cmd-str (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-mcp-conn name to-stdin from-stdout from-stderr pid 1 --- a/src/jcode/tool/lsp.ss +++ b/src/jcode/tool/lsp.ss @@ -13,6 +13,7 @@ :jcode/tool/registry) (def logger (make-logger "lsp")) +(def *lsp-max-content-length* (* 50 1024 1024)) ;; --- LSP connection state --- @@ -24,12 +25,30 @@ "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-join (cons command args) " "))) + (let ((cmd-str (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 @@ -69,6 +88,10 @@ ;; End of headers (unless content-length (error 'lsp "Missing Content-Length header")) + (unless (and (integer? content-length) + (>= content-length 0) + (<= content-length *lsp-max-content-length*)) + (error 'lsp "Invalid Content-Length" content-length)) ;; Read exactly content-length bytes (let ((buf (make-string content-length))) (let read-loop ((pos 0))