AI_Slop/calog
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Some security decisions revised. Bugs fixed.

Browse source
This commit is contained in:
Scott Duensing 2026-10-15 17:45:12 -05:00
parent 2ba93770a8
commit 080bc95d8e
44 changed files with 1388 additions and 309 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

60
API.md
View file

@ -35,8 +35,10 @@ etc. -- see the README and `src/calog.h`.)
lent to a function in another script via `calogCall`, which uses it and returns while the
caller is blocked (a safe synchronous hand-off). What is *not* safe is using one handle from
two contexts at the same instant, or closing it while another context is mid-operation: at
most one context may touch a given handle at any moment, and exactly one closes it. (Tasks are
the exception -- a task is owner-scoped: only its spawner may `taskEval`/`taskClose` it.)
most one context may touch a given handle at any moment, and exactly one closes it. (Two
exceptions: a TCP listener may be shared by any number of contexts calling `tcpAccept` on it at
once, each connection going to one of them, and is closed once they have all stopped; and a task
is owner-scoped -- only its spawner may `taskEval`/`taskClose` it.)
- **Callbacks.** Natives that take a `fn` argument (`psSubscribe`, `timerAfter`, `timerEvery`,
`calogExport`) accept a first-class function value in every engine. A function value handed
*to* a script (say, returned by `calogCall`) is invoked directly -- except in my-basic, which
@ -113,32 +115,39 @@ egress (JavaScript, Berry, s7, mruby); Janet loses `symbol`/`keyword` subtype (i
---
## What the engines' own standard libraries do NOT give you
## The engines' own standard libraries
calog's contract is that a script reaches the host **only** through the natives documented below.
That is the one place a policy can see it: the per-context allow-list, the memory cap and the
wall-clock budget all live at the native-dispatch choke point. An engine's own filesystem, process,
socket, environment or dynamic-loading bindings walk straight around all three, so calog removes them
at interpreter creation. This is not limited to sandboxed contexts -- an engine built-in that ends
the host process or dlopens a library is wrong in an ordinary run too.
A context opened with `calogContextOpen` (or `calogContextLoad`, or `bin/calog`) runs the host's own
code, so it has its engine's standard library: Lua's `io`, `os`, `package`, and `debug`; Tcl's
`open`, `file`, `exec`, `source`, and `::env`; Janet's `spit`, `slurp`, and `os/*`; Berry's `open`,
`os`, `compile(..., "file")`, and module files; my-basic's `IMPORT "path"` and `INPUT` from stdin;
s7's file ports, `load`, `require`, `getenv`, and `system`. One change everywhere: an engine's own
exit -- `os.exit`, `exit`, `(os/exit)`, `(exit)` -- ends the run through the host's `calogExit`
(`CALOG_EXIT_NATIVE`), as `calogExit` itself does, instead of calling libc `exit()` underneath every
other script and the host's teardown. A host that registered no `calogExit` has no run to end: the
call fails saying so. (Lua's `debug.sethook` replaces the hook calog uses to stop a script that calls
no natives, so a script that sets its own hook gives that up.)
| engine | removed | use instead |
A **sandboxed** context (`calogContextOpenLimited`, with any policy -- an allow-list alone included --
and every task it spawns) reaches the host **only** through the natives documented below. That is the
one place a policy can see it: the per-context allow-list, the memory cap and the wall-clock budget all
live at the native-dispatch choke point. An engine's own filesystem, process, socket, environment or
dynamic-loading bindings walk straight around all three, so a sandboxed interpreter is sealed when it is
created:
| engine | sealed in a sandbox | use instead |
|---|---|---|
| Lua | `io`, `os`, `package`/`require`, `debug`, `dofile`, `loadfile`, `string.dump`; `load` is text-only | `fs*`, `procRun`, `calogExit`, `time*` |
| Tcl | `exec`, `open`, `socket`, `load`, `exit`, `source`, `glob`, `file` (and `::tcl::file::*`), `cd`, `pwd`, `zipfs`, `after`, `vwait`, the channel commands, `::env` | `fs*`, `procRun`, `net*`, `calogExit`, `timer*` |
| s7 | `system`, `exit`, `emergency-exit`, `abort`, `load`, the file ports, `getenv`, `file-exists?`, `directory->list` | `fs*`, `procRun`, `calogExit` |
| Berry | `os` module (`system`, `exit`, `chdir`, ...), `open`, `compile(..., "file")`, `import` of a `.so`/`.bec`, `introspect` | `fs*`, `procRun`, `calogExit` |
| Janet | `file/*`, `os/execute`, `os/exit`, `os/cwd`, `os/getenv`, `net/*`, `ffi/*`, dynamic modules | `fs*`, `procRun`, `net*`, `calogExit` |
| my-basic | `IMPORT "path"` (module imports `IMPORT "@name"` still work) | `taskLoad`, `calogExport` |
| JavaScript, Squirrel, mruby, Wren | nothing to remove -- these ship no host bindings | -- |
| Lua | `io`, `os`, `package`/`require`, `debug`, `dofile`, `loadfile`, `string.dump`; `load` is text-only | `fs*`, `procRun`, `time*` |
| Tcl | `exec`, `open`, `socket`, `load`, `exit`, `source`, `glob`, `file` (and `::tcl::file::*`), `cd`, `pwd`, `zipfs`, `after`, `vwait`, the channel commands, `::env` | `fs*`, `procRun`, `net*`, `timer*` |
| s7 | `system`, `exit`, `emergency-exit`, `load` (and `require`, autoload, shared objects), the file ports, `getenv`, `getenvs`, `file-exists?`, `directory?`, `delete-file`, `directory->list`, `file-mtime`, `unlink`, `access`, `uname`; `abort` everywhere | `fs*`, `procRun` |
| Berry | `os` module (`system`, `exit`, `chdir`, ...), `open`, `compile(..., "file")`, `import` of any file (`.be`, `.bec`, `.so`), `introspect` | `fs*`, `procRun` |
| Janet | `file/*`, `os/execute`, `os/exit`, `os/cwd`, `os/getenv`, `net/*`, `ffi/*`, dynamic modules | `fs*`, `procRun`, `net*` |
| my-basic | `IMPORT "path"` (module imports `IMPORT "@name"` still work); `INPUT` yields an empty line | `taskLoad`, `calogExport` |
| JavaScript, Squirrel, mruby, Wren | nothing to seal -- these ship no host bindings | -- |
Pure computation is untouched everywhere: strings, collections, math, regex, closures, coroutines,
classes and each language's own control flow all work normally. What is gone is the ability to touch
the machine without going through a native the host registered and can revoke.
Three capabilities have no native equivalent today and are simply unavailable: reading environment
variables, renaming a file, and creating a temp file by name. A host that wants a script to have any
of them registers a native for it -- which is the point, because then it is policy-controlled.
classes and each language's own control flow all work normally. What a sandbox takes away is the
ability to touch the machine without going through a native the host registered and can revoke.
---
@ -147,7 +156,8 @@ of them registers a native for it -- which is the point, because then it is poli
| Function | Description |
|---|---|
| `calogPrint(...values: any)` | Write each argument to stdout, space-separated, with a trailing newline. |
| `calogArgs() -> list[string]` | The arguments given after `--` on the command line (`calog build.lua -- release v2`), the same list for every script in the run, empty when none were given. This is the sanctioned way to parameterize a run: the engines' own `getenv`/`argv` are removed, so without it every project would invent its own convention. |
| `calogArgs() -> list[string]` | The arguments given after `--` on the command line (`calog build.lua -- release v2`), the same list for every script in the run, empty when none were given. This is the sanctioned way to parameterize a run: no engine is handed an `argv` of its own, so without it every project would invent its own convention. |
| `calogScript() -> string` | The path of the calling script's own file, as the runner found it from the command line (with the extension it supplied for an extensionless name), so a script can find the files kept beside it. `""` in a context no file started (a task). |
| `calogExit([code: int])` | Tear down the runtime and exit the process with `code` (default `0`). **Does not return** -- it unwinds the calling script at the call site, so nothing after it runs, and stops every other live script at its next native call, or at its interpreter's next hook if it calls none. The first caller's `code` is the one reported; a script that catches the unwind still cannot call another native. |
## archive
@ -383,7 +393,7 @@ TCP and UDP:
| `tcpConnect(host: string, port: int) -> handle` | Connect to a TCP server. |
| `tcpStartTls(handle: handle, host: string [, opts: map]) -> true` | Turn an established connection into a TLS client session. `host` is both the SNI name and the name the certificate must carry. `opts`: `{ insecure (bool) }`. Verification is **on by default and fails closed** -- without trust anchors (see the `http` section for where those come from) the call errors rather than proceeding unverified. One native covers both shapes: call it immediately after `tcpConnect` for implicit TLS (SMTPS, IMAPS), or after the protocol's own upgrade command for STARTTLS. Upgrading twice is refused. |
| `tcpListen(port: int [, opts: map]) -> handle` | Listen on a TCP port. `opts`: `{ host (bind address), tls (bool), cert (PEM path), key (PEM path) }` -- with `tls`, every accepted connection is a TLS server session (used by the HTTPS/WSS server script). Without `host` the listener binds every interface; naming one (`"127.0.0.1"`) binds only that, which is what a service behind a reverse proxy wants -- there the proxy is the security boundary, and a wildcard bind is a way around it. |
| `tcpAccept(handle: handle [, timeoutMs: int]) -> handle \| nil` | Block for a client (completing the TLS handshake for a TLS listener); returns a connection handle. With `timeoutMs`, returns nil if none arrives in time, so an accept loop can re-check its own stop condition. |
| `tcpAccept(handle: handle [, timeoutMs: int]) -> handle \| nil` | Block for a client (completing the TLS handshake for a TLS listener); returns a connection handle. With `timeoutMs`, returns nil if none arrives in time -- or if another context accepting on the same listener took it -- so an accept loop can re-check its own stop condition. |
| `tcpSend(handle: handle, data: string) -> int` | Send all of `data`; returns bytes sent. |
| `tcpRecv(handle: handle, maxBytes: int) -> string \| nil` | Read up to `maxBytes`; nil at end of stream. |
| `tcpClose(handle: handle)` | Close a socket. |

32
Makefile
View file

@ -25,6 +25,10 @@ COREFLAGS = -std=c11 $(STRICT) $(DEP) -g -O1 $(SAN)
ADPFLAGS = -std=c11 $(WARN) $(DEP) -g -O1 $(SAN)
LDFLAGS = $(SAN)
# The vendored-library rules below come before `all`, so without this a bare `make` built only the
# first of them (the mruby archive) instead of everything the README promises.
.DEFAULT_GOAL := all
# Our headers: src/ plus the per-language subdirs. VPATH lets the object rules find
# a source by name without spelling out its directory.
INC = -Isrc -Isrc/lua -Isrc/mybasic -Isrc/squirrel -Isrc/js -Isrc/berry -Isrc/s7 -Isrc/wren -Isrc/mruby -Isrc/tcl -Isrc/janet -Ilibs
@ -129,11 +133,11 @@ BERRYOBJ = $(foreach f,$(BERRYSRC),obj/$(notdir $(f:.c=)).o)
# feature config; s7 int is 64-bit and strings are binary-safe. ---
S7DIR = vendor/s7
S7INC = -I$(S7DIR)
# WITH_SYSTEM_EXTRAS=0 removes (system ...), file-exists?, delete-file, directory->list and
# getdirandfile; WITH_C_LOADER=0 removes (load "x.so") dlopen'ing native code into this process;
# WITH_R7RS=0 is what actually removes getenv (s7 gates it on r7rs OR system-extras). None of
# these can be closed from the adapter: s7's unlet/#_ recover any rebinding of a built-in.
S7FLAGS = -std=c99 -w -g -O1 -D_GNU_SOURCE -DWITH_SYSTEM_EXTRAS=0 -DWITH_C_LOADER=0 -DWITH_R7RS=0
# s7's own system extras, C loader, and r7rs (getenv) are built in: a context with no sandbox has
# them, and the vendored s7.c refuses each in a sandboxed one (calogS7Sealed), since s7's unlet/#_
# recover any rebinding the adapter could make. A change to these flags or to s7.c's patches needs
# obj/s7.o rebuilt: the vendored rule tracks no headers.
S7FLAGS = -std=c99 -w -g -O1 -D_GNU_SOURCE
S7OBJ = obj/s7.o
S7LIBS = $(DLLIB) -lm
@ -344,19 +348,19 @@ $(PCRE2LIB):
BINS = bin/testBroker bin/testLua bin/testMyBasic bin/testPolyglot bin/testActor bin/testHooks \
bin/testEngineLua bin/testEngineMyBasic bin/testSquirrel bin/testEngineSquirrel bin/testJs bin/testEngineJs \
bin/testEngineBerry bin/testEngineS7 bin/testEngineWren bin/testEngineMruby bin/testEngineTcl bin/testEngineJanet bin/testLoad bin/testDb bin/testNet bin/testTask bin/testExport bin/testJson bin/testXml bin/testTime bin/testFs bin/testCrypto bin/testKv bin/testTimer bin/testPubsub bin/testHttp bin/testHttps bin/testArchive bin/testUtil bin/testSandbox bin/testExit bin/testTeardown bin/testTrace bin/testHttpdLua bin/embed bin/calog
bin/testEngineBerry bin/testEngineS7 bin/testEngineWren bin/testEngineMruby bin/testEngineTcl bin/testEngineJanet bin/testLoad bin/testDb bin/testNet bin/testTask bin/testExport bin/testJson bin/testXml bin/testTime bin/testFs bin/testCrypto bin/testKv bin/testTimer bin/testPubsub bin/testHttp bin/testHttps bin/testArchive bin/testUtil bin/testSandbox bin/testExit bin/testTeardown bin/testTrace bin/testHttpdLua bin/embed bin/calog bin/testRunner bin/testStdlib
all: $(BINS)
# ---- object rules, grouped by flag set (sources resolved via VPATH) ----
# strict C, no threads
STRICTOBJ = obj/broker.o obj/value.o obj/luaEngine.o obj/squirrelEngine.o obj/jsEngine.o obj/berryEngine.o obj/s7Engine.o obj/wrenEngine.o obj/mrubyEngine.o obj/tclEngine.o obj/janetEngine.o obj/testBroker.o
STRICTOBJ = obj/broker.o obj/value.o obj/luaEngine.o obj/squirrelEngine.o obj/jsEngine.o obj/berryEngine.o obj/s7Engine.o obj/wrenEngine.o obj/mrubyEngine.o obj/tclEngine.o obj/janetEngine.o obj/testBroker.o obj/testRunner.o
$(STRICTOBJ): obj/%.o: %.c | obj
$(CC) $(COREFLAGS) $(INC) -c -o $@ $<
# strict C, threaded
THREADOBJ = obj/context.o obj/mybasicEngine.o obj/testActor.o obj/testEngineLua.o obj/testEngineSquirrel.o obj/testEngineJs.o obj/testEngineMyBasic.o obj/testEngineBerry.o obj/testEngineS7.o obj/testEngineWren.o obj/testEngineMruby.o obj/testEngineTcl.o obj/testEngineJanet.o obj/calogHandle.o obj/testDb.o obj/testNet.o obj/testTask.o obj/calogExport.o obj/testExport.o obj/calogJson.o obj/testJson.o obj/calogFs.o obj/testFs.o obj/calogTime.o obj/testTime.o obj/calogKv.o obj/testKv.o obj/testCrypto.o obj/calogTimer.o obj/testTimer.o obj/calogPubsub.o obj/testPubsub.o obj/testHttp.o obj/testSsh.o obj/calogCsv.o obj/calogProc.o obj/testSandbox.o obj/testExit.o obj/testTeardown.o obj/testTrace.o obj/testHooks.o
THREADOBJ = obj/context.o obj/mybasicEngine.o obj/testActor.o obj/testEngineLua.o obj/testEngineSquirrel.o obj/testEngineJs.o obj/testEngineMyBasic.o obj/testEngineBerry.o obj/testEngineS7.o obj/testEngineWren.o obj/testEngineMruby.o obj/testEngineTcl.o obj/testEngineJanet.o obj/calogHandle.o obj/testDb.o obj/testNet.o obj/testTask.o obj/calogExport.o obj/testExport.o obj/calogJson.o obj/testJson.o obj/calogFs.o obj/testFs.o obj/calogTime.o obj/testTime.o obj/calogKv.o obj/testKv.o obj/testCrypto.o obj/calogTimer.o obj/testTimer.o obj/calogPubsub.o obj/testPubsub.o obj/testHttp.o obj/testSsh.o obj/calogCsv.o obj/calogProc.o obj/testSandbox.o obj/testExit.o obj/testTeardown.o obj/testTrace.o obj/testHooks.o obj/testStdlib.o
$(THREADOBJ): obj/%.o: %.c | obj
$(CC) $(COREFLAGS) $(INC) -pthread -c -o $@ $<
@ -759,6 +763,14 @@ bin/testExit: obj/testExit.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/li
bin/testTrace: obj/testTrace.o obj/calogExport.o lib/libcalog.a lib/liblua.a lib/libquickjs.a | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS)
# The engines' own standard libraries: present with no sandbox, refused in one (all six that have any).
bin/testStdlib: obj/testStdlib.o lib/libcalog.a lib/liblua.a lib/libquickjs.a lib/libsquirrel.a lib/libmybasic.a lib/libberry.a lib/libs7.a lib/libwren.a lib/libjanet.a $(MRUBYLIB) $(TCLLIB) | bin
$(CC) $(LDFLAGS) -pthread -o $@ $^ $(LUALIBS) $(CXXLIB) -lm $(MRUBYLIBS) $(TCLLIBS)
# The runner end to end (calogScript, calogArgs): it runs bin/calog, so that is built first.
bin/testRunner: obj/testRunner.o | bin bin/calog
$(CC) $(LDFLAGS) -o $@ $^
# The httpd-as-a-script (examples/httpd.lua): protocol in Lua over the tcp* transport (calogNet, which
# needs libenet) + the crypto natives (calogCrypto, which needs OpenSSL).
bin/testHttpdLua: obj/testHttpdLua.o obj/calogNet.o obj/calogTrust.o obj/calogCrypto.o obj/calogFs.o obj/calogHandle.o lib/libcalog.a lib/liblua.a lib/libenet.a $(SSLARCH) | bin
@ -787,7 +799,7 @@ obj bin lib:
test: all cross-lint static
./bin/testBroker && ./bin/testLua && ./bin/testMyBasic && ./bin/testPolyglot && \
./bin/testActor && ./bin/testHooks && ./bin/testEngineLua && ./bin/testEngineMyBasic && ./bin/testSquirrel && ./bin/testEngineSquirrel && \
./bin/testJs && ./bin/testEngineJs && ./bin/testEngineBerry && ./bin/testEngineS7 && ./bin/testEngineWren && ./bin/testEngineMruby && ./bin/testEngineTcl && ./bin/testEngineJanet && ./bin/testLoad && ./bin/testDb && ./bin/testNet && ./bin/testTask && ./bin/testExport && ./bin/testJson && ./bin/testXml && ./bin/testTime && ./bin/testFs && ./bin/testCrypto && ./bin/testKv && ./bin/testTimer && ./bin/testPubsub && ./bin/testHttp && ./bin/testHttps && ./bin/testArchive && ./bin/testUtil && ./bin/testSandbox && ./bin/testExit && ./bin/testTeardown && ./bin/testTrace && ./bin/testHttpdLua
./bin/testJs && ./bin/testEngineJs && ./bin/testEngineBerry && ./bin/testEngineS7 && ./bin/testEngineWren && ./bin/testEngineMruby && ./bin/testEngineTcl && ./bin/testEngineJanet && ./bin/testLoad && ./bin/testDb && ./bin/testNet && ./bin/testTask && ./bin/testExport && ./bin/testJson && ./bin/testXml && ./bin/testTime && ./bin/testFs && ./bin/testCrypto && ./bin/testKv && ./bin/testTimer && ./bin/testPubsub && ./bin/testHttp && ./bin/testHttps && ./bin/testArchive && ./bin/testUtil && ./bin/testSandbox && ./bin/testExit && ./bin/testTeardown && ./bin/testTrace && ./bin/testHttpdLua && ./bin/testRunner && ./bin/testStdlib
# ThreadSanitizer build of the actor core and the Lua engine path (cannot combine
# with ASan). Recompiled from source under TSan; the vendored Lua objects are
@ -916,7 +928,7 @@ tsanlibs: lib/liblua.a | bin
# calls across the boundary, so races in the net handle table / actor layer / TLS setup surface here.
tsanhttpd: lib/liblua.a lib/libenet.a $(SSLARCH) | bin
$(CC) $(TSANFLAGS) $(INC) $(LUAINC) $(ENETINC) $(OSSLINC) -o bin/testHttpdLuaTsan \
tests/testHttpdLua.c libs/calogNet.c libs/calogCrypto.c libs/calogHandle.c \
tests/testHttpdLua.c libs/calogNet.c libs/calogCrypto.c libs/calogFs.c libs/calogHandle.c libs/calogTrust.c \
src/lua/luaEngine.c src/lua/luaAdapter.c $(TSANCORE) \
lib/liblua.a lib/libenet.a $(SSLARCH) $(LUALIBS)
setarch -R ./bin/testHttpdLuaTsan

