Commit78a45d43Recorded24 Jun 2026Repositorysigil-mcp

Revert tool-handler dispatch to plain guard; VM bug fixed in sigil 0.16.0

Message

The call/cc-escape workaround in handle-tools-call (added in 75dbf3c / v0.16.2) dodged a VM bug where an exception propagating through map's CPS frames corrupted call-with-prompt's return context. That escape, run from inside a with-exception-handler, jumped past the dispatch loop's continuation on the buggy VM: the error response was delivered but the loop never resumed, so the next request got "Connection closed" and the server was dead until restart.

That VM bug is fixed in sigil v0.16.0 (the guard-raise-escape / abort-propagation fix, 3dd14f94). sigil-mcp requires sigil ^0.16, so every supported build runs a fixed VM and the workaround is dead weight that was itself the cause of the wedge. Revert handle-tools-call to a plain guard (matching every other handler) and restore unified guarded dispatch in mcp-server-handle-message.

Add a regression group "tool-handler error isolation" that drives the full mcp-server-run loop with a raising tools/call followed by a second request, asserting both get well-formed responses and the loop survives -- in both a plain and a with-async/go context.

Bump to 0.16.3.

Changed
 package.sgl              |   2 +-
 sigil.lock               |  20 ++++++++++----------
 src/sigil/mcp/server.sgl | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------------------------------------------------------
 test/test-server.sgl     |  88 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 4 files changed, 159 insertions(+), 87 deletions(-)
