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