calog/tests/testStdlib.c
2026-10-15 17:45:12 -05:00

318 lines
12 KiB
C

// 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;
}