security: hide mcp protocol errors
Jaime Fournier <jaimef@linbsd.org>
7df5b4d9e27db3aca2bafc0cc8dd24d1eadc75c2
diff --git a/docs/kimi3-security-recommmendations.md b/docs/kimi3-security-recommmendations.md
index 65a1d55..55aae9d 100644
--- a/docs/kimi3-security-recommmendations.md
+++ b/docs/kimi3-security-recommmendations.md
@@ -787,8 +787,10 @@ they are build-time. Close the runtime loop.
`path-leaks.txt` and requires `path_leak_status=pass`. `(std repl server)`
now returns generic client errors with opaque references for eval,
eval-region, malformed request, and request-dispatch failures while logging
- internal detail server-side. Remaining work: router integrations plus MCP/LSP
- surfaces need opaque client error refs.
+ internal detail server-side. `jmcp` now returns opaque references for
+ unexpected tool-handler exceptions and framed/unframed JSON parse failures
+ while logging internal detail server-side. Remaining work: router integrations
+ plus LSP surfaces need opaque client error refs.
### K3-P1-11 — Parameterized-only SQL in the safe surface
**Serves:** G1. **Effort:** 2–3 days.
diff --git a/docs/security-reference.md b/docs/security-reference.md
index 0e9bc85..e57c31c 100644
--- a/docs/security-reference.md
+++ b/docs/security-reference.md
@@ -821,7 +821,7 @@ These modules are implemented but not covered in depth above.
| Module | Purpose |
|--------|---------|
| `(std security sanitize)` | Context-aware sanitization: `sanitize-html`, `sanitize-html-attribute`, `sanitize-url-attribute`, `sql-escape`, `sanitize-path`, `safe-path-join`, `sanitize-header-value`, `sanitize-url`. Raises `&path-traversal`, `&header-injection`, `&url-scheme-violation`. |
-| `(std security errors)` | Error classification (internal vs client-safe). Generates opaque error references for correlation. Prevents leaking internal details in error responses; `(std net grpc)`, `(std net thread-httpd)`, and `(std repl server)` use it for protocol/handler failures. |
+| `(std security errors)` | Error classification (internal vs client-safe). Generates opaque error references for correlation. Prevents leaking internal details in error responses; `(std net grpc)`, `(std net thread-httpd)`, `(std repl server)`, and `jmcp` use it for protocol/handler failures. |
| `(std security audit)` | Append-only JSONL audit log with SHA-256 hash chain. `audit-log!`, `verify-audit-chain`, `check-capability!/audit`. |
| `(std security audit-log)` | Per-run structured audit records with JSONL/summary rendering, per-log redactors, and `audit-log-use-env-policy!` to scrub `(std security env)` registered secret values before emission. |
| `(std security auth)` | API key stores, session tokens with expiry, auth middleware pattern, rate limiting for auth attempts. |
diff --git a/mcp/server.ss b/mcp/server.ss
index 986a1e5..33c428f 100644
--- a/mcp/server.ss
+++ b/mcp/server.ss
@@ -10,6 +10,7 @@
(only (std os exec-id) exec-id-realpath-of)
(std security profile)
(std security taint)
+ (std security errors)
(std port-position)
(std misc string))
@@ -1113,9 +1114,28 @@
(if (> (string-length (string-trim rendered)) 0)
(string-trim rendered)
(error-message e))))
+(def (mcp-error-detail exn)
+ (guard (render-exn [else (format "~s" exn)])
+ (condition->text exn)))
+
+(def mcp-safe-error-handler
+ (make-safe-error-handler
+ (lambda (reference class-name exn)
+ (jmcp-log-line
+ "protocol.safe_error"
+ (list (cons 'reference reference)
+ (cons 'class class-name)
+ (cons 'detail (mcp-error-detail exn)))))))
+
+(def (safe-mcp-error-message class-name exn)
+ (let ([safe (mcp-safe-error-handler class-name exn)])
+ (format "~a (Reference: ~a)"
+ (safe-error-response-message safe)
+ (safe-error-response-reference safe))))
(def (tool-error-text name e)
- (string-append "Tool error in " name ": " (condition->text e)))
+ (string-append "Tool error in " name ": "
+ (safe-mcp-error-message 'internal-error e)))
(def (json-rpc-result id result)
(jhash "jsonrpc" "2.0" "id" id "result" result))
@@ -9943,20 +9963,11 @@
(cond
[(not name) (json-rpc-error id -32602 "tools/call requires params.name")]
[(not tool) (json-rpc-error id -32602 (string-append "Unknown tool: " name))]
- ;; Convert any handler exception into an isError tool result (not a
- ;; protocol-level json-rpc-error) so the caller sees the real reason and
- ;; the JSON-RPC id stays correlated. Without this a raised tool error fell
- ;; through to the serve-loop guard and returned id=#f.
+ ;; Convert any handler exception into an opaque isError tool result (not a
+ ;; protocol-level json-rpc-error) so the JSON-RPC id stays correlated while
+ ;; internal details remain server-side under the opaque reference.
[else (json-rpc-result id
- (guard (e [else (text-result
- (begin
- (jmcp-log-line
- "tool.handler_error"
- (list (cons 'id id)
- (cons 'tool name)
- (cons 'error (condition->text e))))
- (tool-error-text name e))
- #t)])
+ (guard (e [else (text-result (tool-error-text name e) #t)])
((hash-ref tool 'handler) args)))]))
(def (handle-message msg)
@@ -9994,7 +10005,10 @@
[payload (cdr request)])
(when (> (string-length (string-trim payload)) 0)
(let ([send (if (eq? mode 'framed) emit-framed emit)])
- (guard (e [else (send (json-rpc-error #f -32700 (error-message e)))])
+ (guard (e [else (send (json-rpc-error
+ #f
+ -32700
+ (safe-mcp-error-message 'bad-request e)))])
(def msg (string->json-object payload))
(def response (handle-message msg))
(when response (send response))))))
diff --git a/mcp/test/protocol-test.ss b/mcp/test/protocol-test.ss
index d0eaa2a..18038e4 100644
--- a/mcp/test/protocol-test.ss
+++ b/mcp/test/protocol-test.ss
@@ -836,6 +836,13 @@
(cons "clientInfo" (alist->hash-table '())))))))
(check "framed initialize server name"
(string=? (hash-ref (hash-ref (result framed-init) "serverInfo") "name") "jerboa-mcp"))
+(def framed-bad-json
+ (run-framed-server "{not-json"))
+(check "framed parse error is opaque with reference"
+ (let ([message (hash-ref (hash-ref framed-bad-json "error") "message")])
+ (and (string-contains message "Bad request")
+ (string-contains message "Reference:")
+ (not (string-contains message "not-json")))))
(def tools (hash-ref (result (cadr responses)) "tools"))
(check "tools/list includes eval" (has-tool? tools "jerboa_eval"))
@@ -1238,10 +1245,14 @@
(content-text (result (list-ref responses 134)))
"http-response-raw-condition-message"))
-(check "tool error formatting includes tool name and condition"
- (and (hash-ref (result (list-ref responses 108)) "isError")
- (string-contains (content-text (result (list-ref responses 108))) "Tool error in jerboa_suggest_feature")
- (not (string-contains (content-text (result (list-ref responses 108))) "failed for ~a"))))
+(check "tool handler error is opaque with reference"
+ (let ([text (content-text (result (list-ref responses 108)))])
+ (and (hash-ref (result (list-ref responses 108)) "isError")
+ (string-contains text "Tool error in jerboa_suggest_feature")
+ (string-contains text "Internal server error")
+ (string-contains text "Reference:")
+ (not (string-contains text "failed for ~a"))
+ (not (string-contains text "/tmp/jmcp-missing-dir")))))
(check "verify WPO mode runs"
(string-contains (content-text (result (list-ref responses 109))) "WPO verify passed"))