7
README.md
View file

@ -57,8 +57,11 @@ Swap `&calogJsEngine` for `&calogLuaEngine`, `&calogSquirrelEngine`,
`CalogLimitsT` policy: a **native allow-list** (which registered natives the script may
call -- enforced for every engine at the one dispatch choke point), a **wall-clock budget**
(a runaway loop is retired -- Lua and JavaScript), and a **memory cap** (Lua and JavaScript,
via their per-VM allocators). Each context is already its own thread, so a limited plugin
can misbehave without taking down the host.
via their per-VM allocators). The sandboxed interpreter is sealed as well: its engine's own
file, process, and environment access is gone, so the script reaches the host only through
natives the policy can see. An unsandboxed context keeps its engine's standard library. Each
context is already its own thread, so a limited plugin can misbehave without taking down the
host.
- **Many runtimes.** Independent `CalogT` runtimes coexist in one process; one host
thread can drive several.
- **Load by filename.** `calogContextLoad(calog, "config")` finds `config.lua` /

120
design.md
View file

@ -2203,3 +2203,123 @@ symptom is a leak, a truncated environment, or an argument that silently does no
the first failure and returns it. `calogArchive` had already grown a private version of exactly
that table -- a good sign the shared one was overdue, and that twelve more copies were the wrong
direction.
---
## 33. A listener several contexts can share, a script that knows its own file, and a bare `make`
### The context that lost the race for a connection
`examples/httpd.lua` and API.md's httpd section both recommended sharing one listener across several
contexts for parallelism, each calling `tcpAccept` on it. It did not work. `tcpAccept(l, ms)` polled
the listener and then called `accept()` on a BLOCKING socket, and `poll` wakes every waiter for one
connection: one context takes it, and the rest sleep in `accept()` until some later client arrives.
The timeout that exists precisely so an accept loop can see its own stop condition was spent before
the call that blocked. A context asleep there cannot see the abort latch either, so `Ctrl-C` and
`calogExit` left the run waiting forever on `calogDestroy`'s join. Reproduced with two tasks accepting
on one listener and a single connection: the run never ended after `SIGTERM`.
The listener is now non-blocking (`tcpListen` sets it), and `tcpAccept` treats "would block" after a
successful poll as what it is -- another context got there first: with a timeout it returns nil, as
for no connection, and without one it goes back to waiting. The accepted socket is set blocking
explicitly, because BSD and Windows hand the listener's mode to it and the connection's own calls
are written to block. API.md's handle rule ("at most one context may touch a given handle") now
names the listener as the exception it was always documented to be elsewhere; it is closed once
every context accepting on it has stopped.
`tests/testNet.c` runs the shape that failed: two contexts on one listener, both settled in their
poll, one client. Built against the old `calogNet.c` it fails exactly there -- the losing context
never comes back to see its stop flag -- and it passes against the new one.
### `calogScript()`
The parameter channel of sec 31 gave a run its arguments but not its own location, so a script could
not find the files kept beside it unless the user passed the folder in by hand. Every multi-file
project ends up inventing that convention. `calogScript()` is the path of the calling script's own
file, as the runner found it (`bin/calog build` gives `build.lua`), and `""` in a task, which no file
started. The runner records each script's entry before the script starts, with the context id
stored last, so the first call already finds it; registered inline, like `calogArgs`.
The runner had no test of its own -- not of `calogArgs` either -- so `tests/testRunner.c` runs
`bin/calog` the way a user does, with a Lua script found by an extensionless name, a JavaScript
script, a task, and arguments after `--`.
### A bare `make` built one archive
The README says `make` builds everything. Since the vendored-library rules grew ahead of `all`, a
bare `make` built only the first of them -- the mruby archive -- and reported nothing to do, so an
edit to the runner or a library was silently not rebuilt. `.DEFAULT_GOAL := all` makes the promise
true again.
---
## 34. The engines' own standard libraries, back where the host's own code runs
Sec 30 sealed all six engines that ship an operating-system interface, in every context, on the
argument that "an engine built-in that ends the host process or dlopens a library is wrong in an
ordinary run too." In practice the seal cost more than it protected. An unsandboxed context runs the
host's own code -- a build script, a server, a tool -- and that code wants `io.open`, `os.getenv`,
`require`, Tcl's `file`, Janet's `slurp`. Every project was routing around the seal (paths passed in as
arguments, configuration read through `fsRead` and parsed by hand), which is the convention-inventing
sec 31 set out to stop. The sandbox is where the seal earns its keep: a script the host does not trust,
whose every reach for the machine must pass the allow-list, the memory cap, and the budget.
So the seal now follows the sandbox. `calogContextSandboxed(context)` is true for a context with any
policy at all -- an allow-list alone included, and every task it spawns -- and each adapter is told it
at create. Sandboxed, the interpreter is sealed exactly as sec 30 built it; with no sandbox, it has
its engine's standard library.
The flag had to be new. The adapters already took `calogContextLimitState`, but that is NULL unless a
memory cap or a deadline is set: an allow-list-only sandbox reports no limit state. The first cut keyed
the seal on it, and the new test (below) caught every engine leaving an allow-list sandbox unsealed.
### What ends a run
The one thing not restored as it was is each engine's exit. Lua's `os.exit`, Tcl's `exit`, Janet's
`os/exit`, Berry's `os.exit`, and s7's `exit` and `emergency-exit` call libc `exit()` from a context
thread, underneath every other script and the host's teardown -- the problem sec 25 solved for
`calogExit`. They now go through `calogEngineExit`, which normalizes the code (none, nil, or true is
success; false is failure; a number is the code) and calls the host's `CALOG_EXIT_NATIVE` -- the name
`bin/calog` registers `calogExit` under. The script unwinds, the first code wins, and the host tears
down in order. A host that registered no such native has no run to end, and the call says so. s7's
`abort` stays refused in every context: libc `abort()` has no orderly form.
### Per engine
- **Lua, Tcl, Janet** -- the seal is adapter code, so it simply runs only when sandboxed. Tcl keeps
calog's own `puts` for stdout (it writes through C, in order with `calogPrint`) and hands any other
channel -- a file, a socket, stderr -- to Tcl's own `puts`, kept as `::tcl::calogChannelPuts`.
Janet's `os/exit` became a `JanetNativeT` with a dispatch function, the same abstract an exposed
native is, rather than a second copy of the call path; Tcl's trampoline and `exit` likewise share
`tclCallWith`.
- **Berry** -- the five config macros are back to upstream, and the vendored source asks
`calogBerrySealed` (defined by the adapter, declared in `berry_conf.h`) at each funnel: `open`, the
`os` and `introspect` native modules, `be_loadmode`, and the shared-library loader. `be_loadmode`
closes a gap the old seal had: `compile(path, "file")` and `import` of a `.be` file read and ran
files even in a sandbox, because only `.bec` and `.so` were compiled out. The adapter's native
trampoline and foreign-call paths were two copies of the same marshal/call/raise sequence, and
`os.exit` would have been a third; all three are `berryCallWith` now.
- **my-basic** -- `IMPORT "path"` is refused at parse time only when `calogMyBasicSealed`, and
`INPUT` reads stdin again outside a sandbox.
- **s7** -- the three build flags are gone, so the runner has s7's system extras, C loader, and r7rs
`getenv`, and the vendored source refuses each when `calogS7Sealed`, at the C function (s7's
`unlet`/`#_` still recover any rebinding an adapter could make). Two gaps closed here too: `load`
was the only refused way to read a script, but `require` and autoload reach
`s7_load_with_environment` without it, so the checks moved to the two funnels every load passes,
`load_file_1` and `load_shared_object`. And the cross builds had never passed the three flags, so
a macOS runner already had `system` and `getenv` in a sandbox; the runtime checks hold in every
build.
### Test
`tests/testStdlib.c` runs each of the six engines three ways: with no sandbox, a file round trip
through the engine's own I/O plus an environment variable or a loaded module; with no sandbox, the
engine's exit, which must reach `CALOG_EXIT_NATIVE` with its code and never return; and in an
allow-list-only sandbox, a probe of every way out, all of which must be refused -- Berry's file
`compile` and s7's `load`, `system`, and `getenv` included. A runtime with no exit native shows
`os.exit` failing with the reason.
The ThreadSanitizer build of the httpd path (`make tsanhttpd`), which covers the shared-listener
accept of sec 33, had stopped linking: its hand-written source list predated `calogFs` and
`calogTrust`, which the ASan build of the same test links. Both are in the list now, and it runs clean.

6
examples/scripts/README.md
View file

@ -26,8 +26,10 @@ Conventions every example follows:
process reports. `Ctrl-C` ends a run the same way, aborting the scripts rather than waiting
for them to finish.
- **`calogArgs()`** returns the arguments given after `--` (`bin/calog build.lua -- release v2`),
the same list for every script in the run. It is the only parameter channel: the engines' own
`getenv`/`argv` are not available.
the same list for every script in the run. No engine is handed an `argv` of its own, so this is
the parameter channel; each engine's own environment access (`os.getenv` and the like) works.
- **`calogScript()`** returns the path of the calling script's own file (`""` in a task), so a
script can find files kept beside it wherever the run was started from.
- Extensions map to engines: `.lua .js .nut .bas .be .scm .wren`.
## `languages/` -- one guided tour per engine

41
libs/calogNet.c
View file

