Commit75dbf3c9Recorded22 Jun 2026Repositorysigil-mcp

Fix tool handler exceptions producing no JSON-RPC error response

Message

Sigil has two VM bugs affecting exception handling in the MCP server:

1. When an exception propagates through map's CPS continuation frames, call-with-prompt's return context (stackmark/framemark) is corrupted. Returning through with-exception-handler's call-with-prompt raises car:expected-pair and crashes the server.

2. When call/cc escape is invoked from within a with-exception-handler handler, Sigil's VM jumps past the c/cc capture site's calling context rather than resuming it normally. The escape value is not delivered to the code after the (call-with-current-continuation ...) form.

Workaround: in the else branch of handle-tools-call, the exception handler writes the JSON-RPC error response directly via mcp-write-response! before calling escape. This ensures the error response is written even though escape doesn't resume the caller normally.

Previously: malformed patch entries → server crash, no response After fix: malformed patch entries → JSON-RPC -32603 written, server exits

Bumps version to 0.16.2.

Changed
 package.sgl              |   2 +-
 src/sigil/mcp/server.sgl | 128 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------------------------------------------------
 2 files changed, 76 insertions(+), 54 deletions(-)
Diff
package.sglmodified
@@ -7,7 +7,7 @@
7
8
(package
9
name: "sigil-mcp"
−10
version: "0.16.1"
+10
version: "0.16.2"
11
sigil: "^0.16"
12
description: "Library for building MCP servers in Sigil"
13
url: "https://codeberg.org/sigil/sigil-mcp"
src/sigil/mcp/server.sglmodified
@@ -269,22 +269,43 @@
269
(if (null? (cdr missing)) "" "s")
270
(comma-join missing))))
271
(else
−272
(guard (e (else
−273
(let ((err-msg (guard (fe (else "unknown error"))
−274
(format-exception e))))
−275
(guard (le (else #f))
−276
(log-error "tool/call failed" tool: name
−277
error: err-msg))
−278
(make-error-response id error-internal
−279
(format "Tool error: ~a" err-msg)))))
−280
(let ((result ((tool-def-handler tool) args)))
−281
(guard (le (else #f))
−282
(log-debug "tool/call completed" tool: name))
−283
(make-response id
−284
`((content . (((type . "text")
−285
(text . ,(if (string? result)
−286
result
−287
(json-encode result))))))))))))))))))
+272
;; Sigil VM bug: when an exception propagates through map's CPS
+273
;; continuation frames, call-with-prompt's return context becomes
+274
;; corrupted (return_ip/stack_mark invalid). Using guard (which is
+275
;; call-with-prompt) causes car:expected-pair on handler return.
+276
;; Using call/cc escape from within the exception handler bypasses
+277
;; the corrupted return path, but Sigil's VM does not properly
+278
;; resume the continuation after escape-from-within-weh — the
+279
;; escape jumps past the caller, so the returned value is never
+280
;; propagated. Workaround: write the error response directly from
+281
;; inside the exception handler (before escaping), so the response
+282
;; is written even if the continuation is not resumed normally.
+283
(call-with-current-continuation
+284
(lambda (escape)
+285
(with-exception-handler
+286
(lambda (e)
+287
(let ((err-msg (guard (fe (else "unknown error"))
+288
(format-exception e))))
+289
(guard (le (else #f))
+290
(log-error "tool/call failed" tool: name
+291
error: err-msg))
+292
;; Write error response directly — escape will not resume
+293
;; the caller, so we cannot return this response the normal
+294
;; way.
+295
(guard (we (else #f))
+296
(mcp-write-response!
+297
(make-error-response id error-internal
+298
(format "Tool error: ~a" err-msg))))
+299
(escape #f)))
+300
(lambda ()
+301
(let ((result ((tool-def-handler tool) args)))
+302
(guard (le (else #f))
+303
(log-debug "tool/call completed" tool: name))
+304
(make-response id
+305
`((content . (((type . "text")
+306
(text . ,(if (string? result)
+307
result
+308
(json-encode result)))))))))))))))))))
309
)
310
311
(define (handle-resources-list server params id)
@@ -361,42 +382,43 @@
382
(let ((method (jsonrpc-request-method msg))
383
(params (or (jsonrpc-request-params msg) '()))
384
(id (jsonrpc-request-id msg)))
−364
;; Guard the entire request dispatch so any error during tool
−365
;; lookup, schema validation, or handler execution still returns a
−366
;; JSON-RPC error response. Without this, an uncaught error escapes
−367
;; the read loop and a live client hangs forever waiting for a reply.
−368
(guard (e (else
−369
(let ((err-msg (guard (fe (else "unknown error"))
−370
(format-exception e))))
−371
(guard (le (else #f))
−372
(log-error "request dispatch failed" id: id error: err-msg))
−373
(make-error-response id error-internal
−374
(format "Internal error: ~a" err-msg)))))
−375
(log-debug "request" method: method id: id)
−376
(cond
−377
((equal? method "initialize")
−378
(handle-initialize server params id))
−379
((equal? method "tools/list")
−380
(handle-tools-list server params id))
−381
((equal? method "tools/call")
−382
(handle-tools-call server params id))
−383
((equal? method "resources/list")
−384
(handle-resources-list server params id))
−385
((equal? method "resources/read")
−386
(handle-resources-read server params id))
−387
((equal? method "resources/templates/list")
−388
(make-response id `((resourceTemplates . ,#()))))
−389
((equal? method "prompts/list")
−390
(handle-prompts-list server params id))
−391
((equal? method "prompts/get")
−392
(handle-prompts-get server params id))
−393
((equal? method "ping")
−394
(log-debug "pong" id: id)
−395
(make-response id '()))
−396
(else
−397
(log-warn "Unknown method" method: method)
−398
(make-error-response id error-method-not-found
−399
(format "Unknown method: ~a" method)))))))
+385
;; tools/call is dispatched without the outer guard because
+386
;; handle-tools-call uses call/cc escape internally to avoid
+387
;; a Sigil VM bug (corrupted OP_PROMPT return context when
+388
;; exceptions propagate through map's CPS frames). The outer
+389
;; guard below wraps all other method handlers.
+390
(if (equal? method "tools/call")
+391
(handle-tools-call server params id)
+392
(guard (e (else
+393
(let ((err-msg (guard (fe (else "unknown error"))
+394
(format-exception e))))
+395
(guard (le (else #f))
+396
(log-error "request dispatch failed" id: id error: err-msg))
+397
(make-error-response id error-internal
+398
(format "Internal error: ~a" err-msg)))))
+399
(log-debug "request" method: method id: id)
+400
(cond
+401
((equal? method "initialize")
+402
(handle-initialize server params id))
+403
((equal? method "tools/list")
+404
(handle-tools-list server params id))
+405
((equal? method "resources/list")
+406
(handle-resources-list server params id))
+407
((equal? method "resources/read")
+408
(handle-resources-read server params id))
+409
((equal? method "resources/templates/list")
+410
(make-response id `((resourceTemplates . ,#()))))
+411
((equal? method "prompts/list")
+412
(handle-prompts-list server params id))
+413
((equal? method "prompts/get")
+414
(handle-prompts-get server params id))
+415
((equal? method "ping")
+416
(log-debug "pong" id: id)
+417
(make-response id '()))
+418
(else
+419
(log-warn "Unknown method" method: method)
+420
(make-error-response id error-method-not-found
+421
(format "Unknown method: ~a" method))))))))
422
((jsonrpc-notification? msg)
423
;; Handle notifications (no response expected)
424
(let ((method (jsonrpc-notification-method msg)))
@@ -473,4 +495,4 @@
495
line))
496
(mcp-write-response!
497
(make-error-response #f error-parse "Parse error"))))))
−476
(loop))))))))
498
No newline at end of file
+499
(loop))))))))))
500
No newline at end of file