Harden core runtime security controls
ober
1f3f35f4b9aaa9e70f0b8b7ed67e8cf1f61aac8a
--- a/data/api-signatures.sexp +++ b/data/api-signatures.sexp @@ -1,4 +1,4 @@ -(("errors") ("generated" . "2026-06-14") +(("errors") ("generated" . "2026-06-25") ("modules" ("(jerboa build musl)" ("exports" "build-musl-binary" "make-musl-cross-target" @@ -361,23 +361,23 @@ ("exports" "&jerboa" "&sandbox-error" "*default-timeout*" "*fasl-allow-procedures*" "*fasl-max-byte-size*" "*fasl-max-object-count*" "*method-tables*" "*safe-mode*" - "*sandbox-landlock*" "*sandbox-seccomp*" "*sandbox-timeout*" - "*struct-types*" "1+" "1-" "ContractViolation" "Error" - "aget" "agetq" "agetv" "alist->hash-table" "any" "aset!" - "asetq!" "asetv!" "assert!" "bind-method!" "call-method" - "call-with-resource" "call-with-safe-input-file" - "call-with-safe-output-file" "catch" "chain" "chain-and" - "connection-refused?" "connection-timeout?" - "db-connection-error?" "db-constraint-violation?" - "db-error?" "db-query-error?" "def" "def*" "defclass" - "defmethod" "defrule" "defrules" "defstruct" "displayln" - "drop" "eprintf" "error-irritants" "error-message" - "error-trace" "every" "filter-map" "finally" "flatten" - "format" "fprintf" "group-by" "hash->list" "hash->plist" - "hash-clear!" "hash-copy" "hash-eq-literal" "hash-find" - "hash-fold" "hash-for-each" "hash-get" "hash-key?" - "hash-keys" "hash-length" "hash-literal" "hash-map" - "hash-merge" "hash-merge!" "hash-put!" "hash-ref" + "*sandbox-landlock*" "*sandbox-max-memory-size*" + "*sandbox-seccomp*" "*sandbox-timeout*" "*struct-types*" + "1+" "1-" "ContractViolation" "Error" "aget" "agetq" "agetv" + "alist->hash-table" "any" "aset!" "asetq!" "asetv!" + "assert!" "bind-method!" "call-method" "call-with-resource" + "call-with-safe-input-file" "call-with-safe-output-file" + "catch" "chain" "chain-and" "connection-refused?" + "connection-timeout?" "db-connection-error?" + "db-constraint-violation?" "db-error?" "db-query-error?" + "def" "def*" "defclass" "defmethod" "defrule" "defrules" + "defstruct" "displayln" "drop" "eprintf" "error-irritants" + "error-message" "error-trace" "every" "filter-map" "finally" + "flatten" "format" "fprintf" "group-by" "hash->list" + "hash->plist" "hash-clear!" "hash-copy" "hash-eq-literal" + "hash-find" "hash-fold" "hash-for-each" "hash-get" + "hash-key?" "hash-keys" "hash-length" "hash-literal" + "hash-map" "hash-merge" "hash-merge!" "hash-put!" "hash-ref" "hash-remove!" "hash-table?" "hash-update!" "hash-values" "iota" "jerboa-condition-subsystem" "jerboa-condition?" "json-object->string" "keyword->string" "keyword?" @@ -397,23 +397,24 @@ "run-safe-eval" "safe-fasl-read" "safe-fasl-read-bytevector" "safe-fasl-write" "safe-fasl-write-bytevector" "sandbox-config-capabilities" "sandbox-config-landlock" - "sandbox-config-seccomp" "sandbox-config-timeout" - "sandbox-config?" "sandbox-error-detail" - "sandbox-error-phase" "sandbox-error?" "scope-spawn" - "scope-spawn-named" "snoc" "sort" "sort!" "sqlite-bind" - "sqlite-close" "sqlite-exec" "sqlite-execute" - "sqlite-finalize" "sqlite-open" "sqlite-prepare" - "sqlite-query" "sqlite-step" "stable-sort" "stable-sort!" - "string->json-object" "string->keyword" "string-contains" - "string-empty?" "string-index" "string-join" - "string-prefix?" "string-split" "string-suffix?" - "string-trim" "struct-field-ref" "struct-field-set!" - "struct-predicate" "struct-type-info" "take" "task-await" - "task-cancel" "task-done?" "task-name" "task-result" "task?" - "tcp-accept" "tcp-close" "tcp-connect" "tcp-listen" - "tcp-read" "tcp-write" "tcp-write-string" "timeout-error?" - "try" "unique" "unregister-safe-record-type!" "until" - "while" "with-input-from-string" "with-output-to-string" + "sandbox-config-max-memory-size" "sandbox-config-seccomp" + "sandbox-config-timeout" "sandbox-config?" + "sandbox-error-detail" "sandbox-error-phase" + "sandbox-error?" "scope-spawn" "scope-spawn-named" "snoc" + "sort" "sort!" "sqlite-bind" "sqlite-close" "sqlite-exec" + "sqlite-execute" "sqlite-finalize" "sqlite-open" + "sqlite-prepare" "sqlite-query" "sqlite-step" "stable-sort" + "stable-sort!" "string->json-object" "string->keyword" + "string-contains" "string-empty?" "string-index" + "string-join" "string-prefix?" "string-split" + "string-suffix?" "string-trim" "struct-field-ref" + "struct-field-set!" "struct-predicate" "struct-type-info" + "take" "task-await" "task-cancel" "task-done?" "task-name" + "task-result" "task?" "tcp-accept" "tcp-close" "tcp-connect" + "tcp-listen" "tcp-read" "tcp-write" "tcp-write-string" + "timeout-error?" "try" "unique" + "unregister-safe-record-type!" "until" "while" + "with-input-from-string" "with-output-to-string" "with-resource" "with-resource1" "with-task-scope" "with-timeout" "write-file-string" "write-json" "zip" "~") ("file" . "lib/jerboa/prelude/safe.ss") @@ -2139,6 +2140,12 @@ ("exports" "cert-fingerprint" "generate-self-signed-cert!") ("file" . "lib/std/crypto/x509.ss") ("tier" . "stable")) + ("(std crypto)" + ("exports" "hmac" "hmac-md5" "hmac-sha1" "hmac-sha256" "hmac-sha384" + "hmac-sha512" "random-bytes" "random-bytes!" "random-token" + "random-u64" "random-uuid") + ("file" . "lib/std/crypto.ss") + ("tier" . "stable")) ("(std csp clj)" ("exports" "<!" "<!!" ">!" ">!!" "admix" "alt!" "alt!!" "alts!" "alts!!" "async-reduce" "buffer-spec?" "chan" @@ -3135,6 +3142,10 @@ "type-aliases" "type-of") ("file" . "lib/std/macro-types.ss") ("tier" . "stable")) + ("(std markup html)" + ("exports" "sxml->html" "sxml->string" "sxml->xml") + ("file" . "lib/std/markup/html.ss") + ("tier" . "stable")) ("(std markup html-parser)" ("exports" "html->sxml" @@ -3977,6 +3988,11 @@ "router-add!" "router-add-prefix!" "router-lookup") ("file" . "lib/std/net/httpd.ss") ("tier" . "stable")) + ("(std net httpsd)" + ("exports" "httpsd-default-security-headers" "httpsd-listen-port" + "httpsd-start" "httpsd-start*" "httpsd-stop!" "httpsd?") + ("file" . "lib/std/net/httpsd.ss") + ("tier" . "stable")) ("(std net io)" ("exports" "fiber-tcp-accept" "fiber-tcp-close" "fiber-tcp-connect" "fiber-tcp-listen" "fiber-tcp-read" "fiber-tcp-write" @@ -4403,9 +4419,10 @@ ("file" . "lib/std/net/udp.ss") ("tier" . "stable")) ("(std net uri)" - ("exports" "alist->query-string" "query-string->alist" "uri->string" - "uri-decode" "uri-encode" "uri-fragment" "uri-host" - "uri-parse" "uri-path" "uri-port" "uri-query" "uri-scheme" + ("exports" "alist->query-string" "form-url-decode" "form-url-encode" + "query-string->alist" "uri->string" "uri-decode" + "uri-encode" "uri-fragment" "uri-host" "uri-parse" + "uri-path" "uri-port" "uri-query" "uri-scheme" "uri-userinfo") ("file" . "lib/std/net/uri.ss") ("tier" . "stable")) @@ -4439,14 +4456,6 @@ "notebook-name" "notebook?") ("file" . "lib/std/notebook.ss") ("tier" . "stable")) - ("(std nrepl)" - ("exports" - "nrepl-running?" - "nrepl-server-port" - "nrepl-start!" - "nrepl-stop!") - ("file" . "lib/std/nrepl.sls") - ("tier" . "stable")) ("(std odb)" ("exports" "*odb*" ":f64" ":mptr" ":s64" ":string" "define-persistent-class" "doclass" "mptr->object" @@ -5595,6 +5604,15 @@ "validation-error?") ("file" . "lib/std/schema.ss") ("tier" . "stable")) + ("(std secmon telemetry)" + ("exports" "MUX-MSG-ENCRYPTED" "MUX-MSG-TELEMETRY" + "make-secmon-telemetry" "secmon-mux-frame" + "secmon-mux-telemetry-frame" "secmon-telemetry-emit!" + "secmon-telemetry-enabled?" "secmon-telemetry-event" + "secmon-telemetry-from-env" "secmon-telemetry-send!" + "secmon-telemetry?" "secmon-transport-key") + ("file" . "lib/std/secmon/telemetry.ss") + ("tier" . "stable")) ("(std secure compiler)" ("exports" "make-slang-config" "parse-slang-module" "slang-allowed-forms" "slang-compile" "slang-config-debug?" @@ -5791,11 +5809,12 @@ ("tier" . "stable")) ("(std security sandbox)" ("exports" "&sandbox-error" "*sandbox-capsicum*" - "*sandbox-landlock*" "*sandbox-seatbelt*" - "*sandbox-seccomp*" "*sandbox-timeout*" + "*sandbox-landlock*" "*sandbox-max-memory-size*" + "*sandbox-seatbelt*" "*sandbox-seccomp*" "*sandbox-timeout*" "make-sandbox-config" "make-sandbox-error" "run-safe" "run-safe-eval" "sandbox-config-capabilities" "sandbox-config-capsicum" "sandbox-config-landlock" + "sandbox-config-max-memory-size" "sandbox-config-max-output-size" "sandbox-config-seatbelt" "sandbox-config-seccomp" "sandbox-config-timeout" "sandbox-config?" "sandbox-error-detail" @@ -6936,13 +6955,13 @@ ("file" . "lib/std/zipper.ss") ("tier" . "stable"))) ("source_root" . "/Users/user/mine/jerboa") - ("stats" ("modules" . 707) ("parse_errors" . 0) ("symbols" . 10267) + ("stats" ("modules" . 710) ("parse_errors" . 0) ("symbols" . 10285) ("tiers" ("compat" . 47) ("core" . 34) - ("stable" . 548) + ("stable" . 551) ("unstable" . 78)) - ("total_exports" . 13466)) + ("total_exports" . 13500)) ("symbol_index" ("%chan-enqueue-raw!" "(std csp)") ("&actor-dead" "(std error conditions)") ("&actor-timeout" "(std error conditions)") @@ -7087,6 +7106,9 @@ ("*sandbox-landlock*" "(jerboa prelude safe)" "(std security sandbox)") + ("*sandbox-max-memory-size*" + "(jerboa prelude safe)" + "(std security sandbox)") ("*sandbox-seatbelt*" "(std security sandbox)") ("*sandbox-seccomp*" "(jerboa prelude safe)" @@ -7382,9 +7404,11 @@ ("METHOD-NOT-FOUND" "(lsp jsonrpc)") ("MS_ASYNC" "(std os mmap)") ("MS_INVALIDATE" "(std os mmap)") - ("MS_SYNC" "(std os mmap)") ("Monad" "(std typed hkt)") - ("NIL->VAL" "(std specter)") ("NaN?" "(std clojure)") - ("Natural" "(std typed refine)") + ("MS_SYNC" "(std os mmap)") + ("MUX-MSG-ENCRYPTED" "(std secmon telemetry)") + ("MUX-MSG-TELEMETRY" "(std secmon telemetry)") + ("Monad" "(std typed hkt)") ("NIL->VAL" "(std specter)") + ("NaN?" "(std clojure)") ("Natural" "(std typed refine)") ("Navigable" "(jerboa clojure)" "(std datafy)") ("NetIO" "(std security io-intercept)") ("NonEmpty" "(std typed refine)") @@ -10753,6 +10777,8 @@ ("foreign-set!" "(std foreign)" "(std ftype)") ("foreign-sizeof" "(std foreign)" "(std ftype)") ("forked" "(std srfi srfi-159)") + ("form-url-decode" "(std net uri)") + ("form-url-encode" "(std net uri)") ("format" "(jerboa clojure)" "(jerboa prelude safe)" "(jerboa prelude)" "(std format)" "(std prelude)") ("format-build-result" "(std build watch)") @@ -11365,12 +11391,12 @@ ("hkt-dispatch" "(std typed hkt)") ("hkt-instance" "(std typed hkt)") ("hkt-instance?" "(std typed hkt)") - ("hmac" "(std crypto hmac)") - ("hmac-md5" "(std crypto hmac)") - ("hmac-sha1" "(std crypto hmac)") - ("hmac-sha256" "(std crypto hmac)") - ("hmac-sha384" "(std crypto hmac)") - ("hmac-sha512" "(std crypto hmac)") + ("hmac" "(std crypto hmac)" "(std crypto)") + ("hmac-md5" "(std crypto hmac)" "(std crypto)") + ("hmac-sha1" "(std crypto hmac)" "(std crypto)") + ("hmac-sha256" "(std crypto hmac)" "(std crypto)") + ("hmac-sha384" "(std crypto hmac)" "(std crypto)") + ("hmac-sha512" "(std crypto hmac)" "(std crypto)") ("holding-resource!" "(std concur deadlock)") ("host-is-ipv4-literal?" "(std net allow-proxy)" @@ -11462,6 +11488,12 @@ ("httpd-start" "(std net httpd)") ("httpd-start-https" "(std net httpd)") ("httpd-stop" "(std net httpd)") + ("httpsd-default-security-headers" "(std net httpsd)") + ("httpsd-listen-port" "(std net httpsd)") + ("httpsd-start" "(std net httpsd)") + ("httpsd-start*" "(std net httpsd)") + ("httpsd-stop!" "(std net httpsd)") + ("httpsd?" "(std net httpsd)") ("iappend" "(std srfi srfi-116)") ("icar" "(std srfi srfi-116)") ("icdr" "(std srfi srfi-116)") @@ -13015,6 +13047,7 @@ ("make-seccomp-blocklist" "(std security seccomp)") ("make-seccomp-error" "(std os seccomp)") ("make-seccomp-filter" "(std security seccomp)") + ("make-secmon-telemetry" "(std secmon telemetry)") ("make-secret" "(std security secret)") ("make-security-headers" "(std net security-headers)") ("make-security-level" "(std security flow)") @@ -13609,9 +13642,6 @@ ("notebook?" "(std notebook)" "(std repl notebook)") ("nothing" "(std srfi srfi-159)") ("notify-change!" "(std dev reload)") - ("nrepl-running?" "(std nrepl)") - ("nrepl-server-port" "(std nrepl)") - ("nrepl-start!" "(std nrepl)") ("nrepl-stop!" "(std nrepl)") ("nth-prime" "(std misc prime)") ("nthpath" "(std specter)") ("null-list?" "(std srfi srfi-1)") ("nullo" "(jerboa clojure)" "(std logic)") @@ -14895,12 +14925,12 @@ ("raise-ssh-timeout-error" "(std net ssh conditions)") ("raise-timeout-error" "(std error conditions)") ("random-ascii-string" "(std test fuzz)") - ("random-bytes" - "(jerboa core)" + ("random-bytes" "(jerboa core)" "(std crypto etc)" + "(std crypto random)" "(std crypto)" "(std gambit-compat)") + ("random-bytes!" "(std crypto etc)" "(std crypto random)" - "(std gambit-compat)") - ("random-bytes!" "(std crypto etc)" "(std crypto random)") + "(std crypto)") ("random-bytevector" "(std test fuzz)") ("random-choice" "(std test fuzz)") ("random-element" "(std test fuzz)") @@ -14910,10 +14940,13 @@ "(jerboa prelude)" "(std gambit-compat)") ("random-suffix" "(std pkg util)") - ("random-token" "(std crypto random)") - ("random-u64" "(std crypto random)") + ("random-token" "(std crypto random)" "(std crypto)") + ("random-u64" "(std crypto random)" "(std crypto)") ("random-utf8-string" "(std test fuzz)") - ("random-uuid" "(std clojure)" "(std crypto random)") + ("random-uuid" + "(std clojure)" + "(std crypto random)" + "(std crypto)") ("range" "(jerboa clojure)" "(std clojure)") ("range->generator" "(std srfi srfi-121)") ("range->json" "(lsp types)") @@ -15909,6 +15942,9 @@ ("sandbox-config-landlock" "(jerboa prelude safe)" "(std security sandbox)") + ("sandbox-config-max-memory-size" + "(jerboa prelude safe)" + "(std security sandbox)") ("sandbox-config-max-output-size" "(std security sandbox)") ("sandbox-config-seatbelt" "(std security sandbox)") ("sandbox-config-seccomp" @@ -16096,6 +16132,15 @@ ("seccomp-lock-strict!" "(std os seccomp)") ("seccomp-log" "(std security seccomp)") ("seccomp-trap" "(std security seccomp)") + ("secmon-mux-frame" "(std secmon telemetry)") + ("secmon-mux-telemetry-frame" "(std secmon telemetry)") + ("secmon-telemetry-emit!" "(std secmon telemetry)") + ("secmon-telemetry-enabled?" "(std secmon telemetry)") + ("secmon-telemetry-event" "(std secmon telemetry)") + ("secmon-telemetry-from-env" "(std secmon telemetry)") + ("secmon-telemetry-send!" "(std secmon telemetry)") + ("secmon-telemetry?" "(std secmon telemetry)") + ("secmon-transport-key" "(std secmon telemetry)") ("second" "(std srfi srfi-1)") ("seconds->duration" "(std time)") ("seconds->time" "(std srfi srfi-19)") @@ -17403,9 +17448,11 @@ "(jerboa prelude)" "(std clojure)" "(std misc atom)") - ("sxml->html" "(std markup sxml-print)") - ("sxml->string" "(std markup sxml-print)") - ("sxml->xml" "(std markup sxml-print)") + ("sxml->html" "(std markup html)" "(std markup sxml-print)") + ("sxml->string" + "(std markup html)" + "(std markup sxml-print)") + ("sxml->xml" "(std markup html)" "(std markup sxml-print)") ("sxml-attr" "(std text html-parse)") ("sxml-attribute-e" "(std markup xml)" "(std text xml)") ("sxml-attributes" "(std markup xml)" "(std text xml)") --- a/docs/ai-threat.md +++ b/docs/ai-threat.md @@ -119,22 +119,30 @@ resource consumption but don't prevent clever abuse within bounds. ### Denial of Service Within the Sandbox -`run-safe` has an engine-based timeout, but an adversary can still exhaust -memory before the timeout fires. Chez engines preempt CPU but not allocation. -A `(make-bytevector 1000000000)` inside a sandbox will OOM the child process -(and potentially the parent if fork copy-on-write pages aren't limited). - -**Known gap**: `run-safe` does not set `ulimit`-style memory caps. Should add -`setrlimit(RLIMIT_AS, ...)` in the child before running the thunk. +`run-safe` has an engine-based timeout. Memory limits are configured separately: +`make-sandbox-config` accepts `max-memory-size`, which installs a child-process +`setrlimit(RLIMIT_AS, ...)` policy after `fork` and before the thunk runs. + +```scheme +(run-safe + (lambda () (expensive-untrusted-work)) + (make-sandbox-config + 'timeout 2 + 'max-memory-size (* 256 1024 1024))) +``` + +The cap is opt-in because platforms disagree on address-space limit semantics +and Chez may already have a large mapped heap before the fork. If the requested +limit cannot be installed, `run-safe` reports a sandbox error rather than +silently continuing. ### Temp File Race in run-safe -`run-safe` communicates with the child via `/tmp/jerboa-sandbox-*` with a -random numeric suffix. This is a predictable filename — an attacker with local -access can create symlinks to redirect the result file. +`run-safe` now communicates with the child via `pipe(2)`. It does not create a +predictable `/tmp/jerboa-sandbox-*` result file, so the old symlink/TOCTOU +result-file attack is closed. -**Known bug**: Should use `mkstemp` equivalent or `O_TMPFILE` (Linux 3.11+). -Status: open. +Status: fixed in the fork-based sandbox implementation. ### The Pre-Existing Import Conflict @@ -179,11 +187,11 @@ patterns. If the pattern doesn't exist, there's nothing to find. | Issue | Severity | Status | |-------|----------|--------| -| Temp file race in `run-safe` | Medium | Known, not fixed | -| No memory limit in sandbox child | Medium | Known, not fixed | +| Temp file race in `run-safe` | Medium | Fixed (pipe-based child result channel) | +| No memory limit in sandbox child | Medium | Fixed when `max-memory-size` is configured | | Import conflict in safe prelude | Low | Known, cosmetic | | SQL injection heuristic bypasses | Medium | By design (use parameterized queries) | -| No `setrlimit` in forked child | Medium | Known, not fixed | +| No `setrlimit` in forked child | Medium | Fixed for configured `max-memory-size` | | Seccomp/Landlock x86_64-only | Low | By design (arch-specific syscalls) | | Silent degradation on non-Linux | Medium | Known (skips kernel protections) | --- a/docs/api-index.md +++ b/docs/api-index.md @@ -9213,6 +9213,7 @@ Every exported symbol, mapped to the modules that export it. If a symbol has mul | `sandbox-config-capabilities` | `(jerboa prelude safe)`, `(std security sandbox)` | | `sandbox-config-capsicum` | `(std security sandbox)` | | `sandbox-config-landlock` | `(jerboa prelude safe)`, `(std security sandbox)` | +| `sandbox-config-max-memory-size` | `(jerboa prelude safe)`, `(std security sandbox)` | | `sandbox-config-max-output-size` | `(std security sandbox)` | | `sandbox-config-seatbelt` | `(std security sandbox)` | | `sandbox-config-seccomp` | `(jerboa prelude safe)`, `(std security sandbox)` | @@ -11009,6 +11010,7 @@ Every exported symbol, mapped to the modules that export it. If a symbol has mul | `*safe-mode*` | `(jerboa prelude safe)`, `(std safe)` | | `*sandbox-capsicum*` | `(std security sandbox)` | | `*sandbox-landlock*` | `(jerboa prelude safe)`, `(std security sandbox)` | +| `*sandbox-max-memory-size*` | `(jerboa prelude safe)`, `(std security sandbox)` | | `*sandbox-seatbelt*` | `(std security sandbox)` | | `*sandbox-seccomp*` | `(jerboa prelude safe)`, `(std security sandbox)` | | `*sandbox-timeout*` | `(jerboa prelude safe)`, `(std security sandbox)` | @@ -13194,7 +13196,7 @@ All 626 modules sorted by name. Export count in parentheses. | `(std security metrics)` | 10 | `lib/std/security/metrics.sls` | | `(std security privsep)` | 12 | `lib/std/security/privsep.sls` | | `(std security restrict)` | 4 | `lib/std/security/restrict.sls` | -| `(std security sandbox)` | 21 | `lib/std/security/sandbox.sls` | +| `(std security sandbox)` | 23 | `lib/std/security/sandbox.sls` | | `(std security sanitize)` | 17 | `lib/std/security/sanitize.sls` | | `(std security seatbelt)` | 7 | `lib/std/security/seatbelt.sls` | | `(std security seccomp)` | 13 | `lib/std/security/seccomp.sls` | @@ -13339,4 +13341,3 @@ All 626 modules sorted by name. Export count in parentheses. | `(thunderchez sql-null)` | 6 | `lib/thunderchez/sql-null.sls` | | `(thunderchez thunder-utils)` | 17 | `lib/thunderchez/thunder-utils.sls` | | `(thunderchez usb)` | 29 | `lib/thunderchez/usb.sls` | - --- a/docs/async.md +++ b/docs/async.md @@ -110,10 +110,14 @@ Entry point for async code. Runs `thunk` in a new thread with Async effect handl (run-async/workers thunk n-workers) => value ``` -Identical to `run-async` in behavior. The `n-workers` argument is accepted for API compatibility but has no effect: since each `(Async spawn ...)` call creates a dedicated OS thread, there is no fixed worker pool to size. Future versions may use `n-workers` to cap parallelism via a semaphore. +Like `run-async`, but caps concurrent `(Async spawn ...)` tasks with a +semaphore. The root task that calls `run-async/workers` is not counted against +the worker limit; spawned async tasks acquire a worker slot before their thread +starts and release it when the task exits. `n-workers` must be a positive +integer. ```scheme -(run-async/workers my-thunk 4) ; n-workers is currently ignored +(run-async/workers my-thunk 4) ; at most 4 spawned async tasks run at once ``` --- @@ -375,12 +379,15 @@ When a task spawned by `async-task` or `(Async spawn ...)` throws an unhandled e | Scenario | Recommendation | |---|---| | CPU-bound parallel work | Use `async-task` / `gather` — each gets a real OS thread | -| Many short-lived tasks | Overhead per task is `fork-thread` cost; avoid spawning thousands | +| Many short-lived tasks | Use `run-async/workers` to cap concurrent spawned tasks; overhead per task is still `fork-thread` cost | | Blocking FFI/IO | Works naturally — threads block independently | | High-throughput channels | Use `channel-get`/`channel-put` directly from dedicated threads; avoid `async-channel-get`/`async-channel-put` (each call spawns a helper thread) | | Sequential async code | `run-async` with `async-sleep` / `Async await` is fine; no event-loop overhead | -`run-async/workers n` currently does not limit parallelism. If you need to cap OS thread count (e.g., for a bounded thread pool), implement a semaphore-based wrapper around `async-task`. +`run-async/workers n` limits concurrent `(Async spawn ...)` work. Direct helper +threads created by lower-level APIs such as `async-channel-get` and +`async-channel-put` are separate implementation details and are not counted as +worker slots. --- @@ -433,7 +440,7 @@ Note that `with-handler` pushes a frame on top of the stack, so the inner `with- | `Async` | macro | Perform `await`, `spawn`, or `sleep` operations | | `Async::descriptor` | value | Effect descriptor for the `Async` effect | | `run-async` | procedure | Run a thunk in async context, block until done | -| `run-async/workers` | procedure | Like `run-async`; `n-workers` arg is a no-op | +| `run-async/workers` | procedure | Like `run-async`, with a semaphore cap for spawned async tasks | | `make-async-promise` | procedure | Create an unresolved promise | | `async-promise?` | procedure | Type predicate | | `async-promise-resolve!` | procedure | Resolve a promise (write-once, thread-safe) | --- a/docs/security-reference.md +++ b/docs/security-reference.md @@ -247,6 +247,7 @@ Combines all protection layers into a single `run-safe` call. Forks a child proc (run-safe (lambda () (+ 1 2)) (make-sandbox-config 'timeout 10 + 'max-memory-size (* 256 1024 1024) 'seccomp 'io-only 'landlock (make-readonly-ruleset "/usr/lib" "/lib"))) @@ -262,12 +263,14 @@ Combines all protection layers into a single `run-safe` call. Forks a child proc | `*sandbox-timeout*` | 30 seconds | Max execution time (`#f` = no limit) | | `*sandbox-seccomp*` | `'compute-only` | Seccomp filter preset | | `*sandbox-landlock*` | `#f` | No filesystem restriction by default | +| `*sandbox-max-memory-size*` | `#f` | Optional child `RLIMIT_AS` byte cap | ### Protection order (in child process) -1. Install Landlock filesystem rules (if configured and available) -2. Install seccomp-BPF filter (if configured and available) -3. Set capability context +1. Install memory limit (`max-memory-size`) if configured +2. Install Landlock filesystem rules (if configured and available) +3. Install seccomp-BPF filter (if configured and available) +4. Set capability context 4. Evaluate in restricted environment with timeout Raises `&sandbox-error` with phase (`'landlock`, `'seccomp`, `'capability`, `'timeout`, `'eval`, `'fork`) and detail. @@ -488,7 +491,7 @@ These are known gaps documented as current limitations, not implementation promi - **No message authentication for distributed actors.** `deserialize-message` uses `jerboa-read`, but messages are still plaintext with no HMAC. - **No TOCTOU-safe path checking.** `canonicalize-path` uses `realpath(3)` before access, not `O_NOFOLLOW` + `/proc/self/fd/N` after open. - **`define-syntax` remains in the sandbox allowlist.** Macro definition in sandboxed code is possible. Whether this is a risk depends on the use case. -- **No max-output-size for sandboxes.** A sandboxed expression can produce unbounded output via `display`/`write`. +- **Sandbox output is capped at the result channel.** `max-output-size` bounds the child result read from the pipe. It is not a full stdout/stderr capture system for arbitrary display traffic. - **No Argon2id.** Password hashing uses PBKDF2 (via OpenSSL or Rust ring) rather than Argon2id (requires separate library). - **FFI audit (Phase 5 of parser hardening) is not started.** Null return checks, type validation, and SQL injection lint rules are unimplemented. - **No red team evaluation.** No independent adversarial testing has been performed. --- a/docs/wasm-example.md +++ b/docs/wasm-example.md @@ -17,7 +17,7 @@ For architecture and API reference, see [wasm.md](wasm.md). - [Compiling to .wasm Files](#compiling-to-wasm-files) - [String I/O Conventions](#string-io-conventions) - [What Works Well in WASM](#what-works-well-in-wasm) -- [Current Limitations](#current-limitations) +- [Current Scope and Backend Limits](#current-scope-and-backend-limits) ## Prerequisites @@ -566,11 +566,15 @@ Cons: Requires import function registration (interpreter mode only, currently). --- -## Current Limitations +## Current Scope and Backend Limits -### No heap allocation -WASM linear memory is flat. There's no `malloc`/`free`. For tree-building -parsers, you'd need to implement a bump allocator in WASM: +### Allocation model + +WASM linear memory is flat, and Jerboa's production WASM path does not expose a +general `malloc`/`free` API. The runtime subset does include allocation patterns +for tagged Scheme values, cons cells, lists, and closures, and the wasmi tests +exercise those paths. For parser-style code, prefer an explicit bump allocator +or the runtime helper forms: ```scheme ;; Simple bump allocator pattern @@ -582,23 +586,43 @@ parsers, you'd need to implement a bump allocator in WASM: ptr)) ``` -### No closures or higher-order functions -Functions can't capture variables. All data passes through arguments, globals, -or memory. +For long-lived tree structures, define a reset point between calls or implement +a free list in linear memory. + +### Closures and higher-order code + +Closure lowering is supported through the runtime subset: lifted functions live +in a WASM table, closure records store the function index and captured +environment, and `call-closure-N` dispatches through `call_indirect`. This is +not a full arbitrary Scheme compiler yet; code still needs to fit the closure +conversion model used by the WASM runtime helpers. + +### Strings + +The direct WASM ABI has no string type. Strings are UTF-8 byte ranges in linear +memory, and the host reads/writes those byte ranges. Hosted instances can log or +display through WASI-style imports, but string construction APIs such as +`string-append` and `substring` are still host-side conventions unless you +provide a byte-level implementation in the module. + +### Exceptions + +The compiler/runtime has exception-proposal forms in the interpreter path, but +the Rust wasmi backend used by `(std wasm sandbox)` does not execute WASM +exception handling yet. For sandboxed production modules, use return codes +(`0` = success, negative = error type) or write error records into memory. -### No string operations -No `string-append`, `substring`, etc. Strings are raw bytes in memory. The -host must handle any string construction. +### Direct ABI values -### No exceptions -WASM has no try/catch. Use return codes (0 = success, negative = error type). +Function parameters and return values are numeric WASM values (`i32`, `i64`, +`f32`, `f64`). Compound values go through linear memory or tagged runtime +references. -### Numeric types only -Function parameters and return values must be i32, i64, f32, or f64. -Compound results go through memory. +### Garbage collection -### No garbage collection -Allocated memory stays allocated. Use a bump allocator that resets between -calls, or implement a free list. +The interpreter has post-MVP GC model support for structs, arrays, and `i31` +tests. The production wasmi sandbox does not provide a tracing Scheme GC for +module-owned allocations. Treat linear-memory allocation as region-based unless +you implement explicit reclamation. --- --- a/lib/jerboa/prelude/safe.ss +++ b/lib/jerboa/prelude/safe.ss @@ -145,7 +145,9 @@ make-sandbox-config sandbox-config? sandbox-config-timeout sandbox-config-seccomp sandbox-config-landlock sandbox-config-capabilities + sandbox-config-max-memory-size *sandbox-timeout* *sandbox-seccomp* *sandbox-landlock* + *sandbox-max-memory-size* &sandbox-error sandbox-error? sandbox-error-phase sandbox-error-detail) (import @@ -185,7 +187,9 @@ make-sandbox-config sandbox-config? sandbox-config-timeout sandbox-config-seccomp sandbox-config-landlock sandbox-config-capabilities + sandbox-config-max-memory-size *sandbox-timeout* *sandbox-seccomp* *sandbox-landlock* + *sandbox-max-memory-size* &sandbox-error sandbox-error? sandbox-error-phase sandbox-error-detail) (only (jerboa core) def)) --- a/lib/std/async.ss +++ b/lib/std/async.ss @@ -50,6 +50,7 @@ async-sleep) (import (chezscheme) (std effect) (std misc channel) + (only (std concur util) make-semaphore semaphore-acquire! semaphore-release!) (only (jerboa core) def defstruct try catch finally)) ;; ========== Async Effect Definition ========== @@ -97,6 +98,22 @@ ;; ;; Since we run each task in a thread, this correctly suspends the task. + (def *async-spawn-semaphore* (make-parameter #f)) + + (def (spawn-async-task! task-thunk) + (let ([spawn-sem (*async-spawn-semaphore*)]) + (when spawn-sem + (semaphore-acquire! spawn-sem)) + (fork-thread + (lambda () + (parameterize ([*async-spawn-semaphore* spawn-sem]) + (dynamic-wind + (lambda () (void)) + (lambda () (install-async-handlers! task-thunk)) + (lambda () + (when spawn-sem + (semaphore-release! spawn-sem))))))))) + (def (install-async-handlers! thunk) (with-handler ([Async @@ -106,20 +123,7 @@ (resume k val))) ;; spawn: fork a new thread for the task, resume immediately (spawn (k task-thunk) - (fork-thread - (lambda () - (with-handler - ([Async - (await (k2 p) (resume k2 (promise-wait! p))) - (spawn (k2 t) - (fork-thread (lambda () (install-async-handlers! t))) - (resume k2 (void))) - (sleep (k2 ms) - (sleep (make-time 'time-duration - (fx* (fxmod ms 1000) 1000000) - (fxquotient ms 1000))) - (resume k2 (void)))]) - (task-thunk)))) + (spawn-async-task! task-thunk) (resume k (void))) ;; sleep: sleep the current thread (sleep (k ms) @@ -134,24 +138,28 @@ (def (run-async thunk) (let ([result-promise (make-async-promise)]) ;; Run the thunk in a thread with Async handlers installed - (fork-thread - (lambda () - (try (install-async-handlers! - (lambda () - (let ([val (thunk)]) - (async-promise-resolve! result-promise val)))) - (catch (exn) (fprintf (current-error-port) - "run-async error: ~a~%" - (if (message-condition? exn) (condition-message exn) exn)) - (async-promise-resolve! result-promise - (raise-continuable exn)))))) + (let ([spawn-sem (*async-spawn-semaphore*)]) + (fork-thread + (lambda () + (parameterize ([*async-spawn-semaphore* spawn-sem]) + (try (install-async-handlers! + (lambda () + (let ([val (thunk)]) + (async-promise-resolve! result-promise val)))) + (catch (exn) (fprintf (current-error-port) + "run-async error: ~a~%" + (if (message-condition? exn) (condition-message exn) exn)) + (async-promise-resolve! result-promise + (raise-continuable exn)))))))) ;; Block main thread until done (promise-wait! result-promise))) - ;; (run-async/workers thunk n) — same as run-async (threads handle workers) + ;; (run-async/workers thunk n) — cap concurrent Async spawn tasks. (def (run-async/workers thunk n-workers) - ;; The n-workers hint is noted but not used (each spawn creates its own thread) - (run-async thunk)) + (unless (and (integer? n-workers) (> n-workers 0)) + (error 'run-async/workers "n-workers must be a positive integer" n-workers)) + (parameterize ([*async-spawn-semaphore* (make-semaphore n-workers)]) + (run-async thunk))) ;; ========== async-task ========== --- a/lib/std/security/sandbox.ss +++ b/lib/std/security/sandbox.ss @@ -52,6 +52,7 @@ *sandbox-landlock* *sandbox-seatbelt* *sandbox-capsicum* + *sandbox-max-memory-size* ;; Config accessors sandbox-config-timeout @@ -61,6 +62,7 @@ sandbox-config-capsicum sandbox-config-capabilities sandbox-config-max-output-size + sandbox-config-max-memory-size ;; Condition type &sandbox-error make-sandbox-error sandbox-error? @@ -74,6 +76,7 @@ (std security capsicum) (std security capability) (std security restrict) + (only (std os limits) limit-policy limit-policy-set! limit-policy-install!) (std safe-timeout) (std error conditions) (only (jerboa core) def defstruct try catch finally)) @@ -137,7 +140,19 @@ ;; ========== Sandbox config record ========== - (defstruct %sandbox-config (timeout seccomp landlock seatbelt capsicum capabilities max-output-size)) + ;; make-sandbox-config: key-value pairs → sandbox-config record + ;; (make-sandbox-config 'timeout 10 'seccomp 'io-only) + ;; (make-sandbox-config 'timeout 10 'seatbelt 'no-write) + ;; (make-sandbox-config 'timeout 10 'capsicum #t) + ;; Default max output size: 1 MB + (def *sandbox-max-output-size* (make-parameter (* 1 1024 1024))) + + ;; Default memory cap for the forked child. #f means no RLIMIT_AS cap. + ;; Keep this opt-in because Chez may already have a large mapped heap before + ;; run-safe forks, and lowering RLIMIT_AS below that point is platform-sensitive. + (def *sandbox-max-memory-size* (make-parameter #f)) + + (defstruct %sandbox-config (timeout seccomp landlock seatbelt capsicum capabilities max-output-size max-memory-size)) (def %make-sandbox-config make-%sandbox-config) (def sandbox-config? %sandbox-config?) @@ -149,13 +164,7 @@ (def sandbox-config-capsicum %sandbox-config-capsicum) (def sandbox-config-capabilities %sandbox-config-capabilities) (def sandbox-config-max-output-size %sandbox-config-max-output-size) - - ;; make-sandbox-config: key-value pairs → sandbox-config record - ;; (make-sandbox-config 'timeout 10 'seccomp 'io-only) - ;; (make-sandbox-config 'timeout 10 'seatbelt 'no-write) - ;; (make-sandbox-config 'timeout 10 'capsicum #t) - ;; Default max output size: 1 MB - (def *sandbox-max-output-size* (make-parameter (* 1 1024 1024))) + (def sandbox-config-max-memory-size %sandbox-config-max-memory-size) (def (make-sandbox-config . args) (let loop ([rest args] @@ -165,9 +174,10 @@ [seatbelt (*sandbox-seatbelt*)] [capsicum (*sandbox-capsicum*)] [caps '()] - [max-output (*sandbox-max-output-size*)]) + [max-output (*sandbox-max-output-size*)] + [max-memory (*sandbox-max-memory-size*)]) (if (null? rest) - (%make-sandbox-config timeout seccomp landlock seatbelt capsicum caps max-output) + (%make-sandbox-config timeout seccomp landlock seatbelt capsicum caps max-output max-memory) (begin (when (null? (cdr rest)) (error 'make-sandbox-config "key missing value" (car rest))) @@ -176,22 +186,24 @@ [remaining (cddr rest)]) (cond [(eq? key 'timeout) - (loop remaining val seccomp landlock seatbelt capsicum caps max-output)] + (loop remaining val seccomp landlock seatbelt capsicum caps max-output max-memory)] [(eq? key 'seccomp) - (loop remaining timeout val landlock seatbelt capsicum caps max-output)] + (loop remaining timeout val landlock seatbelt capsicum caps max-output max-memory)] [(eq? key 'landlock) - (loop remaining timeout seccomp val seatbelt capsicum caps max-output)] + (loop remaining timeout seccomp val seatbelt capsicum caps max-output max-memory)] [(eq? key 'seatbelt) - (loop remaining timeout seccomp landlock val capsicum caps max-output)] + (loop remaining timeout seccomp landlock val capsicum caps max-output max-memory)] [(eq? key 'capsicum) - (loop remaining timeout seccomp landlock seatbelt val caps max-output)] + (loop remaining timeout seccomp landlock seatbelt val caps max-output max-memory)] [(eq? key 'capabilities) - (loop remaining timeout seccomp landlock seatbelt capsicum val max-output)] + (loop remaining timeout seccomp landlock seatbelt capsicum val max-output max-memory)] [(eq? key 'max-output-size) - (loop remaining timeout seccomp landlock seatbelt capsicum caps val)] + (loop remaining timeout seccomp landlock seatbelt capsicum caps val max-memory)] + [(eq? key 'max-memory-size) + (loop remaining timeout seccomp landlock seatbelt capsicum caps max-output val)] [else (error 'make-sandbox-config - "unknown key; expected timeout, seccomp, landlock, seatbelt, capsicum, capabilities, or max-output-size" + "unknown key; expected timeout, seccomp, landlock, seatbelt, capsicum, capabilities, max-output-size, or max-memory-size" key)])))))) ;; ========== Seccomp filter resolution (Linux) ========== @@ -270,7 +282,8 @@ seatbelt-profile capsicum-mode (%sandbox-config-capabilities cfg) - (%sandbox-config-max-output-size cfg))))) + (%sandbox-config-max-output-size cfg) + (%sandbox-config-max-memory-size cfg))))) ;; FFI pipe(2) — creates a pair of connected file descriptors (def c-pipe @@ -371,11 +384,25 @@ ;; Capsicum not available — warn but don't fail (void)))) + (def (install-memory-limit! max-memory-size) + (when max-memory-size + (let ([policy (limit-policy)]) + (limit-policy-set! policy 'mem max-memory-size) + (let ([results (limit-policy-install! policy)]) + (let ([mem-result (cdr (assq 'mem results))]) + (unless (or (eq? mem-result 'installed) + (eq? mem-result 'degraded)) + (raise (make-sandbox-error + "sandbox" + 'limit + (format "failed to install memory limit: ~a" + mem-result))))))))) + ;; ========== Core sandbox implementation ========== (def (run-safe-internal thunk timeout seccomp-filter landlock-rules seatbelt-profile capsicum-mode capabilities - max-output-size) + max-output-size max-memory-size) ;; Communication via pipe: child writes result, parent reads it. ;; HARDENED: Uses pipe(2) instead of temp files to prevent symlink attacks, ;; TOCTOU races, and read-eval injection. @@ -387,6 +414,8 @@ ;; Close read end — child only writes (c-close read-fd) (try (begin ;; Install platform-specific protections + (install-memory-limit! max-memory-size) + (case *current-platform* [(linux) (install-linux-protections! landlock-rules seccomp-filter)] @@ -518,6 +547,7 @@ seatbelt-profile capsicum-mode (%sandbox-config-capabilities cfg) - (%sandbox-config-max-output-size cfg))))) + (%sandbox-config-max-output-size cfg) + (%sandbox-config-max-memory-size cfg))))) ) ;; end library --- a/tests/test-async.ss +++ b/tests/test-async.ss @@ -129,6 +129,30 @@ 2) 42) +;;; Test 11: run-async/workers caps concurrent spawned tasks +(test "run-async/workers caps spawns" + (run-async/workers + (lambda () + (let ([lock (make-mutex)] + [current 0] + [peak 0]) + (define (task) + (with-mutex lock + (set! current (+ current 1)) + (when (> current peak) + (set! peak current))) + (async-sleep 40) + (with-mutex lock + (set! current (- current 1)))) + (Async spawn task) + (Async spawn task) + (Async spawn task) + (Async spawn task) + (async-sleep 120) + peak)) + 2) + 2) + (printf "~%~a tests: ~a passed, ~a failed~%" (+ pass fail) pass fail) (when (> fail 0) (exit 1)) --- a/tests/test-sandbox.ss +++ b/tests/test-sandbox.ss @@ -56,6 +56,10 @@ (*sandbox-landlock*) #f) +(test "*sandbox-max-memory-size* defaults to #f" + (*sandbox-max-memory-size*) + #f) + ;; ========== Condition type ========== (printf "~%-- Condition type --~%") @@ -104,6 +108,16 @@ (sandbox-config-timeout (make-sandbox-config))) 99) +(test "make-sandbox-config with max-memory-size" + (sandbox-config-max-memory-size + (make-sandbox-config 'max-memory-size (* 128 1024 1024))) + (* 128 1024 1024)) + +(test "make-sandbox-config uses memory parameter default" + (parameterize ([*sandbox-max-memory-size* (* 256 1024 1024)]) + (sandbox-config-max-memory-size (make-sandbox-config))) + (* 256 1024 1024)) + (test "make-sandbox-config rejects unknown key" (guard (exn [#t #t]) (make-sandbox-config 'bogus 42) --- a/vendor/ChezScheme/configure +++ b/vendor/ChezScheme/configure @@ -896,6 +896,17 @@ if [ "$addflags" = "yes" ] ; then fi fi +try_harden_cflags() { + flags="$1" + tmpc="${TMPDIR:-/tmp}/chez-harden-$$.c" + tmpo="${TMPDIR:-/tmp}/chez-harden-$$.o" + printf '%s\n' 'int main(void) { return 0; }' > "$tmpc" + if $CC $CPPFLAGS $CFLAGS $flags -c "$tmpc" -o "$tmpo" >/dev/null 2>&1 ; then + CFLAGS="${CFLAGS} ${flags}" + fi + rm -f "$tmpc" "$tmpo" +} + # Add security hardening flags if [ "$enableharden" = "yes" ] ; then CFLAGS="${CFLAGS} -fstack-protector-strong -fstack-clash-protection" @@ -913,6 +924,9 @@ if [ "$enableharden" = "yes" ] ; then CFLAGS="${CFLAGS} -mbranch-protection=standard" ;; esac + try_harden_cflags "-fzero-call-used-regs=used-gpr" + try_harden_cflags "-ftrivial-auto-var-init=zero" + try_harden_cflags "-Wformat -Wformat-security -Werror=format-security" LDFLAGS="${LDFLAGS} -Wl,-z,relro,-z,now" if [ "$staticbuild" != "yes" ] ; then # -fPIC generates position-independent code needed for both PIE @@ -921,6 +935,10 @@ if [ "$enableharden" = "yes" ] ; then # (which is inherited by test shared-object compilation). CFLAGS="${CFLAGS} -fPIC" hardenLinkFlags="-pie" + else + # Static PIE final links need position-independent objects, but the + # executable-only -pie flag still belongs to the final Jerboa link. + try_harden_cflags "-fPIE"