@ -496,6 +496,7 @@ static int32_t tcpAccept(CalogValueT *args, int32_t argCount, CalogValueT *resul
NetLibT *lib;
NetSocketT *listener;
CalogSocketT fd;
int timeout;
lib = (NetLibT *)userData;
calogValueNil(result);
@ -506,23 +507,43 @@ static int32_t tcpAccept(CalogValueT *args, int32_t argCount, CalogValueT *resul
if (listener == NULL) {
return calogFail(result, calogErrArgE, "tcpAccept: invalid listener handle");
}
// Optional timeout: poll-gate the accept so a script's accept loop wakes periodically to re-check
// its own stop condition (a blocking accept would pin the context thread until a connection lands).
// Wait for a client with poll, then take it with accept on the NON-blocking listener (tcpListen).
// Several contexts may accept on one listener: every one of them wakes for a connection, and those
// that lose the race see "would block" -- with a timeout that returns nil as if none had come, so
// the script loop re-checks its stop condition; without one they go back to waiting. A blocking
// accept here slept the losers until some later connection, pinning their threads past shutdown.
timeout = -1;
if (argCount == 2) {
timeout = args[1].as.i < 0 ? 0 : (args[1].as.i > INT32_MAX ? INT32_MAX : (int)args[1].as.i);
}
for (;;) {
struct pollfd pfd;
int timeout;
int ready;
timeout = args[1].as.i < 0 ? 0 : (args[1].as.i > INT32_MAX ? INT32_MAX : (int)args[1].as.i);
pfd.fd = listener->fd;
pfd.events = POLLIN;
pfd.revents = 0;
ready = calogPoll(&pfd, 1, timeout);
if (ready < 0 && timeout < 0) {
return calogFail(result, calogErrArgE, calogSockErrStr());
}
if (ready <= 0) {
return calogOkE; // timeout (nil result) -- the script loop decides whether to keep going
}
fd = accept(listener->fd, NULL, NULL);
if (fd != CALOG_INVALID_SOCKET) {
break;
}
if (!calogSockWouldBlock(calogSockErrno())) {
return calogFail(result, calogErrArgE, calogSockErrStr());
}
if (timeout >= 0) {
return calogOkE; // another context took it: nil, as for a timeout
}
}
fd = accept(listener->fd, NULL, NULL);
if (fd == CALOG_INVALID_SOCKET) {
// BSD and Windows hand the listener's non-blocking mode to the accepted socket; the connection's
// own calls (tcpRecv, tcpSend) block until they have their bytes.
if (calogSockSetNonblock(fd, 0) != 0) {
calogSockClose(fd);
return calogFail(result, calogErrArgE, calogSockErrStr());
}
if (listener->tlsCtx == NULL) {
@ -662,6 +683,14 @@ static int32_t tcpListen(CalogValueT *args, int32_t argCount, CalogValueT *resul
}
return status;
}
// Non-blocking, so tcpAccept never sleeps in accept() after another context took the connection
if (calogSockSetNonblock(fd, 1) != 0) {
calogSockClose(fd);
if (ctx != NULL) {
SSL_CTX_free(ctx);
}
return calogFail(result, calogErrArgE, calogSockErrStr());
}
status = netStore(lib, fd, NET_TYPE_TCP_LISTEN, result);
if (status != calogOkE) {
if (ctx != NULL) {

229
src/berry/berryAdapter.c
View file

@ -48,10 +48,13 @@ struct CalogBerryT {
// thread-local pointer -- set once at create -- resolves the running context exactly, the
// same pattern my-basic uses for its process-global allocator (see mybasicAdapter.c).
static _Thread_local CalogLimitStateT *gBerryLimits = NULL;
// The broker of the Berry context running on THIS thread. The heartbeat hook gets only the bvm, so
// this is how it reaches the runtime to ask whether the abort latch is set. Armed for every context,
// limited or not, because an unlimited script must be interruptible too.
static _Thread_local CalogT *gBerryBroker = NULL;
// The Berry context running on THIS thread. The heartbeat hook and the vendored os.exit get only the
// bvm, so this is how they reach the runtime (is the abort latch set; end the run). Armed for every
// context, limited or not, because an unlimited script must be interruptible too.
static _Thread_local CalogBerryT *gBerryContext = NULL;
// Whether that context is sandboxed (an allow-list alone included). Set before the VM is built, so
// calogBerrySealed is exact for the VM's whole life.
static _Thread_local bool gBerrySealed = false;
// Backs a CalogFnT exported from this VM: the owning context, the reclaimable slot
// number, and the name of the hidden global that keeps the Berry function GC-reachable.
@ -61,18 +64,26 @@ typedef struct BerryExportT {
char refName[BERRY_REF_CAP];
} BerryExportT;
// What a call marshalled through berryCallWith does with its arguments; target is the caller's own
// (the native's name, the function value, or nothing).
typedef int32_t (*BerryDispatchFnT)(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int berryCallWith(bvm *vm, CalogBerryT *context, int argc, int held, BerryDispatchFnT dispatch, void *target, const char *noun);
static int32_t berryCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void berryCallableRelease(CalogFnT *callable);
static int32_t berryExitDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out);
static int berryForeignCall(bvm *vm);
static int32_t berryFromValue(CalogBerryT *context, const CalogValueT *value, int32_t depth);
static int32_t berryInvokeDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int32_t berryNativeDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result);
static void berryObsHook(bvm *vm, int event, ...);
static int32_t berryTrackForeign(CalogBerryT *context, CalogFnT *callable);
static int32_t berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth);
static int berryTrampoline(bvm *vm);
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed) {
CalogBerryT *context;
*out = NULL;
@ -80,6 +91,7 @@ int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, Calo
if (context == NULL) {
return calogErrOomE;
}
gBerrySealed = sandboxed;
// The base VM is built before the cap is armed, so the runtime itself is never refused
// (the cap must exceed the base runtime, as with Lua); Berry still counts these bytes in
// vm->gc.usage, so a subsequent grow is measured against the true live total.
@ -96,8 +108,8 @@ int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, Calo
// instruction loop every 2^19 instructions (BE_USE_PERF_COUNTERS is enabled in the
// vendored berry_conf.h) -- often enough to notice a wall-clock deadline inside a tight
// loop. An unlimited context leaves the pointer NULL and installs no hook (zero overhead).
gBerryLimits = limits;
gBerryBroker = broker;
gBerryLimits = limits;
gBerryContext = context;
be_set_obs_hook(context->vm, berryObsHook);
*out = context;
return calogOkE;
@ -107,6 +119,23 @@ int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, Calo
// Charge check for the vendored be_realloc cap patch: non-zero when growing the running
// context's live heap by `growth` bytes would exceed its cap. Also mirrors the current live
// usage into memUsed for reporting. NULL/uncapped context -> never refuses.
// os.exit for the vendored os module (be_oslib.c), which only a context with no sandbox can import:
// the run ends the way the host's calogExit ends it, not with exit() underneath every other script
// and the host's teardown.
int calogBerryExit(bvm *vm) {
return berryCallWith(vm, gBerryContext, be_top(vm), 0, berryExitDispatch, NULL, "os.exit");
}
// Non-zero when the context on this thread is sandboxed (calogContextOpenLimited). The vendored
// Berry asks before each way out of the VM -- open, the os and introspect modules, a script or
// bytecode file, a shared library -- and refuses in a sandboxed context, where a script reaches the
// host only through calog natives. A context with no sandbox has all of Berry.
int calogBerrySealed(void) {
return gBerrySealed;
}
int calogBerryMemOverCap(size_t usage, size_t growth) {
CalogLimitStateT *limits;
@ -133,7 +162,7 @@ static void berryObsHook(bvm *vm, int event, ...) {
}
// The runtime was latched aborting (calogExit, or a signal): unwind this script even though it
// may never call a native. Deliberately no retire -- teardown order stays the host's.
if (gBerryBroker != NULL && calogAborting(gBerryBroker)) {
if (gBerryContext != NULL && calogAborting(gBerryContext->broker)) {
calogAbortRaise();
be_raise(vm, "calog_abort", CALOG_ABORT_MESSAGE);
}
@ -145,6 +174,69 @@ static void berryObsHook(bvm *vm, int event, ...) {
}
// Marshal a call's arguments (stack slots 1..argc), hand them to dispatch, pop the `held` values the
// caller left above them, and return the result to Berry -- or raise what failed. noun names the
// caller in the messages.
static int berryCallWith(bvm *vm, CalogBerryT *context, int argc, int held, BerryDispatchFnT dispatch, void *target, const char *noun) {
CalogValueT *args;
CalogValueT result;
int index;
int32_t status;
char message[CALOG_ERR_MSG_CAP];
args = NULL;
if (argc > 0) {
args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
if (args == NULL) {
be_pop(vm, held);
snprintf(message, sizeof(message), "out of memory marshalling %s arguments", noun);
be_raise(vm, "memory_error", message);
return 0;
}
}
for (index = 0; index < argc; index++) {
status = berryToValue(context, index + 1, &args[index], 0);
if (status != calogOkE) {
int cleanup;
for (cleanup = 0; cleanup < index; cleanup++) {
calogValueFree(&args[cleanup]);
}
free(args);
be_pop(vm, held);
snprintf(message, sizeof(message), "failed to marshal a %s argument", noun);
be_raise(vm, "type_error", message);
return 0;
}
}
calogValueNil(&result);
status = dispatch(context, target, args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
be_pop(vm, held);
if (status != calogOkE) {
if (result.type == calogStringE) {
snprintf(message, sizeof(message), "%s", result.as.s.bytes);
} else {
snprintf(message, sizeof(message), "%s call failed", noun);
}
calogValueFree(&result);
be_raise(vm, "calog_error", message);
return 0;
}
status = berryFromValue(context, &result, 0);
calogValueFree(&result);
if (status != calogOkE) {
be_pop(vm, 1);
snprintf(message, sizeof(message), "failed to marshal the %s result", noun);
be_raise(vm, "type_error", message);
return 0;
}
be_return(vm);
}
static int32_t berryCallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
BerryExportT *export;
CalogBerryT *context;
@ -222,8 +314,9 @@ void calogBerryDestroy(CalogBerryT *context) {
}
// This thread's limit pointer aliases the context's limit state, which is freed with the
// context; clear it so nothing on this (soon-joined) thread can read it afterward.
gBerryLimits = NULL;
gBerryBroker = NULL;
gBerryLimits = NULL;
gBerryContext = NULL;
gBerrySealed = false;
// Release the foreign function values pushed into this VM (see berryTrackForeign).
for (index = 0; index < context->foreignCount; index++) {
calogFnRelease(context->foreignFns[index]);
@ -259,6 +352,12 @@ int32_t calogBerryExport(CalogBerryT *context, const char *globalName, CalogFnT
}
static int32_t berryExitDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result) {
(void)target;
return calogEngineExit(context->broker, args, argCount, result);
}
static int32_t berryExportValue(CalogBerryT *context, int index, CalogFnT **out) {
bvm *vm;
BerryExportT *export;
@ -327,12 +426,7 @@ int32_t calogBerryExpose(CalogBerryT *context, const char *name) {
static int berryForeignCall(bvm *vm) {
CalogBerryT *context;
CalogFnT *callable;
CalogValueT *args;
CalogValueT result;
int argc;
int index;
int32_t status;
char message[CALOG_ERR_MSG_CAP];
argc = be_top(vm); // arguments occupy stack slots 1..argc
be_getupval(vm, 0, 0);
@ -340,45 +434,7 @@ static int berryForeignCall(bvm *vm) {
be_getupval(vm, 0, 1);
callable = (CalogFnT *)be_tocomptr(vm, -1);
be_pop(vm, 2);
args = NULL;
if (argc > 0) {
args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
if (args == NULL) {
be_raise(vm, "memory_error", "out of memory marshalling function-value args");
return 0;
}
}
for (index = 0; index < argc; index++) {
status = berryToValue(context, index + 1, &args[index], 0);
if (status != calogOkE) {
int cleanup;
for (cleanup = 0; cleanup < index; cleanup++) {
calogValueFree(&args[cleanup]);
}
free(args);
be_raise(vm, "value_error", "failed to marshal a function-value argument");
return 0;
}
}
status = calogFnInvoke(callable, args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
if (status != calogOkE) {
snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "function value failed");
calogValueFree(&result);
be_raise(vm, "calog_error", message);
return 0;
}
status = berryFromValue(context, &result, 0);
calogValueFree(&result);
if (status != calogOkE) {
be_pop(vm, 1);
be_raise(vm, "type_error", "failed to marshal the function-value result");
return 0;
}
be_return(vm);
return berryCallWith(vm, context, argc, 0, berryInvokeDispatch, callable, "function-value");
}
@ -534,6 +590,17 @@ int32_t calogBerryRun(CalogBerryT *context, const char *source) {
}
static int32_t berryInvokeDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result) {
(void)context;
return calogFnInvoke((CalogFnT *)target, args, argCount, result);
}
static int32_t berryNativeDispatch(CalogBerryT *context, void *target, CalogValueT *args, int32_t argCount, CalogValueT *result) {
return calogCall(context->broker, (const char *)target, args, argCount, result);
}
static int32_t berryToValue(CalogBerryT *context, int index, CalogValueT *out, int32_t depth) {
bvm *vm;
@ -681,60 +748,14 @@ static int32_t berryTrackForeign(CalogBerryT *context, CalogFnT *callable) {
static int berryTrampoline(bvm *vm) {
CalogBerryT *context;
const char *name;
CalogValueT *args;
CalogValueT result;
int argc;
int index;
int32_t status;
char message[CALOG_ERR_MSG_CAP];
argc = be_top(vm); // arguments occupy stack slots 1..argc
// Recover the binding from the closure's upvalues (pushed above the args).
// Recover the binding from the closure's upvalues, pushed above the args and left there until
// the call is done: the name is borrowed from the second.
be_getupval(vm, 0, 0);
context = (CalogBerryT *)be_tocomptr(vm, -1);
be_getupval(vm, 0, 1);
name = be_tostring(vm, -1); // borrowed; valid until popped after the call
args = NULL;
if (argc > 0) {
args = (CalogValueT *)calloc((size_t)argc, sizeof(CalogValueT));
if (args == NULL) {
be_pop(vm, 2);
be_raise(vm, "memory_error", "out of memory marshalling native arguments");
return 0;
}
}
for (index = 0; index < argc; index++) {
status = berryToValue(context, index + 1, &args[index], 0);
if (status != calogOkE) {
int cleanup;
for (cleanup = 0; cleanup < index; cleanup++) {
calogValueFree(&args[cleanup]);
}
free(args);
be_pop(vm, 2);
be_raise(vm, "type_error", "failed to marshal a native argument");
return 0;
}
}
status = calogCall(context->broker, name, args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
be_pop(vm, 2); // pop the two upvalues (name, context)
if (status != calogOkE) {
snprintf(message, sizeof(message), "%s", (result.type == calogStringE) ? result.as.s.bytes : "native call failed");
calogValueFree(&result);
be_raise(vm, "calog_error", message);
return 0;
}
status = berryFromValue(context, &result, 0);
calogValueFree(&result);
if (status != calogOkE) {
be_pop(vm, 1);
be_raise(vm, "type_error", "failed to marshal the native result");
return 0;
}
be_return(vm);
name = be_tostring(vm, -1);
return berryCallWith(vm, context, argc, 2, berryNativeDispatch, (void *)name, "native");
}

2
src/berry/berryAdapter.h
View file

@ -18,7 +18,7 @@
typedef struct CalogBerryT CalogBerryT;
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
int32_t calogBerryCreate(CalogBerryT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed);
void calogBerryDestroy(CalogBerryT *context);
int32_t calogBerryExport(CalogBerryT *context, const char *globalName, CalogFnT **out);
int32_t calogBerryExpose(CalogBerryT *context, const char *name);

2
src/berry/berryEngine.c
View file

@ -30,7 +30,7 @@ static int32_t berryEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status;
*interpOut = NULL;
status = calogBerryCreate(&be, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
status = calogBerryCreate(&be, calogContextBroker(context), calogContextId(context), calogContextLimitState(context), calogContextSandboxed(context));
if (status != calogOkE) {
return status;
}

18
src/broker.c
View file

@ -102,6 +102,24 @@ void calogBrokerDestroy(CalogT *broker) {
}
int32_t calogEngineExit(CalogT *broker, CalogValueT *args, int32_t argCount, CalogValueT *result) {
CalogValueT code;
int32_t status;
calogValueInt(&code, EXIT_SUCCESS);
if (argCount > 0 && (args[0].type == calogIntE || args[0].type == calogRealE)) {
code = args[0];
} else if (argCount > 0 && args[0].type == calogBoolE && !args[0].as.b) {
calogValueInt(&code, EXIT_FAILURE);
}
status = calogCall(broker, CALOG_EXIT_NATIVE, &code, 1, result);
if (status == calogErrNotFoundE) {
return calogFail(result, status, "exit: this host has no " CALOG_EXIT_NATIVE " to end the run with");
}
return status;
}
int32_t calogFail(CalogValueT *result, int32_t status, const char *message) {
int32_t initStatus;

5
src/calog.h
View file

@ -285,6 +285,11 @@ int32_t calogAbortAll(CalogT *calog, CalogValueT *result);
// a tight compute loop -- still stops. To ask whether a failure in hand WAS that abort rather than
// the script's own, adapters use the internal calogAbortRaised instead.
bool calogAborting(CalogT *calog);
// The native that ends a run (bin/calog registers it). An engine's own exit -- Lua's os.exit, Tcl's
// exit, and the like, in a context with no sandbox -- calls it rather than libc exit(), so the run
// ends the same way: the script unwinds, every other script stops, and the host tears down in order.
// A host that wants scripts able to end its run registers a native under this name, inline.
#define CALOG_EXIT_NATIVE "calogExit"
extern const CalogEngineT calogLuaEngine;
extern const CalogEngineT calogJsEngine;

12
src/calogInternal.h
View file

@ -175,6 +175,12 @@ void calogAbortRaise(void);
// error, say) still gets its diagnostic while some other script is tearing the runtime down.
bool calogAbortRaised(CalogT *calog);
// An engine's own exit, in a context with no sandbox: calls the host's CALOG_EXIT_NATIVE with the
// code (a missing code, nil, or true is EXIT_SUCCESS; false is EXIT_FAILURE; a number is the code)
// and returns its status for the adapter to raise like any native error. A host with no such native
// has no run to end: the call fails saying so.
int32_t calogEngineExit(CalogT *calog, CalogValueT *args, int32_t argCount, CalogValueT *result);
// Report a script failure to the runtime's error handler, delivered on the host thread. A library
// that invokes a script callback from its OWN thread (the timer thread, a publish) uses this: that
// thread has no caller to return a status to, so without it a callback that failed vanishes -- no
@ -254,6 +260,12 @@ typedef struct CalogLimitStateT {
// unlimited (so the common case installs nothing).
CalogLimitStateT *calogContextLimitState(CalogContextT *context);
// True for a context opened with any sandbox at all (calogContextOpenLimited, or a task inheriting
// one) -- an allow-list alone included, which calogContextLimitState does not report. An engine
// adapter seals its interpreter's own ways out to the host (files, processes, the environment, its
// exit) exactly when this is true; a context with no sandbox keeps its engine's standard library.
bool calogContextSandboxed(CalogContextT *context);
// calogContextOpen / calogContextLoad for a script spawning a task: the new context INHERITS the
// calling script's sandbox (shared memory pool, shared absolute deadline, same allow-list) instead
// of starting unrestricted, and is refused -- NULL -- once the tree has reached maxContexts. Used by

104
src/calogMain.c
View file

@ -86,6 +86,7 @@ static const char *extensionOf(const char *arg);
static int32_t nativeCalogArgs(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeCalogExit(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeCalogPrint(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeCalogScript(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void noteExitCode(int32_t code);
static void onError(uint64_t contextId, const char *message, void *userData);
static void onSignal(int sig);
@ -93,7 +94,7 @@ static void printUsage(FILE *stream, const char *program);
static void printValue(const CalogValueT *value);
static char *readFile(const char *path);
static void requestShutdown(int32_t code);
static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **outSource);
static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **outSource, char **outPath);
// Requested by a script (calogExit), a signal, or a context erroring out; the host pump loop watches
// gShutdown and exits with gExitCode. See noteExitCode for how the code is arbitrated.
@ -109,22 +110,25 @@ static _Atomic bool gAbortRequested = false;
// The arguments after "--" on the command line: the sanctioned way to parameterize a run. Written
// once before any context starts and never mutated, so calogArgs reads them without a lock. Scripts
// have no other channel -- the engines' own getenv/argv are removed (see API.md) -- and a documented
// one beats every project inventing its own convention out of files or the kv store.
// are handed no argv of their own, and a documented channel beats every project inventing its own
// convention out of files or the kv store.
static char **gScriptArgs = NULL;
static int32_t gScriptArgCount = 0;
// One entry per script context the runner launched. onError flags `failed` for a context whose
// script errors; the pump loop then closes that context and drops the live count. When the live
// count reaches zero -- every launched context has errored out -- the runner exits.
// count reaches zero -- every launched context has errored out -- the runner exits. An entry is
// filled in before its script starts (the id last), so the script's own calogScript() finds it.
typedef struct LaunchedT {
uint64_t id;
CalogContextT *context; // NULL once the context has been closed
_Atomic bool failed;
_Atomic uint64_t id;
CalogContextT *context; // NULL once the context has been closed
const char *path; // the script's file (owned by main's paths)
_Atomic bool failed;
} LaunchedT;
static LaunchedT *gLaunched = NULL;
static int32_t gLaunchedCount = 0;
static int32_t gLaunchedCap = 0; // gLaunched's entries, every one zeroed before any script runs
// The engines the runner knows, in load-search priority order (the same order
// calogRegisterBuiltinEngines uses, so an extensionless name resolves identically here and via
@ -276,6 +280,34 @@ static int32_t nativeCalogArgs(CalogValueT *args, int32_t argCount, CalogValueT
}
// calogScript() -> the path of the script file the calling context was started from, as the runner
// found it from the command line (with any extension it supplied), so a script can find the files
// beside it; "" in a context the runner did not start from a file (a task). Inline: each entry is
// complete before its script starts and never changes while it runs.
static int32_t nativeCalogScript(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
const char *path;
uint64_t id;
int32_t index;
(void)args;
(void)argCount;
(void)userData;
calogValueNil(result);
path = "";
id = calogCurrentId();
for (index = 0; id != 0 && index < gLaunchedCap; index++) {
if (atomic_load(&gLaunched[index].id) == id) {
path = gLaunched[index].path;
break;
}
}
if (calogValueString(result, path, (int64_t)strlen(path)) != calogOkE) {
return calogFail(result, calogErrOomE, "calogScript: out of memory");
}
return calogOkE;
}
// calogExit([code]) -- a script asks the runner to tear everything down and exit. Registered inline
// so it runs on the CALLING script's thread: that is what lets calogAbortAll unwind this very script
// (an error raised on the host thread could not), and everything it touches is thread-safe anyway.
@ -405,6 +437,7 @@ static void printUsage(FILE *stream, const char *program) {
fprintf(stream, "\n");
fprintf(stream, "Run each script through the calog multi-language runtime.\n");
fprintf(stream, "Arguments after -- are passed to every script, readable with calogArgs().\n");
fprintf(stream, "calogScript() is the path of the calling script's own file.\n");
fprintf(stream, "A name with a known extension runs on that engine:\n");
fprintf(stream, " ");
// Derived from gEngines so the help text can never drift from the resolver's own truth.
@ -500,11 +533,11 @@ static void requestShutdown(int32_t code) {
}
// Resolve one command-line argument to an engine + its script source (a fresh buffer the caller
// frees). A recognized extension binds the exact file to that engine; otherwise the argument is
// Resolve one command-line argument to an engine + its script source and the path of the file it
// came from (fresh buffers the caller frees). A recognized extension binds the exact file to that engine; otherwise the argument is
// treated as a base name and searched as <arg>.<ext> across the engines in priority order. On
// failure prints a diagnostic and returns false.
static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **outSource) {
static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **outSource, char **outPath) {
const char *ext;
const CalogEngineT *engine;
char *source;
@ -512,6 +545,7 @@ static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **o
*outEngine = NULL;
*outSource = NULL;
*outPath = NULL;
ext = extensionOf(arg);
if (ext != NULL) {
@ -522,6 +556,12 @@ static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **o
fprintf(stderr, "calog: %s: %s\n", arg, strerror(errno));
return false;
}
*outPath = strdup(arg);
if (*outPath == NULL) {
fprintf(stderr, "calog: out of memory\n");
free(source);
return false;
}
*outEngine = engine;
*outSource = source;
return true;
@ -558,9 +598,9 @@ static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **o
free(path);
return false;
}
free(path);
*outEngine = engine;
*outSource = source;
*outPath = path;
return true;
}
}
@ -573,6 +613,7 @@ static bool resolveArg(const char *arg, const CalogEngineT **outEngine, char **o
int main(int argc, char **argv) {
const CalogEngineT **engines = NULL;
char **sources = NULL;
char **paths = NULL;
const char *program;
CalogT *calog = NULL;
struct timespec tick = { 0, PUMP_INTERVAL_NS };
@ -615,7 +656,8 @@ int main(int argc, char **argv) {
}
engines = (const CalogEngineT **)malloc((size_t)scriptCount * sizeof(*engines));
sources = (char **)malloc((size_t)scriptCount * sizeof(*sources));
if (engines == NULL || sources == NULL) {
paths = (char **)malloc((size_t)scriptCount * sizeof(*paths));
if (engines == NULL || sources == NULL || paths == NULL) {
fprintf(stderr, "calog: out of memory\n");
status = 1;
goto cleanup;
@ -623,7 +665,7 @@ int main(int argc, char **argv) {
// Resolve every argument before running any (fail fast): one bad name runs nothing.
for (index = 0; index < scriptCount; index++) {
if (!resolveArg(argv[index + 1], &engines[index], &sources[index])) {
if (!resolveArg(argv[index + 1], &engines[index], &sources[index], &paths[index])) {
status = 1;
goto cleanup;
}
@ -640,7 +682,8 @@ int main(int argc, char **argv) {
if (calogRegister(calog, "calogPrint", nativeCalogPrint, NULL) != calogOkE ||
calogRegisterInline(calog, "calogArgs", nativeCalogArgs, NULL) != calogOkE ||
calogRegisterInline(calog, "calogExit", nativeCalogExit, NULL) != calogOkE) {
calogRegisterInline(calog, CALOG_EXIT_NATIVE, nativeCalogExit, NULL) != calogOkE ||
calogRegisterInline(calog, "calogScript", nativeCalogScript, NULL) != calogOkE) {
fprintf(stderr, "calog: failed to register the runner natives\n");
status = 1;
goto cleanup;
@ -669,29 +712,38 @@ int main(int argc, char **argv) {
// Launch every script fire-and-forget on its own context, recording the live ones so a
// later error can retire exactly that context. calogContextEval keeps its own copy of the
// source, so the resolved buffer is freed right after.
// source, so the resolved buffer is freed right after. The entry is filled in before the script
// starts -- its id last -- so the script's first calogScript() already finds its path.
gLaunched = (LaunchedT *)calloc((size_t)scriptCount, sizeof(*gLaunched));
if (gLaunched == NULL) {
fprintf(stderr, "calog: out of memory\n");
status = 1;
goto cleanup;
}
gLaunchedCap = scriptCount;
for (index = 0; index < scriptCount; index++) {
CalogContextT *context;
LaunchedT *entry;
entry = &gLaunched[gLaunchedCount];
context = calogContextOpen(calog, engines[index]);
if (context == NULL) {
fprintf(stderr, "calog: %s: failed to open a context\n", argv[index + 1]);
noteExitCode(1); // failed launch: never report success on exit
} else if (calogContextEval(context, sources[index]) != calogOkE) {
fprintf(stderr, "calog: %s: failed to start script\n", argv[index + 1]);
calogContextClose(context);
noteExitCode(1); // failed launch: never report success on exit
} else {
gLaunched[gLaunchedCount].id = calogContextId(context);
gLaunched[gLaunchedCount].context = context;
atomic_store(&gLaunched[gLaunchedCount].failed, false);
gLaunchedCount++;
entry->context = context;
entry->path = paths[index];
atomic_store(&entry->failed, false);
atomic_store(&entry->id, calogContextId(context));
if (calogContextEval(context, sources[index]) != calogOkE) {
fprintf(stderr, "calog: %s: failed to start script\n", argv[index + 1]);
atomic_store(&entry->id, 0);
entry->context = NULL;
calogContextClose(context);
noteExitCode(1); // failed launch: never report success on exit
} else {
gLaunchedCount++;
}
}
free(sources[index]);
}
@ -750,6 +802,10 @@ int main(int argc, char **argv) {
calogDestroy(calog);
free(gLaunched);
for (index = 0; index < resolvedCount; index++) {
free(paths[index]);
}
free(paths);
return (int)atomic_load(&gExitCode);
cleanup:
@ -757,9 +813,11 @@ cleanup:
// argv-length arrays, and destroy the runtime if calogCreate got far enough to build one.
for (index = 0; index < resolvedCount; index++) {
free(sources[index]);
free(paths[index]);
}
free(engines);
free(sources);
free(paths);
if (calog != NULL) {
calogDestroy(calog);
}

5
src/context.c
View file

@ -611,6 +611,11 @@ CalogLimitStateT *calogContextLimitState(CalogContextT *context) {
}
bool calogContextSandboxed(CalogContextT *context) {
return context->sandbox != NULL;
}
static int limitNameCompare(const void *a, const void *b) {
return strcmp(*(const char *const *)a, *(const char *const *)b);
}

63
src/janet/janetAdapter.c
View file

@ -64,10 +64,15 @@ static _Thread_local CalogLimitStateT *gJanetLimits = NULL;
static _Thread_local JanetVM *gJanetVm = NULL;
static _Thread_local bool gJanetInterrupted = false;
// Backs an exposed broker native: an abstract whose .call dispatches through calogCall by name.
// What a call on a JanetNativeT does with its arguments: name is the binding's.
typedef int32_t (*JanetDispatchFnT)(CalogT *broker, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
// Backs an exposed broker native -- an abstract whose .call dispatches through calogCall by name --
// or, in a context with no sandbox, os/exit (calogEngineExit).
typedef struct JanetNativeT {
CalogJanetT *context;
char *name;
CalogJanetT *context;
char *name;
JanetDispatchFnT dispatch;
} JanetNativeT;
// Backs a foreign CalogFnT pushed into this VM: an abstract whose .call invokes the retained fn.
@ -83,12 +88,15 @@ typedef struct JanetScriptT {
} JanetScriptT;
static void janetCharge(CalogLimitStateT *owner, int64_t delta);
static int32_t janetDefNative(CalogJanetT *context, const char *name, JanetDispatchFnT dispatch);
static int32_t janetExitDispatch(CalogT *broker, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
static Janet janetForeignCall(void *p, int32_t argc, Janet *argv);
static int janetForeignGc(void *data, size_t len);
static void janetFreeArgs(CalogValueT *args, int32_t argCount);
static int32_t janetFromValue(CalogJanetT *context, const CalogValueT *value, Janet *out, int32_t depth);
static int32_t janetMarshalArgs(CalogJanetT *context, int32_t argc, Janet *argv, CalogValueT **out);
static Janet janetNativeCall(void *p, int32_t argc, Janet *argv);
static int32_t janetNativeDispatch(CalogT *broker, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int janetNativeGc(void *data, size_t len);
static int32_t janetScriptInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void janetScriptRelease(CalogFnT *callable);
@ -202,9 +210,11 @@ void calogJanetFree(void *ptr) {
}
// Shut every door out of the VM that does not go through a calog native.
// Shut every door out of a SANDBOXED VM (calogContextOpenLimited) that does not go through a calog
// native. A context with no sandbox keeps all of Janet -- its script is the host's own code -- except
// that os/exit ends the run through calogExit (janetExitDispatch).
//
// calog's contract is that a script reaches the host only through registered natives, where the
// A sandboxed script reaches the host only through registered natives, where the
// allow-list, the memory cap and the wall-clock budget can see it. Janet ships its own filesystem,
// subprocess, socket, environment and FFI bindings, none of which pass through calogCall, so no
// policy calog can express applies to them -- and ffi/ is worse than the rest together, since jitfn
@ -284,7 +294,7 @@ static const JanetAbstractType gNativeType = {
};
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed) {
CalogJanetT *context;
*out = NULL;
@ -296,11 +306,17 @@ int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, Calo
// The core env is memoized and gcrooted internally by Janet, so the defs installed by
// calogJanetExpose survive collection for the VM's lifetime.
context->env = janet_core_env(NULL);
janetSealHostAccess(context->env);
context->broker = broker;
context->ctxId = ctxId;
context->limits = limits;
context->janetVm = janet_local_vm(); // this context thread's VM, for the watchdog's interrupt
if (sandboxed) {
janetSealHostAccess(context->env);
} else if (janetDefNative(context, "os/exit", janetExitDispatch) != calogOkE) {
janet_deinit();
free(context);
return calogErrOomE;
}
// Arm the limits AFTER the base VM + core env are built, so the base runtime is neither charged
// nor deadline-checked (the memory cap must exceed the base runtime, as with Lua). gJanetVm is
// always set so the allocator can interrupt on an over-cap allocation.
@ -353,12 +369,18 @@ int32_t calogJanetExport(CalogJanetT *context, const char *name, CalogFnT **out)
int32_t calogJanetExpose(CalogJanetT *context, const char *name) {
JanetNativeT *native;
char *copy;
if (calogLookup(context->broker, name) == NULL) {
return calogErrNotFoundE;
}
return janetDefNative(context, name, janetNativeDispatch);
}
// Bind name in the context's env to a JanetNativeT whose calls go to dispatch.
static int32_t janetDefNative(CalogJanetT *context, const char *name, JanetDispatchFnT dispatch) {
JanetNativeT *native;
char *copy;
// Copy the name first so the abstract is fully formed the instant it exists (its .gc handler
// frees this copy). janet_abstract aborts rather than returns NULL on OOM.
copy = strdup(name);
@ -366,13 +388,22 @@ int32_t calogJanetExpose(CalogJanetT *context, const char *name) {
return calogErrOomE;
}
native = (JanetNativeT *)janet_abstract(&gNativeType, sizeof(JanetNativeT));
native->context = context;
native->name = copy;
native->context = context;
native->name = copy;
native->dispatch = dispatch;
janet_def(context->env, name, janet_wrap_abstract(native), NULL);
return calogOkE;
}
// (os/exit [code]) in a context with no sandbox: the run ends the way the host's calogExit ends it,
// not with exit() underneath every other script and the host's teardown.
static int32_t janetExitDispatch(CalogT *broker, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result) {
(void)name;
return calogEngineExit(broker, args, argCount, result);
}
// Call target for a foreign CalogFnT pushed into this VM (gForeignType.call). p is the abstract's
// JanetForeignT payload; the arguments are argv[0..argc).
static Janet janetForeignCall(void *p, int32_t argc, Janet *argv) {
@ -555,7 +586,8 @@ static Janet janetNativeCall(void *p, int32_t argc, Janet *argv) {
if (janetMarshalArgs(context, argc, argv, &args) != calogOkE) {
janet_panic("failed to marshal a native argument");
}
status = calogCall(context->broker, native->name, args, argc, &result);
calogValueNil(&result);
status = native->dispatch(context->broker, native->name, args, argc, &result);
janetFreeArgs(args, argc);
if (status != calogOkE) {
char message[CALOG_ERR_MSG_CAP];
@ -572,6 +604,11 @@ static Janet janetNativeCall(void *p, int32_t argc, Janet *argv) {
}
static int32_t janetNativeDispatch(CalogT *broker, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result) {
return calogCall(broker, name, args, argCount, result);
}
static int janetNativeGc(void *data, size_t len) {
JanetNativeT *native;

2
src/janet/janetAdapter.h
View file

@ -24,7 +24,7 @@
typedef struct CalogJanetT CalogJanetT;
// Create a Janet VM for this context (call on the context's own thread). *out owns the VM.
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
int32_t calogJanetCreate(CalogJanetT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed);
// Tear down the VM (call on the context's own thread).
void calogJanetDestroy(CalogJanetT *context);

2
src/janet/janetEngine.c
View file

@ -30,7 +30,7 @@ static int32_t janetEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status;
*interpOut = NULL;
status = calogJanetCreate(&janet, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
status = calogJanetCreate(&janet, calogContextBroker(context), calogContextId(context), calogContextLimitState(context), calogContextSandboxed(context));
if (status != calogOkE) {
return status;
}

48
src/lua/luaAdapter.c
View file

@ -56,7 +56,10 @@ static int32_t luaPushValueDepth(lua_State *L, const CalogValueT *value, in
static int32_t luaToValueDepth(lua_State *L, int idx, CalogValueT *out, int32_t depth);
static int luaTrampoline(lua_State *L);
static int32_t luaTrampolineDispatch(void *userData, CalogValueT *args, int32_t argCount, CalogValueT *result);
static void luaOpenAllLibs(lua_State *L);
static void luaOpenSafeLibs(lua_State *L);
static int luaOsExit(lua_State *L);
static int32_t luaOsExitDispatch(void *userData, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int luaTextOnlyLoad(lua_State *L);
static void luaVmHook(lua_State *L, lua_Debug *ar);
@ -189,19 +192,44 @@ static void *luaCountingAlloc(void *ud, void *ptr, size_t osize, size_t nsize) {
}
// Open the standard libraries a calog script may have, INSTEAD of luaL_openlibs.
// Every standard library, for a context with no sandbox: its script is the host's own code, and io,
// os, package, and debug are what a Lua programmer reaches for. One change: os.exit ends the run the
// way the host's calogExit does (calogEngineExit), instead of calling exit() from this context's
// thread underneath every other script and the host's teardown.
static void luaOpenAllLibs(lua_State *L) {
luaL_openlibs(L);
lua_getglobal(L, LUA_OSLIBNAME);
lua_pushcfunction(L, luaOsExit);
lua_setfield(L, -2, "exit");
lua_pop(L, 1);
}
// os.exit([code [, close]]) in a context with no sandbox: see luaOpenAllLibs.
static int luaOsExit(lua_State *L) {
return luaCallDispatch(L, 1, luaOsExitDispatch, luaContextOf(L)->broker, "os.exit", "os.exit failed");
}
static int32_t luaOsExitDispatch(void *userData, CalogValueT *args, int32_t argCount, CalogValueT *result) {
return calogEngineExit((CalogT *)userData, args, argCount, result);
}
// Open the standard libraries a SANDBOXED script may have (calogContextOpenLimited), INSTEAD of
// luaL_openlibs.
//
// calog's contract is that a script reaches the host only through registered natives, which is the
// one place the allow-list, the memory cap and the wall-clock budget can see it. Lua's io/os/package
// A sandboxed script reaches the host only through registered natives, which is the one place the
// allow-list, the memory cap and the wall-clock budget can see it. Lua's io/os/package
// libraries walk straight around all three: io.open reads and writes any file, os.execute and
// io.popen run a shell, os.exit terminates the whole host process mid-run, and package.loadlib
// dlopens an attacker-supplied .so and executes native code inside this process. None of that is
// reachable through calogCall, so no policy calog can express applies to it.
//
// Every capability that is dropped has a native equivalent that IS gated: fs* for files, procRun for
// processes, net*/http* for sockets, calogExit for ending the run, time* for clocks. The three
// things with no equivalent are os.getenv, os.rename and os.tmpname; a host that wants those should
// register a native for them, which is exactly the point -- then they are policy-controlled.
// processes, net*/http* for sockets, calogExit for ending the run, time* for clocks, fsRename for
// os.rename. The two with no equivalent are os.getenv and os.tmpname; a host that wants a sandboxed
// script to have them registers a native, which is exactly the point -- then they are policy-controlled.
//
// debug is dropped as well: debug.getregistry hands out every internal table calog keeps there, and
// debug.sethook would fight the hook the sandbox installs.
@ -291,7 +319,7 @@ static void luaVmHook(lua_State *L, lua_Debug *ar) {
}
int32_t calogLuaCreate(CalogLuaT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
int32_t calogLuaCreate(CalogLuaT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed) {
CalogLuaT *context;
lua_State *L;
@ -308,7 +336,11 @@ int32_t calogLuaCreate(CalogLuaT **out, CalogT *broker, uint64_t ctxId, CalogLim
free(context);
return calogErrOomE;
}
luaOpenSafeLibs(L);
if (sandboxed) {
luaOpenSafeLibs(L);
} else {
luaOpenAllLibs(L);
}
context->L = L;
context->broker = broker;
context->ctxId = ctxId;

2
src/lua/luaAdapter.h
View file

@ -16,7 +16,7 @@
typedef struct CalogLuaT CalogLuaT;
int32_t calogLuaCreate(CalogLuaT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
int32_t calogLuaCreate(CalogLuaT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed);
void calogLuaDestroy(CalogLuaT *context);
int32_t calogLuaExport(CalogLuaT *context, const char *globalName, CalogFnT **out);
int32_t calogLuaExpose(CalogLuaT *context, const char *name);

2
src/lua/luaEngine.c
View file

@ -31,7 +31,7 @@ static int32_t luaEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status;
*interpOut = NULL;
status = calogLuaCreate(&lc, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
status = calogLuaCreate(&lc, calogContextBroker(context), calogContextId(context), calogContextLimitState(context), calogContextSandboxed(context));
if (status != calogOkE) {
return status;
}

25
src/mybasic/mybasicAdapter.c
View file

@ -77,6 +77,8 @@ typedef struct MbAllocHeaderT {
} MbAllocHeaderT;
static _Thread_local CalogLimitStateT *gMbLimits = NULL;
// Whether the context on this thread is sandboxed (an allow-list alone included); set at create.
static _Thread_local bool gMbSealed = false;
// Serializes my-basic context lifecycle (mb_init/mb_dispose + mbContextCount); the engine
// holds it, via calogMyBasicLifecycleLock, around create/destroy. NOT held during execution,
@ -1382,9 +1384,9 @@ static int32_t mbFromValueDepth(CalogMyBasicT *context, void **l, const CalogVal
}
// Sandbox INPUT: never read host stdin (the default inputer, mb_gets, calls fgets(stdin), which would
// block the context thread and read host input). A my-basic INPUT yields an empty line instead, so I/O
// stays on calog natives like every other engine.
// Sandboxed INPUT: never read host stdin (the default inputer, mb_gets, calls fgets(stdin), which would
// block the context thread and read host input). A my-basic INPUT yields an empty line instead, so a
// sandboxed script's I/O stays on calog natives. A context with no sandbox keeps the default.
static int mbInputer(struct mb_interpreter_t *s, const char *prompt, char *buffer, int size) {
(void)s;
(void)prompt;
@ -1770,7 +1772,14 @@ static int32_t mbWrapRoutine(CalogMyBasicT *context, mb_value_t routine, CalogFn
}
int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
// Non-zero when the context on this thread is sandboxed (calogContextOpenLimited): the vendored
// parser refuses IMPORT "path" there (ourBasic.c).
int calogMyBasicSealed(void) {
return gMbSealed;
}
int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed) {
CalogMyBasicT *context;
struct mb_interpreter_t *bas;
@ -1789,6 +1798,7 @@ int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId,
// Charge this context's allocations (mb_open onward) to its limit state. This runs on the context's
// dedicated thread, so the thread-local is exact for this context's whole lifetime.
gMbLimits = limits;
gMbSealed = sandboxed;
bas = NULL;
if (mb_open(&bas) != MB_FUNC_OK || bas == NULL) {
if (mbContextCount == 0) {
@ -1807,8 +1817,11 @@ int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId,
mbContextCount++;
mb_set_userdata(bas, context);
mb_set_printer(bas, mbPrinter);
// Sandbox host stdin: a my-basic INPUT yields an empty line instead of reading it (see mbInputer).
mb_set_inputer(bas, mbInputer);
// Sandboxed, host stdin is out of reach: INPUT yields an empty line instead of reading it (see
// mbInputer). With no sandbox, INPUT reads stdin as my-basic does.
if (sandboxed) {
mb_set_inputer(bas, mbInputer);
}
// A limited context checks its memory and time budgets at every statement boundary. Unlimited
// contexts install nothing, so the step hook adds no per-statement cost to the common case.
// Installed for every context: the hook carries the abort check, which an unlimited context needs

2
src/mybasic/mybasicAdapter.h
View file

@ -21,7 +21,7 @@ typedef struct CalogMyBasicT CalogMyBasicT;
// unlimited context. A limited context installs a per-statement step hook that retires the script when
// it exceeds its memory or time budget; my-basic's global allocator is wrapped to charge per-context
// memory. See mbStepHandler / mbLimitAlloc.
int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
int32_t calogMyBasicCreate(CalogMyBasicT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed);
void calogMyBasicDestroy(CalogMyBasicT *context);
int32_t calogMyBasicExportRoutine(CalogMyBasicT *context, const char *routineName, CalogFnT **out);
int32_t calogMyBasicExpose(CalogMyBasicT *context, const char *name);

2
src/mybasic/mybasicEngine.c
View file

@ -42,7 +42,7 @@ static int32_t mybasicEngineCreate(CalogContextT *context, void **interpOut) {
*interpOut = NULL;
calogMyBasicLifecycleLock();
status = calogMyBasicCreate(&mb, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
status = calogMyBasicCreate(&mb, calogContextBroker(context), calogContextId(context), calogContextLimitState(context), calogContextSandboxed(context));
if (status == calogOkE) {
calogForEach(calogContextBroker(context), mybasicExposeVisitor, mb);
*interpOut = mb;

39
src/s7/s7Adapter.c
View file

@ -48,6 +48,11 @@ struct CalogS7T {
char errorText[CALOG_ERR_MSG_CAP];
};
// Whether the s7 context on THIS thread is sandboxed (calogContextOpenLimited): the vendored s7 asks
// (calogS7Sealed) before every way out of the interpreter. Each context owns its thread, and this is
// set before s7_init, so it is exact for the interpreter's whole life.
static _Thread_local bool gS7Sealed = false;
// Backs a CalogFnT exported from this interpreter: the owning context, the protected
// procedure, and its gc-protect location (dropped on release).
typedef struct S7ExportT {
@ -72,7 +77,7 @@ static s7_pointer s7ResolveUnbound(s7_scheme *sc, s7_pointer args);
static int32_t s7ToValue(CalogS7T *context, s7_pointer obj, CalogValueT *out, int32_t depth);
int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId) {
int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId, bool sandboxed) {
CalogS7T *context;
*out = NULL;
@ -80,6 +85,7 @@ int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId) {
if (context == NULL) {
return calogErrOomE;
}
gS7Sealed = sandboxed;
context->sc = s7_init();
if (context->sc == NULL) {
free(context);
@ -118,6 +124,37 @@ int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId) {
}
// exit and emergency-exit for the vendored s7 (s7.c): with no sandbox, the run ends the way the
// host's calogExit ends it, not with libc exit underneath every other script and the host's
// teardown; sandboxed, they refuse, as everything else that reaches the host does there.
s7_pointer calogS7Exit(s7_scheme *sc, s7_pointer args) {
CalogS7T *context;
CalogValueT *cargs;
CalogValueT result;
int32_t argCount;
int32_t status;
if (gS7Sealed) {
return s7_error(sc, s7_make_symbol(sc, "calog-blocked"), s7_list(sc, 1, s7_make_string(sc, "calog: exit is not available in a sandboxed context")));
}
context = (CalogS7T *)s7_c_pointer(s7_name_to_value(sc, S7_CONTEXT_VAR));
argCount = (int32_t)s7_list_length(sc, args);
status = s7MarshalArgs(context, args, argCount, &cargs);
if (status != calogOkE) {
return s7MarshalError(sc, status, "out of memory marshalling exit's arguments", "failed to marshal exit's argument");
}
calogValueNil(&result);
status = calogEngineExit(context->broker, cargs, argCount, &result);
return s7FinishInvoke(sc, context, cargs, argCount, status, &result, "exit failed");
}
// Non-zero when the context on this thread is sandboxed; see gS7Sealed.
int calogS7Sealed(void) {
return gS7Sealed;
}
static int32_t s7CallableInvoke(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
S7ExportT *export;
CalogS7T *context;

2
src/s7/s7Adapter.h
View file

@ -18,7 +18,7 @@
typedef struct CalogS7T CalogS7T;
int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId);
int32_t calogS7Create(CalogS7T **out, CalogT *broker, uint64_t ctxId, bool sandboxed);
void calogS7Destroy(CalogS7T *context);
int32_t calogS7Export(CalogS7T *context, const char *globalName, CalogFnT **out);
int32_t calogS7Expose(CalogS7T *context, const char *name);

2
src/s7/s7Engine.c
View file

@ -30,7 +30,7 @@ static int32_t s7EngineCreate(CalogContextT *context, void **interpOut) {
int32_t status;
*interpOut = NULL;
status = calogS7Create(&s7, calogContextBroker(context), calogContextId(context));
status = calogS7Create(&s7, calogContextBroker(context), calogContextId(context), calogContextSandboxed(context));
if (status != calogOkE) {
return status;
}

120
src/tcl/tclAdapter.c
View file

@ -37,12 +37,17 @@
// How often the time-limit handler re-arms itself, and so how often a running Tcl script notices
// the runtime abort latch. Also the ceiling on any real budget's re-arm.
#define TCL_ABORT_POLL_MS 100
// Tcl's own puts, kept under this name in a context with no sandbox for the lines that go to a
// channel other than stdout (a file, a socket, stderr); calog's puts writes stdout itself.
#define TCL_CHANNEL_PUTS "::tcl::calogChannelPuts"
#define TCL_PUTS_MAX_ARGS 4 // puts -nonewline channel string
struct CalogTclT {
Tcl_Interp *interp;
CalogT *broker;
uint64_t ctxId;
CalogLimitStateT *limits; // sandbox limits (mem cap + deadline), or NULL if unlimited
bool sandboxed; // any sandbox, an allow-list alone included: Tcl's own I/O is sealed
Tcl_AsyncHandler memAsync; // fired when the allocator notices the memory cap is exceeded
int32_t nextFn; // mints unique "calogFn<N>" command names for function values
};
@ -65,6 +70,9 @@ typedef struct TclScriptT {
Tcl_Obj *prefix;
} TclScriptT;
// What a command marshalled through tclCallWith does with its arguments: name is the command's.
typedef int32_t (*TclDispatchFnT)(CalogTclT *context, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
// Internal-rep type pointers, cached once (they are process-global static ObjTypes in libtcl).
// Tcl_GetObjType returns NULL for "int"/"bytearray" in 9.0, so we mint a sample of each instead.
static pthread_once_t gInitOnce = PTHREAD_ONCE_INIT;
@ -76,6 +84,9 @@ static const Tcl_ObjType *gDictType = NULL;
static void tclArmLimit(Tcl_Interp *ip, uint64_t ms);
static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclCallWith(Tcl_Interp *ip, int objc, Tcl_Obj *const objv[], TclDispatchFnT dispatch);
static int32_t tclExitDispatch(CalogTclT *context, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
static int tclExitCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclForeignCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static void tclForeignDelete(void *cd);
static int32_t tclFromValue(CalogTclT *context, const CalogValueT *value, Tcl_Obj **out, int32_t depth);
@ -83,6 +94,7 @@ static void tclInitOnce(void);
static int32_t tclMakeFnCommand(CalogTclT *context, CalogFnT *fn, Tcl_Obj **out);
static int32_t tclMarshalArgs(CalogTclT *context, int objc, Tcl_Obj *const objv[], int from, CalogValueT **out, int32_t *outCount);
static int tclMemAsync(void *cd, Tcl_Interp *ip, int code);
static int32_t tclNativeDispatch(CalogTclT *context, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result);
static CalogTclT *tclOf(Tcl_Interp *ip);
static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
@ -97,9 +109,11 @@ static int tclUnknownCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const
static int32_t tclWrapCommand(CalogTclT *context, Tcl_Obj *prefix, CalogFnT **out);
// Shut every door out of the interpreter that does not go through a calog native.
// Shut every door out of a SANDBOXED interpreter (calogContextOpenLimited) that does not go through a
// calog native. A context with no sandbox keeps all of Tcl -- its script is the host's own code --
// except that exit ends the run through calogExit (tclExitCmd).
//
// calog's contract is that a script reaches the host only through registered natives, where the
// A sandboxed script reaches the host only through registered natives, where the
// allow-list, the memory cap and the wall-clock budget can see it. Tcl's core carries a complete
// operating-system interface that bypasses all of it: exec and `open |cmd` run a shell, open reads
// and writes any path, socket opens the network, load dlopens an arbitrary .so into this process,
@ -153,7 +167,7 @@ static void tclSealHostAccess(Tcl_Interp *ip) {
}
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits) {
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed) {
CalogTclT *context;
*out = NULL;
@ -167,10 +181,17 @@ int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLim
free(context);
return calogErrOomE;
}
tclSealHostAccess(context->interp);
context->broker = broker;
context->ctxId = ctxId;
context->limits = limits;
if (sandboxed) {
tclSealHostAccess(context->interp);
} else {
Tcl_EvalEx(context->interp, "rename ::puts " TCL_CHANNEL_PUTS, -1, TCL_EVAL_GLOBAL);
Tcl_ResetResult(context->interp);
Tcl_CreateObjCommand(context->interp, "exit", tclExitCmd, NULL, NULL);
}
context->broker = broker;
context->ctxId = ctxId;
context->limits = limits;
context->sandboxed = sandboxed;
// A memory-capped context arms allocator counting on this thread and creates an async handler
// the allocator marks once over budget (fired at the next bytecode async check, every 64
// instructions). A time-limited context uses Tcl's built-in per-interp time limit, checked from
@ -306,6 +327,33 @@ static void tclArmLimit(Tcl_Interp *ip, uint64_t ms) {
// calogCallback command ?arg ...? -- wrap a Tcl command prefix as a calog function value (its name).
// A command whose arguments go to C as calog values: marshal them, hand them to dispatch with the
// command's name, and set the interpreter's result (or error) from what comes back.
static int tclCallWith(Tcl_Interp *ip, int objc, Tcl_Obj *const objv[], TclDispatchFnT dispatch) {
CalogTclT *context;
CalogValueT *args;
CalogValueT result;
int32_t argc;
int32_t index;
int32_t status;
context = tclOf(ip);
args = NULL;
argc = 0;
if (tclMarshalArgs(context, objc, objv, 1, &args, &argc) != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal a native argument", -1));
return TCL_ERROR;
}
calogValueNil(&result);
status = dispatch(context, Tcl_GetString(objv[0]), args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
return tclSetResult(context, ip, status, &result);
}
static int tclCallbackCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
Tcl_Obj *prefix;
@ -410,6 +458,20 @@ static void tclForeignDelete(void *cd) {
}
// exit ?code? in a context with no sandbox: the run ends the way the host's calogExit ends it, not
// with Tcl_Exit underneath every other script and the host's teardown.
static int tclExitCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
(void)cd;
return tclCallWith(ip, objc, objv, tclExitDispatch);
}
static int32_t tclExitDispatch(CalogTclT *context, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result) {
(void)name;
return calogEngineExit(context->broker, args, argCount, result);
}
static int32_t tclFromValue(CalogTclT *context, const CalogValueT *value, Tcl_Obj **out, int32_t depth) {
*out = NULL;
if (depth >= CALOG_MAX_DEPTH) {
@ -564,6 +626,11 @@ static CalogTclT *tclOf(Tcl_Interp *ip) {
}
static int32_t tclNativeDispatch(CalogTclT *context, const char *name, CalogValueT *args, int32_t argCount, CalogValueT *result) {
return calogCall(context->broker, name, args, argCount, result);
}
static int tclPrintCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
int index;
@ -586,10 +653,24 @@ static int tclPutsCmd(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[])
const char *bytes;
(void)cd;
(void)ip;
nonewline = (objc >= 2 && strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0);
first = nonewline ? 2 : 1;
// The string is the last argument; a channel argument (e.g. stdout) before it is ignored.
// A channel other than stdout goes to Tcl's own puts in a context with no sandbox; sandboxed,
// the string is the last argument and a channel argument before it is ignored.
if (objc <= TCL_PUTS_MAX_ARGS && objc - first == 2 && strcmp(Tcl_GetString(objv[first]), "stdout") != 0 && !tclOf(ip)->sandboxed) {
Tcl_Obj *forward[TCL_PUTS_MAX_ARGS];
int index;
int status;
forward[0] = Tcl_NewStringObj(TCL_CHANNEL_PUTS, -1);
Tcl_IncrRefCount(forward[0]);
for (index = 1; index < objc; index++) {
forward[index] = objv[index];
}
status = Tcl_EvalObjv(ip, objc, forward, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(forward[0]);
return status;
}
if (objc > first) {
bytes = Tcl_GetStringFromObj(objv[objc - 1], &len);
fwrite(bytes, 1, (size_t)len, stdout);
@ -816,27 +897,8 @@ static int32_t tclToValue(CalogTclT *context, Tcl_Obj *obj, CalogValueT *out, in
static int tclTrampoline(void *cd, Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]) {
CalogTclT *context;
CalogValueT *args;
CalogValueT result;
int32_t argc;
int32_t index;
int32_t status;
(void)cd;
context = tclOf(ip);
args = NULL;
argc = 0;
if (tclMarshalArgs(context, objc, objv, 1, &args, &argc) != calogOkE) {
Tcl_SetObjResult(ip, Tcl_NewStringObj("failed to marshal a native argument", -1));
return TCL_ERROR;
}
status = calogCall(context->broker, Tcl_GetString(objv[0]), args, argc, &result);
for (index = 0; index < argc; index++) {
calogValueFree(&args[index]);
}
free(args);
return tclSetResult(context, ip, status, &result);
return tclCallWith(ip, objc, objv, tclNativeDispatch);
}

2
src/tcl/tclAdapter.h
View file

@ -22,7 +22,7 @@
typedef struct CalogTclT CalogTclT;
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits);
int32_t calogTclCreate(CalogTclT **out, CalogT *broker, uint64_t ctxId, CalogLimitStateT *limits, bool sandboxed);
void calogTclDestroy(CalogTclT *context);
int32_t calogTclExport(CalogTclT *context, const char *name, CalogFnT **out);
int32_t calogTclExpose(CalogTclT *context, const char *name);

2
src/tcl/tclEngine.c
View file

@ -31,7 +31,7 @@ static int32_t tclEngineCreate(CalogContextT *context, void **interpOut) {
int32_t status;
*interpOut = NULL;
status = calogTclCreate(&tcl, calogContextBroker(context), calogContextId(context), calogContextLimitState(context));
status = calogTclCreate(&tcl, calogContextBroker(context), calogContextId(context), calogContextLimitState(context), calogContextSandboxed(context));
if (status != calogOkE) {
return status;
}

3
tests/runner/whoami.js Normal file
View file

@ -0,0 +1,3 @@
// testRunner: the run's second script, named in full on the command line.
calogPrint("js " + calogScript() + " " + calogArgs().join(","));
kvSet("jsDone", true);

9
tests/runner/whoami.lua Normal file
View file

@ -0,0 +1,9 @@
-- testRunner: calogScript() and calogArgs() in a script the runner launched by an extensionless
-- name, and calogScript() in a task it spawns (which no file started). Ends the run once the task
-- and the run's other script have printed.
calogPrint("lua " .. calogScript() .. " " .. table.concat(calogArgs(), ","))
taskSpawn("lua", "calogPrint('task [' .. calogScript() .. ']')\nkvSet('taskDone', true)")
while not (kvGet("taskDone") and kvGet("jsDone")) do
timeSleep(10)
end
calogExit(0)

2
tests/testLua.c
View file

@ -209,7 +209,7 @@ int main(void) {
calogRegister(broker, "makeList", nativeMakeList, NULL);
calogRegister(broker, "getAdder", nativeGetAdder, NULL);
status = calogLuaCreate(&lua, broker, 1, NULL);
status = calogLuaCreate(&lua, broker, 1, NULL, false);
if (status != calogOkE) {
printf("lua context create failed\n");
return 1;

2
tests/testMyBasic.c
View file

@ -245,7 +245,7 @@ static int32_t runProgram(const char *source) {
calogMyBasicDestroy(basic);
basic = NULL;
}
status = calogMyBasicCreate(&basic, broker, 1, NULL);
status = calogMyBasicCreate(&basic, broker, 1, NULL, false);
if (status != calogOkE) {
return status;
}

168
tests/testNet.c
View file

@ -17,10 +17,13 @@
#define CHECK(cond, msg) checkImpl((cond), (msg), __FILE__, __LINE__)
#define PUMP_LIMIT 8000
#define TCP_PORT 47811
#define UDP_PORT 47812
#define ENET_PORT 47813
#define PUMP_LIMIT 8000
#define TCP_PORT 47811
#define UDP_PORT 47812
#define ENET_PORT 47813
#define SHARED_PORT 47814
#define SHARED_ACCEPTORS 2
#define SHARED_SETTLE_MS 300 // both acceptors back in poll before the client connects
static CalogT *calog = NULL;
static _Atomic bool serverListening = false;
@ -32,20 +35,32 @@ static char clientGot[64] = { 0 };
static _Atomic int32_t clientGotLen = -1;
static int32_t testsRun = 0;
static int32_t testsFailed = 0;
static _Atomic int64_t sharedHandle = 0;
static _Atomic int32_t acceptorsReady = 0;
static _Atomic int32_t acceptedCount = 0;
static _Atomic bool stopAccepting = false;
static void checkImpl(bool condition, const char *message, const char *file, int32_t line);
static void copyReport(CalogValueT *arg, char *dest, _Atomic int32_t *lenOut);
static int32_t nativeAccepted(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeAcceptorReady(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeFinished(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReportClient(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReportServer(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeServerReady(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeShareListener(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeSharedListener(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeStopAccepting(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void onError(uint64_t contextId, const char *message, void *userData);
static void pumpFor(int32_t ms);
static void pumpUntilCount(_Atomic int32_t *counter, int32_t target);
static void pumpUntilFinished(void);
static void pumpUntilListening(void);
static void resetState(void);
static void testEnet(void);
static void testEnetSafety(void);
static void testTcp(void);
static void testTcpSharedListener(void);
static void testUdp(void);
@ -71,6 +86,26 @@ static void copyReport(CalogValueT *arg, char *dest, _Atomic int32_t *lenOut) {
}
static int32_t nativeAccepted(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
atomic_fetch_add(&acceptedCount, 1);
calogValueNil(result);
return calogOkE;
}
static int32_t nativeAcceptorReady(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
atomic_fetch_add(&acceptorsReady, 1);
calogValueNil(result);
return calogOkE;
}
static int32_t nativeFinished(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
@ -113,6 +148,35 @@ static int32_t nativeServerReady(CalogValueT *args, int32_t argCount, CalogValue
}
static int32_t nativeShareListener(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount != 1 || args[0].type != calogIntE) {
return calogFail(result, calogErrArgE, "shareListener expects one handle");
}
atomic_store(&sharedHandle, args[0].as.i);
return calogOkE;
}
static int32_t nativeSharedListener(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
calogValueInt(result, atomic_load(&sharedHandle));
return calogOkE;
}
static int32_t nativeStopAccepting(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)args;
(void)argCount;
(void)userData;
calogValueBool(result, atomic_load(&stopAccepting));
return calogOkE;
}
static void onError(uint64_t contextId, const char *message, void *userData) {
(void)contextId;
(void)userData;
@ -121,6 +185,31 @@ static void onError(uint64_t contextId, const char *message, void *userData) {
}
static void pumpFor(int32_t ms) {
struct timespec ts = { 0, 500000 };
int32_t i;
for (i = 0; i < ms * 2; i++) {
calogPump(calog);
nanosleep(&ts, NULL);
}
}
static void pumpUntilCount(_Atomic int32_t *counter, int32_t target) {
struct timespec ts = { 0, 500000 };
int i;
for (i = 0; i < PUMP_LIMIT; i++) {
calogPump(calog);
if (atomic_load(counter) >= target) {
return;
}
nanosleep(&ts, NULL);
}
}
static void pumpUntilFinished(void) {
struct timespec ts = { 0, 500000 };
int i;
@ -293,6 +382,71 @@ static void testTcp(void) {
}
// Two contexts accept on one listener, each with a timeout so its loop can see the stop flag; one
// client connects. Both wake for it and one takes it: the other must come back from tcpAccept (nil,
// as for a timeout) rather than sleep in accept() until a second connection that never comes, which
// pinned its thread and hung the runtime's shutdown.
static void testTcpSharedListener(void) {
CalogContextT *listener;
CalogContextT *acceptors[SHARED_ACCEPTORS];
CalogContextT *client;
CalogContextT *closer;
char listenScript[256];
char clientScript[256];
int32_t index;
static const char acceptScript[] =
"local l = sharedListener()\n"
"acceptorReady()\n"
"while not stopAccepting() do\n"
" local c = tcpAccept(l, 200)\n"
" if c then\n"
" accepted()\n"
" tcpClose(c)\n"
" end\n"
"end\n"
"finished()";
resetState();
snprintf(listenScript, sizeof(listenScript), "shareListener(tcpListen(%d, { host = '127.0.0.1' }))\nserverReady()", SHARED_PORT);
snprintf(clientScript, sizeof(clientScript), "tcpClose(tcpConnect('127.0.0.1', %d))", SHARED_PORT);
listener = calogContextOpen(calog, &calogLuaEngine);
calogContextEval(listener, listenScript);
pumpUntilListening();
for (index = 0; index < SHARED_ACCEPTORS; index++) {
acceptors[index] = calogContextOpen(calog, &calogLuaEngine);
calogContextEval(acceptors[index], acceptScript);
}
pumpUntilCount(&acceptorsReady, SHARED_ACCEPTORS);
pumpFor(SHARED_SETTLE_MS);
client = calogContextOpen(calog, &calogLuaEngine);
calogContextEval(client, clientScript);
pumpUntilCount(&acceptedCount, 1);
atomic_store(&stopAccepting, true);
pumpUntilCount(&finishedCount, SHARED_ACCEPTORS);
CHECK(atomic_load(&acceptedCount) == 1, "one of the contexts sharing a listener accepted the client");
CHECK(atomic_load(&finishedCount) == SHARED_ACCEPTORS, "the context that lost the accept race came back and saw its stop flag");
CHECK(atomic_load(&errorCount) == 0, "no errors accepting on a shared listener");
// A context still asleep in accept() would never let its close join it: wake it with a client
if (atomic_load(&finishedCount) < SHARED_ACCEPTORS) {
calogContextEval(client, clientScript);
pumpUntilCount(&finishedCount, SHARED_ACCEPTORS);
}
closer = calogContextOpen(calog, &calogLuaEngine);
calogContextEval(closer, "tcpClose(sharedListener())\nfinished()");
pumpUntilCount(&finishedCount, SHARED_ACCEPTORS + 1);
calogContextClose(listener);
for (index = 0; index < SHARED_ACCEPTORS; index++) {
calogContextClose(acceptors[index]);
}
calogContextClose(client);
calogContextClose(closer);
}
static void testUdp(void) {
CalogContextT *server;
CalogContextT *client;
@ -345,12 +499,18 @@ int main(void) {
calogRegister(calog, "reportServer", nativeReportServer, NULL);
calogRegister(calog, "reportClient", nativeReportClient, NULL);
calogRegister(calog, "finished", nativeFinished, NULL);
calogRegister(calog, "shareListener", nativeShareListener, NULL);
calogRegister(calog, "sharedListener", nativeSharedListener, NULL);
calogRegister(calog, "acceptorReady", nativeAcceptorReady, NULL);
calogRegister(calog, "accepted", nativeAccepted, NULL);
calogRegister(calog, "stopAccepting", nativeStopAccepting, NULL);
if (calogNetRegister(calog) != calogOkE) {
printf("calogNetRegister failed\n");
return 1;
}
testTcp();
testTcpSharedListener();
testUdp();
testEnet();
testEnetSafety();

4
tests/testPolyglot.c
View file

@ -42,7 +42,7 @@ static int32_t basicRun(const char *source) {
calogMyBasicDestroy(basic);
basic = NULL;
}
status = calogMyBasicCreate(&basic, broker, BASIC_CTX_ID, NULL);
status = calogMyBasicCreate(&basic, broker, BASIC_CTX_ID, NULL, false);
if (status != calogOkE) {
return status;
}
@ -130,7 +130,7 @@ int main(void) {
calogRegister(broker, "add", nativeAdd, NULL);
calogRegister(broker, "record", nativeRecord, NULL);
status = calogLuaCreate(&lua, broker, LUA_CTX_ID, NULL);
status = calogLuaCreate(&lua, broker, LUA_CTX_ID, NULL, false);
if (status != calogOkE) {
printf("lua context create failed\n");
return 1;

70
tests/testRunner.c Normal file
View file

@ -0,0 +1,70 @@
// testRunner.c -- the bin/calog runner end to end, as a user runs it: calogScript() names each
// script's own file (with the extension the runner found for an extensionless name) and is "" in a
// task, which no file started; calogArgs() hands every script the arguments after "--". The scripts
// are in tests/runner; whoami.lua ends the run once the others have printed.
#define _POSIX_C_SOURCE 200809L
#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <sys/wait.h>
#define CHECK(cond, msg) checkImpl((cond), (msg), __FILE__, __LINE__)
#define OUTPUT_MAX 4096
// timeout(1) bounds a runner that never ends, so a regression fails here instead of hanging make test
#define RUN_COMMAND "timeout 60 ./bin/calog tests/runner/whoami tests/runner/whoami.js -- one two 2>&1"
static int32_t testsRun = 0;
static int32_t testsFailed = 0;
static void checkImpl(bool condition, const char *message, const char *file, int32_t line);
static void testScriptAndArgs(void);
static void checkImpl(bool condition, const char *message, const char *file, int32_t line) {
testsRun++;
if (!condition) {
testsFailed++;
printf("FAIL %s:%d %s\n", file, line, message);
}
}
static void testScriptAndArgs(void) {
char output[OUTPUT_MAX];
size_t length;
FILE *run;
int status;
run = popen(RUN_COMMAND, "r");
CHECK(run != NULL, "the runner starts");
if (run == NULL) {
return;
}
length = fread(output, 1, sizeof(output) - 1, run);
output[length] = '\0';
status = pclose(run);
CHECK(WIFEXITED(status) && WEXITSTATUS(status) == 0, "the run ends with the code calogExit gave it");
CHECK(strstr(output, "lua tests/runner/whoami.lua one,two\n") != NULL, "an extensionless script's calogScript() is the file the runner found, and calogArgs() the arguments after --");
CHECK(strstr(output, "js tests/runner/whoami.js one,two\n") != NULL, "each script of a run has its own calogScript()");
CHECK(strstr(output, "task []\n") != NULL, "calogScript() is empty in a task, which no file started");
if (testsFailed != 0) {
printf("runner output:\n%s", output);
}
}
int main(void) {
testScriptAndArgs();
printf("\n%d checks, %d failed\n", testsRun, testsFailed);
fflush(stdout);
if (testsFailed != 0) {
return 1;
}
return 0;
}

318
tests/testStdlib.c Normal file
View file

@ -0,0 +1,318 @@
// testStdlib.c -- the engines' own standard libraries (design.md sec 34). A context with no sandbox
// has each engine's own file, environment, and module I/O -- Lua's io/os/package, Tcl's open/file/env,
// Janet's spit/slurp/os, Berry's open/os/compile, my-basic's IMPORT "path", s7's ports/load/getenv --
// and its exit ends the run through the host's calogExit instead of libc exit(). A sandboxed context
// (calogContextOpenLimited) finds every one of those ways out refused, Berry's file compile and s7's
// load and system included. JavaScript, Squirrel, mruby, and Wren ship no host bindings, so there is
// nothing of theirs to restore or refuse.
#define _POSIX_C_SOURCE 200809L
#include "calog.h"
#include <stdatomic.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#define CHECK(cond, msg) checkImpl((cond), (msg), __LINE__)
#define PUMP_LIMIT 6000
#define REPORT_MAX 256
#define MESSAGE_MAX (REPORT_MAX * 2) // a check's message, which quotes the report
#define EXIT_CODE 3
#define ENV_NAME "CALOG_STDLIB_TEST"
#define ENV_VALUE "env-ok"
#define EXISTS_FILE "obj/testStdlibExists.txt" // a file a sandboxed probe tries to read
#define MODULE_BAS "obj/testStdlibMod.bas"
#define MODULE_BE "obj/testStdlibMod.be"
#define MODULE_SCM "obj/testStdlibMod.scm"
#define NO_EXIT_TEXT "has no calogExit"
// One engine's three scripts. open runs with no sandbox and reports openWant; exit runs with no
// sandbox, calls the engine's own exit with EXIT_CODE, and must never reach its report("after");
// sealed runs sandboxed and reports sealedWant, or -- sealedWant NULL -- must fail outright (my-basic
// refuses IMPORT "path" while parsing, before anything runs).
typedef struct StdlibCaseT {
const char *name;
const CalogEngineT *engine;
const char *open;
const char *openWant;
const char *exit;
const char *sealed;
const char *sealedWant;
} StdlibCaseT;
static CalogT *calog = NULL;
static char reported[REPORT_MAX];
static _Atomic bool reportedFlag = false;
static _Atomic int32_t errorCount = 0;
static _Atomic int64_t exitCode = -1;
static int32_t testsRun = 0;
static int32_t testsFailed = 0;
static const char *const gSandboxAllow[] = { "report", NULL };
static const StdlibCaseT gCases[] = {
{
"lua", &calogLuaEngine,
"local f = assert(io.open('obj/testStdlib.lua.txt', 'w')) f:write('lua') f:close()\n"
"local g = assert(io.open('obj/testStdlib.lua.txt')) local s = g:read('a') g:close()\n"
"os.remove('obj/testStdlib.lua.txt')\n"
"report(s .. ':' .. os.getenv('" ENV_NAME "'))",
"lua:" ENV_VALUE,
"os.exit(3)\nreport('after')",
"report(tostring(io == nil and os == nil and package == nil and debug == nil and dofile == nil and loadfile == nil))",
"true"
},
{
"tcl", &calogTclEngine,
"set f [open obj/testStdlib.tcl.txt w]; puts -nonewline $f tcl; close $f\n"
"set f [open obj/testStdlib.tcl.txt r]; set s [read $f]; close $f\n"
"file delete obj/testStdlib.tcl.txt\n"
"report \"$s:$::env(" ENV_NAME ")\"",
"tcl:" ENV_VALUE,
"exit 3\nreport after",
"report \"left:[expr {[llength [info commands open]] + [llength [info commands exec]] + [llength [info commands exit]] + [llength [info commands file]] + [info exists ::env]}]\"",
"left:0"
},
{
"janet", &calogJanetEngine,
"(spit \"obj/testStdlib.janet.txt\" \"janet\")\n"
"(def s (slurp \"obj/testStdlib.janet.txt\"))\n"
"(os/rm \"obj/testStdlib.janet.txt\")\n"
"(report (string s \":\" (os/getenv \"" ENV_NAME "\")))",
"janet:" ENV_VALUE,
"(os/exit 3)\n(report \"after\")",
"(report (string (try (do (slurp \"" EXISTS_FILE "\") \"open\") ([e] \"refused\")) \":\" (if (nil? os/exit) \"noexit\" \"exit\")))",
"refused:noexit"
},
{
"berry", &calogBerryEngine,
"import os\n"
"var f = open('obj/testStdlib.be.txt', 'w') f.write('berry') f.close()\n"
"f = open('obj/testStdlib.be.txt') var s = f.read() f.close()\n"
"os.remove('obj/testStdlib.be.txt')\n"
"var m = compile('" MODULE_BE "', 'file')\n"
"report(s + ':' + m())",
"berry:module",
"import os\nos.exit(3)\nreport('after')",
"var r = []\n"
"try import os r.push('os') except .. r.push('noos') end\n"
"try import introspect r.push('introspect') except .. r.push('nointrospect') end\n"
"try open('" EXISTS_FILE "') r.push('open') except .. r.push('noopen') end\n"
"try compile('" MODULE_BE "', 'file') r.push('compile') except .. r.push('nocompile') end\n"
"report(r.concat(':'))",
"noos:nointrospect:noopen:nocompile"
},
{
"my-basic", &calogMyBasicEngine,
"IMPORT \"" MODULE_BAS "\"\nreport(\"basic:\" + modValue())",
"basic:module",
NULL,
"IMPORT \"" MODULE_BAS "\"\nreport(\"imported\")",
NULL
},
{
"s7", &calogS7Engine,
"(begin\n"
" (call-with-output-file \"obj/testStdlib.scm.txt\" (lambda (p) (display \"s7\" p)))\n"
" (define s (call-with-input-file \"obj/testStdlib.scm.txt\" read-line))\n"
" (delete-file \"obj/testStdlib.scm.txt\")\n"
" (load \"" MODULE_SCM "\")\n"
" (report (string-append s \":\" (getenv \"" ENV_NAME "\") \":\" stdlib-module)))",
"s7:" ENV_VALUE ":module",
"(begin (exit 3) (report \"after\"))",
"(begin\n"
" (define (probe thunk) (catch #t thunk (lambda args \"no\")))\n"
" (report (string-append\n"
" (probe (lambda () (getenv \"" ENV_NAME "\") \"getenv\")) \":\"\n"
" (probe (lambda () (open-input-file \"" EXISTS_FILE "\") \"open\")) \":\"\n"
" (probe (lambda () (load \"" MODULE_SCM "\") \"load\")) \":\"\n"
" (probe (lambda () (system \"true\") \"system\")) \":\"\n"
" (probe (lambda () (exit 3) \"exit\")))))",
"no:no:no:no:no"
}
};
static void checkImpl(bool condition, const char *message, int32_t line);
static int32_t nativeExit(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static int32_t nativeReport(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData);
static void onError(uint64_t contextId, const char *message, void *userData);
static void resetFlags(void);
static void runScript(CalogT *runtime, const CalogEngineT *engine, const char *source, bool sandboxed);
static void testCase(const StdlibCaseT *test);
static void testNoExitNative(void);
static void writeText(const char *path, const char *text);
// s7 allocates permanent strings once per process and never frees them (an s7 design
// characteristic, not a calog defect); suppress exactly that allocation site, as testSandbox does.
const char *__lsan_default_suppressions(void);
const char *__lsan_default_suppressions(void) {
return "leak:make_permanent_string\n";
}
static void checkImpl(bool condition, const char *message, int32_t line) {
testsRun++;
if (!condition) {
testsFailed++;
printf("FAIL testStdlib.c:%d %s\n", line, message);
}
}
// The host's CALOG_EXIT_NATIVE, standing in for the runner's: records the code it was handed and
// fails, so the script unwinds as calogExit's would without latching this runtime for good.
static int32_t nativeExit(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount == 1 && args[0].type == calogIntE) {
atomic_store(&exitCode, args[0].as.i);
}
return calogFail(result, calogErrArgE, "test exit");
}
static int32_t nativeReport(CalogValueT *args, int32_t argCount, CalogValueT *result, void *userData) {
(void)userData;
calogValueNil(result);
if (argCount == 1 && args[0].type == calogStringE) {
snprintf(reported, sizeof(reported), "%.*s", (int)args[0].as.s.length, args[0].as.s.bytes);
atomic_store(&reportedFlag, true);
}
return calogOkE;
}
static void onError(uint64_t contextId, const char *message, void *userData) {
(void)contextId;
(void)message;
(void)userData;
atomic_fetch_add(&errorCount, 1);
}
static void resetFlags(void) {
reported[0] = '\0';
atomic_store(&reportedFlag, false);
atomic_store(&errorCount, 0);
atomic_store(&exitCode, -1);
}
// Run a script fire-and-forget and pump until it reports or fails (or a bounded timeout).
static void runScript(CalogT *runtime, const CalogEngineT *engine, const char *source, bool sandboxed) {
CalogLimitsT limits = { 0, 0, gSandboxAllow, 0 };
CalogContextT *ctx;
struct timespec ts = { 0, 500000 };
int32_t i;
resetFlags();
ctx = sandboxed ? calogContextOpenLimited(runtime, engine, &limits) : calogContextOpen(runtime, engine);
if (ctx == NULL) {
checkImpl(false, "context open failed", __LINE__);
return;
}
calogContextEval(ctx, source);
for (i = 0; i < PUMP_LIMIT; i++) {
calogPump(runtime);
if (atomic_load(&reportedFlag) || atomic_load(&errorCount) > 0) {
calogPump(runtime);
break;
}
nanosleep(&ts, NULL);
}
calogContextClose(ctx);
}
static void testCase(const StdlibCaseT *test) {
char message[MESSAGE_MAX];
runScript(calog, test->engine, test->open, false);
snprintf(message, sizeof(message), "%s, no sandbox: its own file and environment I/O works (got \"%s\")", test->name, reported);
CHECK(strcmp(reported, test->openWant) == 0 && atomic_load(&errorCount) == 0, message);
if (test->exit != NULL) {
runScript(calog, test->engine, test->exit, false);
snprintf(message, sizeof(message), "%s, no sandbox: its exit ends the run through calogExit with the code", test->name);
CHECK(atomic_load(&exitCode) == EXIT_CODE && !atomic_load(&reportedFlag), message);
}
runScript(calog, test->engine, test->sealed, true);
if (test->sealedWant != NULL) {
snprintf(message, sizeof(message), "%s, sandboxed: every way out is refused (got \"%s\")", test->name, reported);
CHECK(strcmp(reported, test->sealedWant) == 0, message);
} else {
snprintf(message, sizeof(message), "%s, sandboxed: the script is refused before it runs", test->name);
CHECK(!atomic_load(&reportedFlag) && atomic_load(&errorCount) > 0, message);
}
}
// A host that registered no CALOG_EXIT_NATIVE has no run for a script's exit to end: the call fails
// saying so, and the script can catch it.
static void testNoExitNative(void) {
CalogT *bare;
bare = calogCreate();
calogSetErrorHandler(bare, onError, NULL);
calogRegister(bare, "report", nativeReport, NULL);
runScript(bare, &calogLuaEngine, "local ok, e = pcall(os.exit, 3)\nreport(tostring(e))", false);
CHECK(strstr(reported, NO_EXIT_TEXT) != NULL, "with no calogExit registered, os.exit fails saying so");
calogDestroy(bare);
}
static void writeText(const char *path, const char *text) {
FILE *fp;
fp = fopen(path, "wb");
if (fp == NULL) {
checkImpl(false, "could not write a test fixture", __LINE__);
return;
}
fputs(text, fp);
fclose(fp);
}
int main(void) {
size_t index;
setenv(ENV_NAME, ENV_VALUE, 1);
writeText(EXISTS_FILE, "exists\n");
writeText(MODULE_BAS, "DEF modValue()\n RETURN \"module\"\nENDDEF\n");
writeText(MODULE_BE, "return 'module'\n");
writeText(MODULE_SCM, "(define stdlib-module \"module\")\n");
calog = calogCreate();
if (calog == NULL) {
printf("calog create failed\n");
return 1;
}
calogSetErrorHandler(calog, onError, NULL);
calogRegister(calog, "report", nativeReport, NULL);
calogRegisterInline(calog, CALOG_EXIT_NATIVE, nativeExit, NULL);
for (index = 0; index < sizeof(gCases) / sizeof(gCases[0]); index++) {
testCase(&gCases[index]);
}
calogDestroy(calog);
testNoExitNative();
remove(EXISTS_FILE);
remove(MODULE_BAS);
remove(MODULE_BE);
remove(MODULE_SCM);
printf("\n%d checks, %d failed\n", testsRun, testsFailed);
fflush(stdout);
if (testsFailed != 0) {
return 1;
}
return 0;
}

22
vendor/berry/berry_conf.h vendored
View file

@ -149,21 +149,21 @@
* otherwise disable the feature.
* Default: 1
**/
#define BE_USE_BYTECODE_SAVER 0 /* --- calog patch: no writing .bec to disk --- */
#define BE_USE_BYTECODE_SAVER 1
/* Macro: BE_USE_BYTECODE_LOADER
* Enable load bytecode from file when BE_USE_BYTECODE_LOADER is not 0,
* otherwise disable the feature.
* Default: 1
**/
#define BE_USE_BYTECODE_LOADER 0 /* --- calog patch: unverified bytecode is a VM escape --- */
#define BE_USE_BYTECODE_LOADER 1
/* Macro: BE_USE_SHARED_LIB
* Enable shared library when BE_USE_SHARED_LIB is not 0,
* otherwise disable the feature.
* Default: 1
**/
#define BE_USE_SHARED_LIB 0 /* --- calog patch: no dlopen of attacker .so --- */
#define BE_USE_SHARED_LIB 1
/* Macro: BE_USE_OVERLOAD_HASH
* Allows instances to overload hash methods for use in the
@ -213,13 +213,13 @@
#define BE_USE_JSON_MODULE 1
#define BE_USE_MATH_MODULE 1
#define BE_USE_TIME_MODULE 1
#define BE_USE_OS_MODULE 0 /* --- calog patch: os.system/os.exit/chdir bypass every calog policy --- */
#define BE_USE_OS_MODULE 1
#define BE_USE_GLOBAL_MODULE 1
#define BE_USE_SYS_MODULE 1
#define BE_USE_DEBUG_MODULE 1
#define BE_USE_GC_MODULE 1
#define BE_USE_SOLIDIFY_MODULE 1
#define BE_USE_INTROSPECT_MODULE 0 /* --- calog patch: introspect.fromptr forges object pointers --- */
#define BE_USE_INTROSPECT_MODULE 1
#define BE_USE_STRICT_MODULE 1
/* Macro: BE_EXPLICIT_XXX
@ -240,4 +240,16 @@
**/
#define be_assert(expr) assert(expr)
/* --- calog patch: the two hooks calog's Berry adapter (src/berry/berryAdapter.c) defines.
* calogBerrySealed is non-zero when the context on this thread is sandboxed
* (calogContextOpenLimited): open, the os and introspect modules, script and bytecode files, and
* shared libraries all refuse there, because a sandboxed script reaches the host only through calog
* natives, where the allow-list, the memory cap and the wall-clock budget can see it. A context with
* no sandbox has all of Berry. calogBerryExit is os.exit: it ends the run the way calog's calogExit
* does, not with exit() underneath every other script and the host's teardown. --- */
struct bvm;
extern int calogBerrySealed(void);
extern int calogBerryExit(struct bvm *vm);
/* --- end calog patch --- */
#endif

9
vendor/berry/src/be_exec.c vendored
View file

@ -266,7 +266,14 @@ static int load_bytecode(bvm *vm, const char *name)
BERRY_API int be_loadmode(bvm *vm, const char *name, bbool islocal)
{
int res = load_bytecode(vm, name);
int res;
/* --- calog patch: a sandboxed context (calogBerrySealed, berry_conf.h) loads no script or
* bytecode file -- not through import, not through compile(path, "file"). --- */
if (calogBerrySealed()) {
be_pushfstring(vm, "calog: loading '%s' is not available in a sandboxed context", name);
return BE_IO_ERROR;
}
res = load_bytecode(vm, name);
#if BE_USE_SCRIPT_COMPILER
if (res && res != BE_IO_ERROR && res != BE_EXCEPTION) {
res = fileparser(vm, name, islocal);

11
vendor/berry/src/be_filelib.c vendored
View file

@ -239,12 +239,11 @@ int be_nfunc_open(bvm *vm)
#endif
{ NULL, NULL }
};
/* --- calog patch: a script reaches the host only through calog natives, where the allow-list,
* the memory cap and the wall-clock budget can see it. open() is direct filesystem read/write
* around all three; calog's fs* natives are the gated equivalent. The function itself stays --
* it is named by the precompiled builtin table, which would otherwise need regenerating -- and
* simply refuses. be_raise does not return. --- */
be_raise(vm, "io_error", "calog: file access is not available to scripts; use the fs* natives");
/* --- calog patch: refused in a sandboxed context (calogBerrySealed, berry_conf.h); calog's fs*
* natives are the gated equivalent there. be_raise does not return. --- */
if (calogBerrySealed()) {
be_raise(vm, "io_error", "calog: file access is not available in a sandboxed context; use the fs* natives");
}
fname = argc >= 1 && be_isstring(vm, 1) ? be_tostring(vm, 1) : NULL;
mode = argc >= 2 && be_isstring(vm, 2) ? be_tostring(vm, 2) : "r";
if (fname) {

12
vendor/berry/src/be_module.c vendored
View file

@ -44,6 +44,11 @@ static const bntvmodule_t* find_native(bstring *path)
{
const bntvmodule_t *module;
const bntvmodule_t* const *node = be_module_table;
/* --- calog patch: a sandboxed context (calogBerrySealed, berry_conf.h) has no os (system, exit,
* the filesystem) and no introspect (fromptr forges object pointers). --- */
if (calogBerrySealed() && (!strcmp(str(path), "os") || !strcmp(str(path), "introspect"))) {
return NULL;
}
for (; (module = *node) != NULL; ++node) {
if (!strcmp(module->name, str(path))) {
return module;
@ -168,7 +173,12 @@ static int open_script(bvm *vm, char *path)
#if BE_USE_SHARED_LIB
static int open_dllib(bvm *vm, char *path)
{
int res = be_loadlib(vm, path);
int res;
/* --- calog patch: no shared library into a sandboxed context (calogBerrySealed, berry_conf.h) --- */
if (calogBerrySealed()) {
return BE_IO_ERROR;
}
res = be_loadlib(vm, path);
if (res == BE_OK)
be_call(vm, 0);
return res;

15
vendor/berry/src/be_oslib.c vendored
View file

@ -107,18 +107,9 @@ static int m_system(bvm *vm)
static int m_exit(bvm *vm)
{
int status = 0;
if (be_top(vm)) {
if (be_isint(vm, 1)) {
status = be_toindex(vm, 1); /* get the exit code */
} else if (be_isbool(vm, 1)) {
status = be_tobool(vm, 1) - 1; /* true: 0, false: -1 */
} else {
status = -1;
}
}
be_exit(vm, status);
be_return_nil(vm);
/* --- calog patch: end the run through calog (calogBerryExit, berry_conf.h) rather than
* be_exit, which calls exit() underneath every other script and the host's teardown. --- */
return calogBerryExit(vm);
}
static int m_path_isdir(bvm *vm)

19
vendor/ourbasic/ourBasic.c vendored
View file

@ -1334,6 +1334,10 @@ static void _resize_dynamic_buffer(_dynamic_buffer_t* buf, size_t es, size_t c);
* every += / -= / read below is then an atomic op. Lets calog run my-basic contexts in
* parallel with only lifecycle (mb_init/mb_dispose) serialized. */
static _Atomic size_t _mb_allocated = 0;
/* [calog fork] Non-zero when the context on this thread is sandboxed (calogContextOpenLimited);
* defined by calog's my-basic adapter (src/mybasic/mybasicAdapter.c). IMPORT "path" asks it. */
extern int calogMyBasicSealed(void);
#else /* MB_ENABLE_ALLOC_STAT */
static const size_t _mb_allocated = (size_t)(~0);
#endif /* MB_ENABLE_ALLOC_STAT */
@ -5651,14 +5655,15 @@ static _data_e _get_symbol_type(mb_interpreter_t* s, char* sym, _raw_t* value) {
#endif /* MB_ENABLE_MODULE */
}
/* Import another file */
/* [calog fork] A script reaches the host only through calog natives, where the
* allow-list, the memory cap and the wall-clock budget can see it. IMPORT "path"
* reads an arbitrary file off disk and executes it as BASIC -- filesystem access and
* arbitrary code execution in one, around all three. Module imports (IMPORT "@name",
* handled above) are in-memory and stay. Scripts compose through taskLoad/calogExport. */
_handle_error_now(s, SE_PS_FAILED_TO_OPEN_FILE, s->source_file, MB_FUNC_ERR);
/* [calog fork] Refused in a sandboxed context (calogMyBasicSealed), where a script reaches
* the host only through calog natives: IMPORT "path" reads a file off disk and executes it
* as BASIC, around the allow-list, the memory cap and the wall-clock budget. Module imports
* (IMPORT "@name", handled above) are in-memory and stay. */
if(calogMyBasicSealed()) {
_handle_error_now(s, SE_PS_FAILED_TO_OPEN_FILE, s->source_file, MB_FUNC_ERR);
goto _end_import;
goto _end_import;
}
buf = _load_file(s, sym + 1, ":", true);
if(buf) {
if(buf == sym + 1) {

75
vendor/s7/s7.c vendored
View file

@ -1579,6 +1579,21 @@ struct s7_scheme {
static no_return void error_nr(s7_scheme *sc, s7_pointer type, s7_pointer info);
static s7_pointer wrap_string(s7_scheme *sc, const char *str, s7_int len);
/* --- calog patch: the hooks calog's s7 adapter (src/s7/s7Adapter.c) defines. calogS7Sealed is
* non-zero when the context on this thread is sandboxed (calogContextOpenLimited): every way out
* of the interpreter -- the file ports, loading a file or shared object (load, require, autoload),
* the environment, and the system extras -- refuses there, because a sandboxed script reaches the
* host only through calog natives, where the allow-list, the memory cap, and the wall-clock budget
* can see it. s7 has no adapter-side rebinding that survives unlet/#_, so the checks are here, at
* the C functions. A context with no sandbox has all of s7. calogS7Exit is exit and emergency-exit:
* the run ends the way calog's calogExit ends it, not with libc exit underneath every other script
* and the host's teardown. --- */
extern int calogS7Sealed(void);
extern s7_pointer calogS7Exit(s7_scheme *sc, s7_pointer args);
#define calog_refuse_if_sealed(sc, what) \
do {if (calogS7Sealed()) error_nr(sc, s7_make_symbol(sc, "calog-blocked"), s7_list(sc, 1, s7_make_string(sc, "calog: " what " is not available in a sandboxed context")));} while (0)
/* --- end calog patch --- */
static s7_pointer set_elist_1(s7_scheme *sc, s7_pointer x1);
@ -30980,10 +30995,9 @@ static block_t *expand_filename(s7_scheme *sc, const char *name)
static s7_pointer open_input_file_1(s7_scheme *sc, const char *name, const char *mode, const char *caller)
{
FILE *fp;
/* --- calog patch: a script reaches the host only through calog natives, where the
* allow-list / memory cap / wall-clock budget can see it. s7 has no build switch and no
* adapter-side rebinding that survives unlet/#_, so the capability is removed here. --- */
file_error_nr(sc, caller, "calog: reading files is not available to scripts; use the fs* natives:", name);
/* --- calog patch: no file reading in a sandboxed context (calogS7Sealed) --- */
if (calogS7Sealed())
file_error_nr(sc, caller, "calog: reading files is not available in a sandboxed context; use the fs* natives:", name);
#if WITH_GCC
block_t *b;
@ -31127,10 +31141,9 @@ static const port_functions_t output_file_functions =
s7_pointer s7_open_output_file(s7_scheme *sc, const char *name, const char *mode)
{
FILE *fp;
/* --- calog patch: a script reaches the host only through calog natives, where the
* allow-list / memory cap / wall-clock budget can see it. s7 has no build switch and no
* adapter-side rebinding that survives unlet/#_, so the capability is removed here. --- */
file_error_nr(sc, "open-output-file", "calog: writing files is not available to scripts; use the fs* natives:", name);
/* --- calog patch: no file writing in a sandboxed context (calogS7Sealed) --- */
if (calogS7Sealed())
file_error_nr(sc, "open-output-file", "calog: writing files is not available in a sandboxed context; use the fs* natives:", name);
s7_pointer port;
block_t *block, *b;
@ -32252,6 +32265,8 @@ static block_t *full_filename(s7_scheme *sc, const char *filename)
static s7_pointer load_shared_object(s7_scheme *sc, const char *fname, s7_pointer let)
{
/* if fname ends in .so|.dylib, try loading it as a C shared object: (load "/home/bil/cl/m_j0.so" (inlet 'init_func 'init_m_j0)) */
/* --- calog patch: every load tries this first, before load_file_1 --- */
calog_refuse_if_sealed(sc, "loading a file");
const s7_int fname_len = safe_strlen(fname);
if (((fname_len > 3) &&
(local_strcmp((const char *)(fname + (fname_len - 3)), ".so"))) || /* linux */
@ -32352,7 +32367,10 @@ static s7_pointer load_shared_object(s7_scheme *sc, const char *fname, s7_pointe
static s7_pointer load_file_1(s7_scheme *sc, const char *filename)
{
char *local_file_name = NULL;
FILE* fp = fopen(filename, "r");
FILE* fp;
/* --- calog patch: load, require, and autoload all read their file here --- */
calog_refuse_if_sealed(sc, "loading a file");
fp = fopen(filename, "r");
#if WITH_GCC
if (!fp) /* catch one special case, "~/..." since it causes 99.9% of the "can't load ..." errors */
{
@ -32481,11 +32499,6 @@ static s7_pointer g_load(s7_scheme *sc, s7_pointer args)
#define H_load "(load file (let (rootlet))) loads the scheme file 'file'. The 'let' argument \
defaults to the rootlet. To load into the current environment instead, pass (curlet)."
#define Q_load s7_make_signature(sc, 3, sc->values_symbol, sc->is_string_symbol, has_let_signature(sc))
/* --- calog patch: load reads and evaluates an arbitrary path, which is filesystem access and
* arbitrary code execution in one. Scripts compose through taskLoad/calogExport instead. --- */
return(s7_error(sc, s7_make_symbol(sc, "calog-blocked"),
s7_list(sc, 1, s7_make_string(sc, "calog: load is not available to scripts; use fs* + taskLoad"))));
const s7_pointer name = car(args);
const char *fname;
@ -38856,6 +38869,7 @@ static s7_pointer format_chooser(s7_scheme *sc, s7_pointer func, int32_t args, s
/* -------------------------------- directory? -------------------------------- */
static bool is_directory_b_7p(s7_scheme *sc, s7_pointer p)
{
calog_refuse_if_sealed(sc, "directory?"); /* --- calog patch --- */
if (!is_string(p))
return(sole_arg_method_or_bust(sc, p, sc->is_directory_symbol, set_mlist_1(sc, p), sc->type_names[T_STRING]));
if (string_length(p) >= 2)
@ -38892,6 +38906,7 @@ static bool file_probe(const char *arg)
static bool file_exists_b_7p(s7_scheme *sc, s7_pointer filename)
{
calog_refuse_if_sealed(sc, "file-exists?"); /* --- calog patch --- */
if (!is_string(filename))
return(sole_arg_method_or_bust(sc, filename, sc->file_exists_symbol, set_mlist_1(sc, filename), sc->type_names[T_STRING]));
if (string_length(filename) >= 2)
@ -38918,6 +38933,7 @@ static s7_pointer g_delete_file(s7_scheme *sc, s7_pointer args)
{
#define H_delete_file "(delete-file filename) deletes the file filename."
#define Q_delete_file s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
calog_refuse_if_sealed(sc, "delete-file"); /* --- calog patch --- */
const s7_pointer name = car(args);
if (!is_string(name))
@ -38947,6 +38963,7 @@ static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
#define H_system "(system command return-string) executes the command. If the optional second argument is #t, \
system captures the output as a string and returns it."
#define Q_system s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol), sc->is_string_symbol, sc->is_boolean_symbol)
calog_refuse_if_sealed(sc, "system"); /* --- calog patch --- */
#ifdef __EMSCRIPTEN__
return s7_nil(sc);
@ -39017,6 +39034,7 @@ static s7_pointer g_directory_to_list(s7_scheme *sc, s7_pointer args)
{
#define H_directory_to_list "(directory->list directory) returns the contents of the directory as a list of strings (filenames)."
#define Q_directory_to_list s7_make_signature(sc, 2, sc->is_list_symbol, sc->is_string_symbol) /* can return nil */
calog_refuse_if_sealed(sc, "directory->list"); /* --- calog patch --- */
const s7_pointer name = car(args);
if (!is_string(name))
@ -39038,6 +39056,7 @@ static s7_pointer g_file_mtime(s7_scheme *sc, s7_pointer args)
{
#define H_file_mtime "(file-mtime file): return the write date of file"
#define Q_file_mtime s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol)
calog_refuse_if_sealed(sc, "file-mtime"); /* --- calog patch --- */
struct stat statbuf;
int32_t err;
@ -39071,6 +39090,7 @@ static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) /* r7rs says #f if no
{
#define H_getenv "(getenv var) returns the value of a let variable, or #f if none is found"
#define Q_getenv s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_string_symbol, sc->not_symbol), sc->is_string_symbol)
calog_refuse_if_sealed(sc, "getenv"); /* --- calog patch --- */
char *result;
s7_pointer name = car(args);
if (!is_string(name))
@ -39085,6 +39105,7 @@ static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args) /* r7rs says #f if no
extern char **environ;
static s7_pointer g_getenvs(s7_scheme *sc, s7_pointer unused_args)
{
calog_refuse_if_sealed(sc, "getenvs"); /* --- calog patch --- */
s7_pointer p = sc->nil;
for (int32_t i = 0; environ[i]; i++)
{
@ -39133,6 +39154,7 @@ static s7_pointer g_time(s7_scheme *sc, s7_pointer args)
static s7_pointer g_uname(s7_scheme *sc, s7_pointer unused_args)
{
calog_refuse_if_sealed(sc, "uname"); /* --- calog patch --- */
struct utsname buf;
uname(&buf);
return(s7_list(sc, 5, s7_make_string(sc, buf.sysname),
@ -39151,6 +39173,7 @@ static s7_pointer g_uname(s7_scheme *sc, s7_pointer args)
/* -------------------------------- unlink -------------------------------- */
static s7_pointer g_unlink(s7_scheme *sc, s7_pointer args)
{
calog_refuse_if_sealed(sc, "unlink"); /* --- calog patch --- */
s7_pointer arg = car(args);
if (!s7_is_string(arg))
sole_arg_wrong_type_error_nr(sc, sc->unlink_symbol, arg, sc->type_names[T_STRING]);
@ -39160,6 +39183,7 @@ static s7_pointer g_unlink(s7_scheme *sc, s7_pointer args)
/* -------------------------------- access -------------------------------- */
static s7_pointer g_access(s7_scheme *sc, s7_pointer args)
{
calog_refuse_if_sealed(sc, "access"); /* --- calog patch --- */
s7_pointer path = car(args), mode = cadr(args);
if (!s7_is_string(path))
wrong_type_error_nr(sc, sc->access_symbol, 1, path, sc->type_names[T_STRING]);
@ -57043,11 +57067,9 @@ static s7_pointer g_emergency_exit(s7_scheme *sc, s7_pointer args)
{
#define H_emergency_exit "(emergency-exit (obj #t)) exits s7 immediately. 'obj', the value passed to libc's _exit, can be an integer or #t=success (0) or #f=fail (1)."
#define Q_emergency_exit s7_make_signature(sc, 2, sc->T, sc->T)
/* --- calog patch: a script reaches the host only through calog natives. Ending the run is
* calogExit, which latches the abort and lets the host tear down in order; libc exit here
* would kill the process mid-run, stranding every other script. --- */
return(s7_error(sc, s7_make_symbol(sc, "calog-blocked"),
s7_list(sc, 1, s7_make_string(sc, "calog: emergency-exit is not available to scripts; use calogExit"))));
/* --- calog patch: end the run through calog (calogS7Exit), not with _exit underneath every
* other script and the host's teardown --- */
return(calogS7Exit(sc, args));
s7_pointer obj;
if (is_null(args)) _exit(EXIT_SUCCESS); /* r7rs spec says use _exit here (it does not call any functions registered with atexit or on_exit) */
@ -57076,11 +57098,9 @@ static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
#define H_exit "(exit obj cobj) exits s7. 'obj', the value passed to libc's exit, can be an integer or #t=success (0) or #f=fail (1). \
'cobj' is a boolean (defaults to #f), #t causes exit to call all active c-object gc_free functions."
#define Q_exit s7_make_signature(sc, 3, sc->T, sc->T, sc->is_boolean_symbol)
/* --- calog patch: a script reaches the host only through calog natives. Ending the run is
* calogExit, which latches the abort and lets the host tear down in order; libc exit here
* would kill the process mid-run, stranding every other script. --- */
return(s7_error(sc, s7_make_symbol(sc, "calog-blocked"),
s7_list(sc, 1, s7_make_string(sc, "calog: exit is not available to scripts; use calogExit"))));
/* --- calog patch: end the run through calog (calogS7Exit), not with exit underneath every
* other script and the host's teardown --- */
return(calogS7Exit(sc, args));
/* calling s7_eval_c_string in an atexit function seems to be problematic -- it works, but args can be changed? */
/* r7rs.pdf says exit checks the stack for dynamic-winds and runs the "after" functions, if any,
@ -57127,11 +57147,10 @@ static s7_pointer g_exit(s7_scheme *sc, s7_pointer args)
#if WITH_GCC
static s7_pointer g_abort(s7_scheme *unused_sc, s7_pointer unused_args)
{
/* --- calog patch: a script reaches the host only through calog natives, where the
* allow-list / memory cap / wall-clock budget can see it. s7 has no build switch and no
* adapter-side rebinding that survives unlet/#_, so the capability is removed here. --- */
/* --- calog patch: libc abort() would kill the host process outright, around calog's teardown, in
* any context; calogExit ends a run --- */
return(s7_error(unused_sc, s7_make_symbol(unused_sc, "calog-blocked"),
s7_list(unused_sc, 1, s7_make_string(unused_sc, "calog: abort is not available to scripts"))));
s7_list(unused_sc, 1, s7_make_string(unused_sc, "calog: abort is not available to scripts; use calogExit"))));
}
#endif