Harden IPC, REPL, LSP, and chat against injection and info leaks
ober
92d96ccb6d7f722ea1a6f82453054fd17770d3c7
--- a/lib/jerboa-emacs/debug-repl.sls +++ b/lib/jerboa-emacs/debug-repl.sls @@ -24,6 +24,7 @@ (def *repl-port-file* (string-append (getenv "HOME") "/.jerboa-repl-port")) (def *repl-env* (interaction-environment)) + (def ffi-chmod (foreign-procedure "chmod" (string int) int)) (def (write-repl-port-file! port-num) (delete-repl-port-file!) (call-with-output-file @@ -31,7 +32,8 @@ (lambda (p) (display "PORT=" p) (display port-num p) - (newline p)))) + (newline p))) + (ffi-chmod *repl-port-file* 384)) (def (delete-repl-port-file!) (when (file-exists? *repl-port-file*) (with-catch --- a/lib/jerboa-emacs/qt/lsp-client.sls +++ b/lib/jerboa-emacs/qt/lsp-client.sls @@ -9,18 +9,19 @@ *lsp-initialized* *lsp-initializing* *lsp-diagnostics* *lsp-workspace-root* lsp-queue-ui-action! lsp-poll-ui-actions! lsp-store-pending! lsp-take-pending! - lsp-read-message lsp-read-headers lsp-write-message - lsp-send-request! lsp-send-request/timeout! - lsp-send-notification! lsp-poll-one-message! - lsp-drain-messages! lsp-handle-server-notification! - lsp-handle-server-request! lsp-send-response! - *lsp-diagnostics-handler* *lsp-show-message-handler* - *lsp-on-initialized-handler* *lsp-last-sent-content* - lsp-store-diagnostics! lsp-store-show-message! - lsp-content-changed? lsp-record-sent-content! lsp-start! - lsp-stop! lsp-running? lsp-send-initialize! lsp-did-open! - lsp-did-change! lsp-did-save! lsp-did-close! file-path->uri - uri->file-path lsp-text-document-position lsp-language-id) + *lsp-max-message-size* lsp-read-message lsp-read-headers + lsp-write-message lsp-send-request! + lsp-send-request/timeout! lsp-send-notification! + lsp-poll-one-message! lsp-drain-messages! + lsp-handle-server-notification! lsp-handle-server-request! + lsp-send-response! *lsp-diagnostics-handler* + *lsp-show-message-handler* *lsp-on-initialized-handler* + *lsp-last-sent-content* lsp-store-diagnostics! + lsp-store-show-message! lsp-content-changed? + lsp-record-sent-content! lsp-start! lsp-stop! lsp-running? + lsp-send-initialize! lsp-did-open! lsp-did-change! + lsp-did-save! lsp-did-close! file-path->uri uri->file-path + lsp-text-document-position lsp-language-id) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -61,18 +62,27 @@ (when cb (hash-remove! *lsp-pending-requests* id)) cb) (mutex-unlock! *lsp-pending-mutex*))) + (define *lsp-max-message-size*--cell + (vector (* 10 1024 1024))) (def (lsp-read-message port) - "Read one LSP message from port. Returns parsed JSON hash, or #f on EOF/error.\n Uses read-string (not read-subu8vector) to avoid Gambit char/byte buffer conflict\n when headers are read with read-line (character I/O)." + "Read one LSP message from port. Returns parsed JSON hash, or #f on EOF/error.\n Uses read-string (not read-subu8vector) to avoid Gambit char/byte buffer conflict\n when headers are read with read-line (character I/O).\n Rejects messages larger than *lsp-max-message-size*." (let ([content-length (lsp-read-headers port)]) - (if content-length - (let ([body (read-string content-length port)]) - (if (and (string? body) - (= (string-length body) content-length)) - (with-catch - (lambda (e) #f) - (lambda () (string->json-object body))) - #f)) - #f))) + (cond + [(not content-length) #f] + [(> content-length *lsp-max-message-size*) + (jemacs-log! + "LSP: rejected oversized message: " + (number->string content-length) + " bytes") + #f] + [else + (let ([body (read-string content-length port)]) + (if (and (string? body) + (= (string-length body) content-length)) + (with-catch + (lambda (e) #f) + (lambda () (string->json-object body))) + #f))]))) (def (lsp-read-headers port) "Read HTTP-style headers, return Content-Length value or #f." (let loop ([content-length #f]) @@ -536,6 +546,13 @@ *lsp-workspace-root*--cell 0 val)])) + (define-syntax *lsp-max-message-size* + (identifier-syntax + [id (vector-ref *lsp-max-message-size*--cell 0)] + [(set! id val) (vector-set! + *lsp-max-message-size*--cell + 0 + val)])) (define-syntax *lsp-diagnostics-handler* (identifier-syntax [id (vector-ref *lsp-diagnostics-handler*--cell 0)] --- a/src/jerboa-emacs/chat.ss +++ b/src/jerboa-emacs/chat.ss @@ -16,7 +16,8 @@ (import :std/sugar :std/srfi/13 - :jerboa-emacs/core) + :jerboa-emacs/core + :std/misc/string) ;;;============================================================================ ;;; Chat state @@ -49,6 +50,11 @@ "Check if chat is waiting for a response." (chat-state-busy? cs)) +(def (shell-quote-arg s) + "Shell-escape a string for safe embedding in a sh -c command. + Wraps in single quotes, escaping any embedded single quotes." + (string-append "'" (string-join (string-split s #\') "'\\''") "'")) + (def (chat-send! cs input) "Send a prompt to Claude CLI. Spawns claude -p as a subprocess." (when (and (not (chat-state-busy? cs)) @@ -58,9 +64,10 @@ "--no-session-persistence" input] ["-p" "--output-format" "text" "--no-session-persistence" input])) + ;; Build shell command with properly escaped cwd and arguments (cmd (string-append - "cd \"" (chat-state-cwd cs) "\" && claude " - (string-join args " "))) + "cd " (shell-quote-arg (chat-state-cwd cs)) " && claude " + (string-join (map shell-quote-arg args) " "))) (in-port (let-values (((in-port out-port err-port pid) (open-process-ports cmd (buffer-mode none) (native-transcoder)))) (close-port out-port) --- a/src/jerboa-emacs/debug-repl.ss +++ b/src/jerboa-emacs/debug-repl.ss @@ -54,13 +54,17 @@ ;;; Port file ;;;============================================================================ +(def ffi-chmod (foreign-procedure "chmod" (string int) int)) + (def (write-repl-port-file! port-num) (delete-repl-port-file!) (call-with-output-file *repl-port-file* (lambda (p) (display "PORT=" p) (display port-num p) - (newline p)))) + (newline p))) + ;; Restrict to owner-only (mode 600) — contains REPL port info + (ffi-chmod *repl-port-file* #o600)) (def (delete-repl-port-file!) (when (file-exists? *repl-port-file*) --- a/src/jerboa-emacs/ipc.ss +++ b/src/jerboa-emacs/ipc.ss @@ -9,7 +9,15 @@ (import :std/sugar :jerboa/repl-socket - :jerboa-emacs/async) + :jerboa-emacs/async + ;; Path validation + :std/srfi/13) + +;;;============================================================================ +;;; FFI +;;;============================================================================ + +(def ffi-chmod (foreign-procedure "chmod" (string int) int)) ;;;============================================================================ ;;; State @@ -30,12 +38,28 @@ (def *ipc-line-buf* "") ;;;============================================================================ +;;; Path validation +;;;============================================================================ + +(def (ipc-path-safe? path) + "Validate an IPC file path — reject directory traversal and null bytes." + (and (> (string-length path) 0) + ;; No null bytes (could truncate C paths) + (not (string-contains path "\x0;")) + ;; No directory traversal components + (not (string-contains path "/../")) + (not (string-prefix? "../" path)) + (not (string-suffix? "/.." path)) + (not (string=? ".." path)))) + +;;;============================================================================ ;;; Queue operations (single-threaded, no mutex needed) ;;;============================================================================ (def (ipc-queue-push! path) - "Push a file path onto the IPC queue." - (set! *ipc-queue* (append *ipc-queue* (list path)))) + "Push a file path onto the IPC queue (if path passes validation)." + (when (ipc-path-safe? path) + (set! *ipc-queue* (append *ipc-queue* (list path))))) (def (ipc-poll-files!) "Drain the IPC queue and return a list of file paths. @@ -162,6 +186,8 @@ (display "127.0.0.1:" p) (display actual-port p) (newline p))) + ;; Restrict to owner-only (mode 600) — contains IPC port info + (ffi-chmod *ipc-server-file* #o600) ;; Register periodic tick (schedule-periodic! 'ipc-accept 100 ipc-tick!) (void)))) --- a/src/jerboa-emacs/qt/lsp-client.ss +++ b/src/jerboa-emacs/qt/lsp-client.ss @@ -88,20 +88,30 @@ ;;; Transport: Content-Length framed JSON over stdio ;;;============================================================================ +;; Maximum LSP message size (10 MB) — reject messages larger than this +;; to prevent memory exhaustion from a malicious or buggy language server. +(def *lsp-max-message-size* (* 10 1024 1024)) + (def (lsp-read-message port) "Read one LSP message from port. Returns parsed JSON hash, or #f on EOF/error. Uses read-string (not read-subu8vector) to avoid Gambit char/byte buffer conflict - when headers are read with read-line (character I/O)." + when headers are read with read-line (character I/O). + Rejects messages larger than *lsp-max-message-size*." (let ((content-length (lsp-read-headers port))) - (if content-length - (let ((body (read-string content-length port))) - (if (and (string? body) (= (string-length body) content-length)) - (with-catch - (lambda (e) #f) - (lambda () - (string->json-object body))) - #f)) - #f))) + (cond + ((not content-length) #f) + ((> content-length *lsp-max-message-size*) + (jemacs-log! "LSP: rejected oversized message: " + (number->string content-length) " bytes") + #f) + (else + (let ((body (read-string content-length port))) + (if (and (string? body) (= (string-length body) content-length)) + (with-catch + (lambda (e) #f) + (lambda () + (string->json-object body))) + #f)))))) (def (lsp-read-headers port) "Read HTTP-style headers, return Content-Length value or #f."