supervise: pin child status reader as data-only
ober
25eebd4e7d62b2c2339f9eeba06a7097151a6bcc
--- a/lib/std/os/supervise.ss +++ b/lib/std/os/supervise.ss @@ -363,6 +363,14 @@ (error . "empty child status"))] [else (try + ;; SECURITY: Chez's `read` does not evaluate any #-prefixed + ;; form at read time. `#.` is rejected ("invalid sharp-sign + ;; prefix"); `#%foo` becomes the data list (`$primitive` + ;; foo) which the caller destructures but never evals. So + ;; bare `read` is safe across this child→parent boundary + ;; without an extra `read-eval`-style guard (that parameter + ;; only exists in other Schemes / Common Lisp, not Chez). + ;; See issue #6 of docs/opus-47-review-handoff.md. (read (open-input-string s)) (catch (e) `((ok . #f) --- a/tests/test-limits-primitives.ss +++ b/tests/test-limits-primitives.ss @@ -140,6 +140,23 @@ ;; (Some macOS sandbox shims kill via SIGKILL; accept either.) (printf "[supervise]~%") +;; Handoff issue #6: the child→parent status channel must not be a code +;; execution vector. Chez's `read` already refuses `#.` and other +;; would-be read-eval prefixes (it has no read-eval parameter; that's a +;; Common Lisp / other-Scheme concept). These tests pin that contract +;; so the supervisor's bare `read` stays safe across the boundary. +(test "child-status-reader: #. is rejected at read time" + (guard (exn [#t 'rejected]) + (read (open-input-string "#.(error 'side-effect)"))) + 'rejected) +(test "child-status-reader: malformed status record yields an error, not eval" + (guard (exn [#t 'rejected]) + (read (open-input-string "#~unknown"))) + 'rejected) +(test "child-status-reader: plain status alist parses as data" + (read (open-input-string "((ok . #t) (where . child-status))")) + '((ok . #t) (where . child-status))) + (let ([r (supervise-run (launch-spec 'command: '("/bin/sleep" "5") 'timeout-ms: 80))])