Expose MCP init stderr in diagnostics
ober
09983eeced664d0316383ff88a772b2b69ad0bca
--- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -14,6 +14,7 @@ mcp-stop-all! mcp-active-servers mcp-server-pids + mcp-stderr-preview current-mcp-call-cb mcp-call-history) @@ -123,6 +124,32 @@ (catch (_) (format "~a" value))) 4000)) +(def (mcp-stderr-preview conn . max-opt) + "Return currently available stderr from CONN without blocking." + (let ((limit (if (null? max-opt) 4000 (car max-opt))) + (p (and conn (mcp-conn-from-stderr conn))) + (out (open-output-string))) + (if (not p) + "" + (let loop ((n 0)) + (cond + ((>= n limit) (get-output-string out)) + ((not (char-ready? p)) (get-output-string out)) + (else + (let ((ch (read-char p))) + (cond + ((eof-object? ch) (get-output-string out)) + (else + (write-char ch out) + (loop (+ n 1))))))))))) + +(def (mcp-init-error-message e conn) + (let ((base (err->string e)) + (stderr (string-trim (mcp-stderr-preview conn)))) + (if (string=? stderr "") + base + (string-append base "; server stderr: " (mcp-truncate stderr 1000))))) + (def (mcp-call-history) (with-mutex *mcp-call-log-lock* (reverse *mcp-call-log*))) @@ -366,6 +393,7 @@ (let ((name (car pair)) (cfg (cdr pair))) (spawn (lambda () + (let ((conn #f)) (try (let* ((command (hash-ref cfg "command" "node")) (args (let ((a (hash-get cfg "args"))) @@ -373,13 +401,16 @@ (env (mcp-config-env cfg)) (prefix (or (hash-get cfg "prefix") (string-append "mcp_" name "_"))) - (conn (mcp-start name command args env))) + (started (mcp-start name command args env))) + (set! conn started) + (let ((conn started)) (mcp-initialize conn) (let ((count (register-mcp-tools conn prefix))) (log-info logger "ready" - `((server . ,name) (tools . ,count))))) + `((server . ,name) (tools . ,count)))))) (catch (e) (log-error logger "init-failed" - `((server . ,name) (error . ,(err->string e)))))))))) + `((server . ,name) + (error . ,(mcp-init-error-message e conn))))))))))) configs))) (for-each thread-join! threads))) --- a/test/run.ss +++ b/test/run.ss @@ -42,6 +42,7 @@ (jcode core verified) (jcode core best-of-k) (jcode core verified-run) + (jcode mcp client) (jcode ui cli) (jcode proxy convert) (jcode proxy handler) @@ -5841,6 +5842,16 @@ (str-contains? s "(let () (def x") (str-contains? s "plain quoted/vector literals")))) +(let ([conn (mcp-start "stderr-preview-unit" + "/bin/sh" + '("-c" "printf 'mcp init boom\\n' >&2; exit 0"))]) + (guard (e [else (void)]) + (mcp-initialize conn)) + (check-pred! "mcp init diagnostics preserve server stderr" + (mcp-stderr-preview conn) + (lambda (s) (str-contains? s "mcp init boom"))) + (mcp-stop! conn)) + (let* ([vr-dir "/tmp"] [target "jcode-verified-mcp-budget.txt"] [target-path (string-append vr-dir "/" target)]