Diff
package.sglmodified
@@ -7,7 +7,7 @@
7
8
(package
9
name: "sigil-mcp"
−10
version: "0.16.2"
+10
version: "0.16.3"
11
sigil: "^0.16"
12
description: "Library for building MCP servers in Sigil"
13
url: "https://codeberg.org/sigil/sigil-mcp"
sigil.lockmodified
@@ -1,19 +1,19 @@
1
;; Auto-generated by sigil deps install. Do not edit.
2
(lock
3
(package name: "sigil-stdlib"
−4
url: "codeberg:sigil/sigil-lang"
−5
ref: "^0.14"
−6
sha: "dba24e3fe531bc150bcf93444e764f87fb321850"
+4
url: "codeberg:sigil/sigil"
+5
ref: "^0.16"
+6
sha: "136c07b8cf1547ddd2d96a450df45a17e5ae6665"
7
package-selector: "sigil-stdlib"
−8
version: "0.14.1")
+8
version: "0.16.2")
9
(package name: "sigil-json"
10
url: "codeberg:sigil/sigil-json"
−11
ref: "^0.14.0"
−12
sha: "a6b76e84bdcccfbed79b048ed8bc9850d08efae7"
−13
version: "0.14.0")
+11
ref: "^0.16"
+12
sha: "55c9e74712b5f79b45d41c65cfe0aef2c8f7e155"
+13
version: "0.16.0")
14
(package name: "sigil-log"
15
url: "codeberg:sigil/sigil-log"
−16
ref: "^0.14.0"
−17
sha: "0e8106b6e064e9ddb0ff3997e3559ad04f8dfdf1"
−18
version: "0.14.0")
+16
ref: "^0.16"
+17
sha: "56e4fc5a52dc370c037ef14502bb8d6d2876dc53"
+18
version: "0.16.0")
19
)
src/sigil/mcp/server.sglmodified
@@ -269,43 +269,30 @@
269
(if (null? (cdr missing)) "" "s")
270
(comma-join missing))))
271
(else
−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)))))))))))))))))))
+272
;; A raising handler is caught and converted to a JSON-RPC
+273
;; error response. This uses a plain `guard` like every other
+274
;; handler. (Earlier releases needed a call/cc-escape workaround
+275
;; here to dodge a VM bug where an exception propagating through
+276
;; map's CPS frames corrupted call-with-prompt's return context;
+277
;; that escape wedged the dispatch loop. The VM bug was fixed in
+278
;; sigil v0.16.0, and this package requires ^0.16, so the plain
+279
;; guard is correct. See test "tool-handler error isolation".)
+280
(guard (e (else
+281
(let ((err-msg (guard (fe (else "unknown error"))
+282
(format-exception e))))
+283
(guard (le (else #f))
+284
(log-error "tool/call failed" tool: name
+285
error: err-msg))
+286
(make-error-response id error-internal
+287
(format "Tool error: ~a" err-msg)))))
+288
(let ((result ((tool-def-handler tool) args)))
+289
(guard (le (else #f))
+290
(log-debug "tool/call completed" tool: name))
+291
(make-response id
+292
`((content . (((type . "text")
+293
(text . ,(if (string? result)
+294
result
+295
(json-encode result))))))))))))))))))
296
)
297
298
(define (handle-resources-list server params id)
@@ -382,43 +369,42 @@
369
(let ((method (jsonrpc-request-method msg))
370
(params (or (jsonrpc-request-params msg) '()))
371
(id (jsonrpc-request-id msg)))
−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))))))))
+372
;; Guard the entire request dispatch so any error during tool
+373
;; lookup, schema validation, or handler execution still returns a
+374
;; JSON-RPC error response. Without this, an uncaught error escapes
+375
;; the read loop and a live client hangs forever waiting for a reply.
+376
(guard (e (else
+377
(let ((err-msg (guard (fe (else "unknown error"))
+378
(format-exception e))))
+379
(guard (le (else #f))
+380
(log-error "request dispatch failed" id: id error: err-msg))
+381
(make-error-response id error-internal
+382
(format "Internal error: ~a" err-msg)))))
+383
(log-debug "request" method: method id: id)
+384
(cond
+385
((equal? method "initialize")
+386
(handle-initialize server params id))
+387
((equal? method "tools/list")
+388
(handle-tools-list server params id))
+389
((equal? method "tools/call")
+390
(handle-tools-call server params id))
+391
((equal? method "resources/list")
+392
(handle-resources-list server params id))
+393
((equal? method "resources/read")
+394
(handle-resources-read server params id))
+395
((equal? method "resources/templates/list")
+396
(make-response id `((resourceTemplates . ,#()))))
+397
((equal? method "prompts/list")
+398
(handle-prompts-list server params id))
+399
((equal? method "prompts/get")
+400
(handle-prompts-get server params id))
+401
((equal? method "ping")
+402
(log-debug "pong" id: id)
+403
(make-response id '()))
+404
(else
+405
(log-warn "Unknown method" method: method)
+406
(make-error-response id error-method-not-found
+407
(format "Unknown method: ~a" method)))))))
408
((jsonrpc-notification? msg)
409
;; Handle notifications (no response expected)
410
(let ((method (jsonrpc-notification-method msg)))
@@ -495,4 +481,4 @@
481
line))
482
(mcp-write-response!
483
(make-error-response #f error-parse "Parse error"))))))
−498
(loop))))))))))
484
No newline at end of file
+485
(loop))))))))
486
No newline at end of file
test/test-server.sglmodified
@@ -3,7 +3,9 @@
3
(sigil mcp protocol)
4
(sigil json)
5
(sigil string)
−6
(sigil io))
+6
(sigil io)
+7
(sigil log)
+8
(sigil async))
9
10
;; ============================================================
11
;; Server creation
@@ -216,6 +218,90 @@
218
(assert-true (jsonrpc-response? resp))
219
(assert-equal "ok" (assoc-ref 'text (car content)))))))
220
+221
;; ============================================================
+222
;; tool-handler error isolation — dispatch loop must survive a raise
+223
;; ============================================================
+224
;;
+225
;; Regression for the "MCP dispatch continuation wedge": a tool handler
+226
;; that raises must return a clean JSON-RPC error AND leave the server
+227
;; loop alive to serve the NEXT request. The earlier workaround used a
+228
;; call/cc escape from inside a with-exception-handler to dodge a Sigil
+229
;; VM bug (exception propagation through map's CPS frames corrupting
+230
;; call-with-prompt's return context). On the buggy VM that escape jumped
+231
;; past the dispatch loop's continuation, so the loop never resumed and
+232
;; the next request got "Connection closed". The VM bug was fixed in
+233
;; sigil v0.16.0 (the guard-raise-escape / abort-propagation fix), so
+234
;; handle-tools-call now uses a plain `guard` like every other handler.
+235
;;
+236
;; These tests drive the full mcp-server-run loop: a raising tools/call
+237
;; followed by a second request, asserting BOTH get well-formed responses.
+238
;; The async variant runs inside with-async/go with logging enabled,
+239
;; reproducing the production context (scheduler prompt + async logging
+240
;; path live on the stack) where the wedge originally manifested.
+241
+242
(define (drive-loop server input-string)
+243
;; Run mcp-server-run over a string input, returning the non-empty
+244
;; response lines written to stdout.
+245
(let ((input (open-input-string input-string))
+246
(output (open-output-string)))
+247
(parameterize ((current-input-port input)
+248
(current-output-port output))
+249
(mcp-server-run server load-env?: #f))
+250
(filter (lambda (l) (not (string-empty? l)))
+251
(string-split (get-output-string output) "\n"))))
+252
+253
(define (raise+follow-up-input)
+254
(string-append
+255
(json-encode (dict jsonrpc: "2.0" id: 1 method: "tools/call"
+256
params: (dict name: "boom" arguments: (dict))))
+257
"\n"
+258
(json-encode (dict jsonrpc: "2.0" id: 2 method: "ping" params: (dict)))
+259
"\n"))
+260
+261
(test-group "tool-handler error isolation"
+262
(test "raising tool/call returns error AND loop serves next request"
+263
(let ((s (mcp-server name: "test" version: "1.0")))
+264
(mcp-server-register-tool! s "boom" "Always fails" '()
+265
(lambda (args) (error "intentional boom")))
+266
(let ((lines (drive-loop s (raise+follow-up-input))))
+267
;; Both requests answered: loop survived the raise.
+268
(assert-equal 2 (length lines))
+269
(let ((resp1 (json-decode (car lines)))
+270
(resp2 (json-decode (cadr lines))))
+271
;; First: well-formed JSON-RPC error for the raising call.
+272
(assert-equal 1 (dict-ref resp1 id:))
+273
(assert-true (dict-ref resp1 error: #f))
+274
(assert-equal error-internal
+275
(dict-ref (dict-ref resp1 error:) code:))
+276
;; Second: the follow-up ping succeeded (no "Connection closed").
+277
(assert-equal 2 (dict-ref resp2 id:))
+278
(assert-false (dict-ref resp2 error: #f))))))
+279
+280
(test "loop survives a raising tool/call inside with-async/go"
+281
;; Faithful to production: mcp-server-run runs in a goroutine and
+282
;; logging routes through the async await-port-writable path. Logs
+283
;; go to a sink port so they don't pollute test output.
+284
(let ((s (mcp-server name: "test" version: "1.0"))
+285
(log-sink (open-output-string))
+286
(input (open-input-string (raise+follow-up-input)))
+287
(output (open-output-string)))
+288
(mcp-server-register-tool! s "boom" "Always fails" '()
+289
(lambda (args) (error "intentional boom")))
+290
(log-configure! level: 'debug target: log-sink)
+291
(parameterize ((current-input-port input)
+292
(current-output-port output))
+293
(with-async
+294
(go (mcp-server-run s load-env?: #f))))
+295
(log-configure! level: 'warn target: 'console)
+296
(let ((lines (filter (lambda (l) (not (string-empty? l)))
+297
(string-split (get-output-string output) "\n"))))
+298
(assert-equal 2 (length lines))
+299
(let ((resp1 (json-decode (car lines)))
+300
(resp2 (json-decode (cadr lines))))
+301
(assert-true (dict-ref resp1 error: #f))
+302
(assert-equal 2 (dict-ref resp2 id:))
+303
(assert-false (dict-ref resp2 error: #f)))))))
+304
305
;; ============================================================
306
;; resources/read
307
;; ============================================================