Add Landlock sandbox library with real kernel enforcement

ober

95129e64758f6cb049071ab3fd30dbb912ffa9c0

diff --git a/lib/std/os/landlock.sls b/lib/std/os/landlock.sls
new file mode 100644
index 0000000..de6ea50
--- /dev/null
+++ b/lib/std/os/landlock.sls
@@ -0,0 +1,96 @@
+#!chezscheme
+;;; (std os landlock) — Linux Landlock filesystem sandboxing
+;;;
+;;; Kernel-enforced filesystem access restrictions via Linux Landlock LSM.
+;;; Once applied, restrictions are PERMANENT and IRREVERSIBLE for the
+;;; process and all its children. This is real enforcement, not advisory.
+;;;
+;;; Requires: Linux 5.13+ with CONFIG_SECURITY_LANDLOCK=y
+;;;           support/landlock-shim.c compiled and linked (or loaded)
+;;;
+;;; For static binaries: register symbols via Sforeign_symbol():
+;;;   Sforeign_symbol("jerboa_landlock_abi_version", (void*)jerboa_landlock_abi_version);
+;;;   Sforeign_symbol("jerboa_landlock_sandbox", (void*)jerboa_landlock_sandbox);
+;;;
+;;; For dynamic binaries: compile and load the shared library:
+;;;   gcc -shared -fPIC -O2 -o libjerboa-landlock.so support/landlock-shim.c
+;;;   Then (load-shared-object "./libjerboa-landlock.so") before importing.
+
+(library (std os landlock)
+  (export
+    landlock-available?
+    landlock-abi-version
+    landlock-enforce!
+
+    ;; Condition type for enforcement failures
+    &landlock-error make-landlock-error landlock-error?
+    landlock-error-reason)
+
+  (import (chezscheme))
+
+  ;; ========== Condition Type ==========
+
+  (define-condition-type &landlock-error &error
+    make-landlock-error landlock-error?
+    (reason landlock-error-reason))
+
+  ;; ========== FFI Bindings ==========
+  ;; These call into support/landlock-shim.c
+
+  (define c-landlock-abi-version
+    (foreign-procedure "jerboa_landlock_abi_version" () int))
+
+  (define c-landlock-sandbox
+    (foreign-procedure "jerboa_landlock_sandbox"
+      (string string string) int))
+
+  ;; ========== Public API ==========
+
+  ;; Check if Landlock is supported by the running kernel.
+  (define (landlock-available?)
+    (>= (c-landlock-abi-version) 1))
+
+  ;; Return the Landlock ABI version (1-6+), or -1 if unsupported.
+  (define (landlock-abi-version)
+    (c-landlock-abi-version))
+
+  ;; Apply Landlock restrictions to the current process.
+  ;;
+  ;; read-paths:  list of paths to allow read-only access
+  ;; write-paths: list of paths to allow read+write access
+  ;; exec-paths:  list of paths to allow execute access
+  ;;
+  ;; System paths (/usr, /lib, /bin, /etc, /proc, /dev) are always
+  ;; allowed for read so that exec and basic operations work.
+  ;;
+  ;; Returns #t on success.
+  ;; Raises &landlock-error on failure.
+  ;; Returns 'unsupported if kernel doesn't support Landlock.
+  ;;
+  ;; WARNING: This is PERMANENT. Once called, the process can NEVER
+  ;; regain access to restricted paths. There is no undo.
+  (define (landlock-enforce! read-paths write-paths exec-paths)
+    (let ((packed-read  (pack-paths read-paths))
+          (packed-write (pack-paths write-paths))
+          (packed-exec  (pack-paths exec-paths)))
+      (let ((ret (c-landlock-sandbox packed-read packed-write packed-exec)))
+        (cond
+          ((= ret 0) #t)
+          ((= ret 1) 'unsupported)
+          (else
+           (raise (condition
+                    (make-landlock-error "Landlock enforcement failed")
+                    (make-message-condition
+                      "Failed to apply Landlock restrictions"))))))))
+
+  ;; ========== Internal Helpers ==========
+
+  ;; Pack a list of path strings with SOH (\x01) separator for C FFI.
+  (define (pack-paths lst)
+    (if (or (not lst) (null? lst)) ""
+      (let loop ((rest (cdr lst)) (acc (car lst)))
+        (if (null? rest) acc
+          (loop (cdr rest)
+                (string-append acc (string #\x1) (car rest)))))))
+
+  ) ;; end library
diff --git a/lib/std/os/sandbox.sls b/lib/std/os/sandbox.sls
new file mode 100644
index 0000000..8ebfc61
--- /dev/null
+++ b/lib/std/os/sandbox.sls
@@ -0,0 +1,115 @@
+#!chezscheme
+;;; (std os sandbox) — Fork-and-sandbox execution
+;;;
+;;; Forks the current process, applies Landlock restrictions in the child,
+;;; runs a thunk, then exits. The parent process is NEVER affected.
+;;;
+;;; This is the high-level API for sandboxed execution. It combines:
+;;; - fork(2) to isolate the sandbox from the parent
+;;; - Landlock to enforce filesystem restrictions in the child
+;;; - waitpid(2) to collect the child's exit status
+;;;
+;;; Usage:
+;;;   (sandbox-run
+;;;     '("/tmp" "/var/data")   ; read-only paths
+;;;     '("/tmp/output")        ; read+write paths
+;;;     '()                     ; execute paths
+;;;     (lambda () (system "ls /tmp")))
+;;;   => exit status (0 on success)
+;;;
+;;; The thunk runs in a forked child with Landlock applied.
+;;; Any attempt to access paths outside the allowed set gets
+;;; EACCES from the kernel.
+
+(library (std os sandbox)
+  (export
+    sandbox-run
+    sandbox-run/command
+    sandbox-available?)
+
+  (import (chezscheme)
+          (std os landlock))
+
+  ;; ========== FFI ==========
+
+  (define c-fork (foreign-procedure "fork" () int))
+  (define c-waitpid (foreign-procedure "waitpid" (int void* int) int))
+  (define c-exit (foreign-procedure "_exit" (int) void))
+
+  ;; ========== Public API ==========
+
+  ;; Check if sandboxing is available on this system.
+  (define (sandbox-available?)
+    (landlock-available?))
+
+  ;; Fork, apply Landlock in child, run thunk, return exit status.
+  ;;
+  ;; read-paths:  list of paths for read-only access
+  ;; write-paths: list of paths for read+write access
+  ;; exec-paths:  list of paths for execute access
+  ;; thunk:       procedure to run in the sandboxed child
+  ;;
+  ;; Returns the child's exit status (0-255).
+  ;; The parent process is NEVER affected by the sandbox.
+  (define (sandbox-run read-paths write-paths exec-paths thunk)
+    (let ((pid (c-fork)))
+      (cond
+        ((< pid 0)
+         (error 'sandbox-run "fork failed"))
+
+        ((= pid 0)
+         ;; === CHILD PROCESS ===
+         ;; Apply Landlock — PERMANENT and IRREVERSIBLE in this process
+         (let ((ret (landlock-enforce! read-paths write-paths exec-paths)))
+           (when (condition? ret)
+             (display "sandbox: Landlock enforcement failed\n"
+                      (current-error-port))
+             (c-exit 126))
+           (when (eq? ret 'unsupported)
+             (display "sandbox: Landlock not supported by kernel, "
+                      (current-error-port))
+             (display "running without enforcement\n"
+                      (current-error-port))))
+         ;; Run the thunk in the sandboxed child
+         (guard (e [#t
+                   (display "sandbox: " (current-error-port))
+                   (display-condition e (current-error-port))
+                   (newline (current-error-port))
+                   (c-exit 1)])
+           (thunk))
+         (c-exit 0))
+
+        (else
+         ;; === PARENT PROCESS ===
+         (wait-for-child pid)))))
+
+  ;; Convenience: run a shell command string in a sandbox.
+  ;; Equivalent to: sandbox-run ... (lambda () (system cmd))
+  (define (sandbox-run/command read-paths write-paths exec-paths cmd)
+    (sandbox-run read-paths write-paths exec-paths
+      (lambda () (system cmd))))
+
+  ;; ========== Internal ==========
+
+  ;; Wait for child and decode exit status.
+  (define (wait-for-child pid)
+    (let ((status-buf (foreign-alloc 4)))
+      (let loop ()
+        (let ((result (c-waitpid pid status-buf 0)))
+          (cond
+            ((> result 0)
+             (let ((raw (foreign-ref 'int status-buf 0)))
+               (foreign-free status-buf)
+               ;; Decode: WIFEXITED -> (status >> 8) & 0xff
+               ;;         WIFSIGNALED -> 128 + (status & 0x7f)
+               (if (= (bitwise-and raw #x7f) 0)
+                 (bitwise-and (bitwise-arithmetic-shift-right raw 8) #xff)
+                 (+ 128 (bitwise-and raw #x7f)))))
+            ((and (< result 0) (= (foreign-ref 'int (foreign-alloc 4) 0) 4))
+             ;; EINTR — retry
+             (loop))
+            (else
+             (foreign-free status-buf)
+             -1))))))
+
+  ) ;; end library
diff --git a/support/landlock-shim.c b/support/landlock-shim.c
new file mode 100644
index 0000000..f05af5c
--- /dev/null
+++ b/support/landlock-shim.c
@@ -0,0 +1,231 @@
+#define _GNU_SOURCE
+/* landlock-shim.c — Non-variadic wrappers for Linux Landlock syscalls.
+ *
+ * syscall() is variadic, which means foreign-procedure can't call it
+ * directly (calling convention differs for variadic on some ABIs).
+ * These thin wrappers provide fixed-arity entry points.
+ *
+ * Compile: gcc -shared -fPIC -O2 -o libjerboa-landlock.so support/landlock-shim.c
+ * Static:  gcc -c -O2 -o landlock-shim.o support/landlock-shim.c
+ *          (then register symbols via Sforeign_symbol)
+ */
+
+#include <sys/types.h>
+#include <sys/prctl.h>
+#include <sys/syscall.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <string.h>
+#include <stdio.h>
+#include <stdint.h>
+
+/* ========== Landlock Definitions ========== */
+/* Defined inline — neither glibc nor musl provides these. */
+
+#ifndef __NR_landlock_create_ruleset
+#define __NR_landlock_create_ruleset 444
+#endif
+#ifndef __NR_landlock_add_rule
+#define __NR_landlock_add_rule 445
+#endif
+#ifndef __NR_landlock_restrict_self
+#define __NR_landlock_restrict_self 446
+#endif
+
+#define LANDLOCK_CREATE_RULESET_VERSION (1U << 0)
+
+#define LANDLOCK_ACCESS_FS_EXECUTE      (1ULL << 0)
+#define LANDLOCK_ACCESS_FS_WRITE_FILE   (1ULL << 1)
+#define LANDLOCK_ACCESS_FS_READ_FILE    (1ULL << 2)
+#define LANDLOCK_ACCESS_FS_READ_DIR     (1ULL << 3)
+#define LANDLOCK_ACCESS_FS_REMOVE_DIR   (1ULL << 4)
+#define LANDLOCK_ACCESS_FS_REMOVE_FILE  (1ULL << 5)
+#define LANDLOCK_ACCESS_FS_MAKE_CHAR    (1ULL << 6)
+#define LANDLOCK_ACCESS_FS_MAKE_DIR     (1ULL << 7)
+#define LANDLOCK_ACCESS_FS_MAKE_REG     (1ULL << 8)
+#define LANDLOCK_ACCESS_FS_MAKE_SOCK    (1ULL << 9)
+#define LANDLOCK_ACCESS_FS_MAKE_FIFO    (1ULL << 10)
+#define LANDLOCK_ACCESS_FS_MAKE_BLOCK   (1ULL << 11)
+#define LANDLOCK_ACCESS_FS_MAKE_SYM     (1ULL << 12)
+#define LANDLOCK_ACCESS_FS_REFER        (1ULL << 13)
+#define LANDLOCK_ACCESS_FS_TRUNCATE     (1ULL << 14)
+#define LANDLOCK_ACCESS_FS_IOCTL_DEV    (1ULL << 15)
+
+#define LANDLOCK_RULE_PATH_BENEATH 1
+
+struct landlock_ruleset_attr {
+    uint64_t handled_access_fs;
+    uint64_t handled_access_net;
+};
+
+struct landlock_path_beneath_attr {
+    uint64_t allowed_access;
+    int32_t  parent_fd;
+} __attribute__((packed));
+
+/* ========== Aggregate Access Masks ========== */
+
+#define ACCESS_FS_READ ( \
+    LANDLOCK_ACCESS_FS_EXECUTE   | \
+    LANDLOCK_ACCESS_FS_READ_FILE | \
+    LANDLOCK_ACCESS_FS_READ_DIR)
+
+#define ACCESS_FS_WRITE ( \
+    LANDLOCK_ACCESS_FS_WRITE_FILE  | \
+    LANDLOCK_ACCESS_FS_REMOVE_DIR  | \
+    LANDLOCK_ACCESS_FS_REMOVE_FILE | \
+    LANDLOCK_ACCESS_FS_MAKE_CHAR   | \
+    LANDLOCK_ACCESS_FS_MAKE_DIR    | \
+    LANDLOCK_ACCESS_FS_MAKE_REG    | \
+    LANDLOCK_ACCESS_FS_MAKE_SOCK   | \
+    LANDLOCK_ACCESS_FS_MAKE_FIFO   | \
+    LANDLOCK_ACCESS_FS_MAKE_BLOCK  | \
+    LANDLOCK_ACCESS_FS_MAKE_SYM)
+
+/* ========== API Functions ========== */
+
+/* Query Landlock ABI version. Returns version (>=1) or -1 if unsupported. */
+int jerboa_landlock_abi_version(void) {
+    int v = syscall(__NR_landlock_create_ruleset, NULL, 0,
+                    LANDLOCK_CREATE_RULESET_VERSION);
+    if (v < 0) return -1;
+    return v;
+}
+
+/* Get the full set of handled_access_fs flags for a given ABI version. */
+static uint64_t landlock_handled_fs(int abi) {
+    uint64_t a = ACCESS_FS_READ | ACCESS_FS_WRITE;
+    if (abi >= 2) a |= LANDLOCK_ACCESS_FS_REFER;
+    if (abi >= 3) a |= LANDLOCK_ACCESS_FS_TRUNCATE;
+    if (abi >= 5) a |= LANDLOCK_ACCESS_FS_IOCTL_DEV;
+    return a;
+}
+
+/*
+ * jerboa_landlock_sandbox — Apply Landlock restrictions to the current process.
+ *
+ * packed_read:  SOH-separated paths for read-only access (or empty/NULL)
+ * packed_write: SOH-separated paths for read+write access (or empty/NULL)
+ * packed_exec:  SOH-separated paths for execute access (or empty/NULL)
+ *
+ * Returns: 0 on success, 1 if Landlock unsupported, -1 on error.
+ *
+ * Once applied, restrictions are PERMANENT and IRREVERSIBLE for this process
+ * and all children. This is the point — it's real enforcement.
+ */
+int jerboa_landlock_sandbox(const char *packed_read,
+                            const char *packed_write,
+                            const char *packed_exec) {
+    /* 1. Check ABI version */
+    int abi = syscall(__NR_landlock_create_ruleset, NULL, 0,
+                      LANDLOCK_CREATE_RULESET_VERSION);
+    if (abi < 0) {
+        if (errno == ENOSYS || errno == EOPNOTSUPP)
+            return 1;  /* unsupported — graceful degradation */
+        return -1;
+    }
+
+    /* 2. Create ruleset handling all known FS access types */
+    uint64_t handled = landlock_handled_fs(abi);
+    struct landlock_ruleset_attr attr;
+    memset(&attr, 0, sizeof(attr));
+    attr.handled_access_fs = handled;
+
+    int ruleset_fd = syscall(__NR_landlock_create_ruleset,
+                             &attr, sizeof(attr), 0);
+    if (ruleset_fd < 0) return -1;
+
+    /* Helper: add one path rule */
+    #define ADD_RULE(path, access) do { \
+        int fd = open((path), O_PATH | O_CLOEXEC); \
+        if (fd >= 0) { \
+            struct landlock_path_beneath_attr pb; \
+            pb.allowed_access = (access) & handled; \
+            pb.parent_fd = fd; \
+            syscall(__NR_landlock_add_rule, ruleset_fd, \
+                    LANDLOCK_RULE_PATH_BENEATH, &pb, 0); \
+            close(fd); \
+        } \
+    } while(0)
+
+    /* 3. Always allow read access to essential system paths */
+    ADD_RULE("/usr", ACCESS_FS_READ);
+    ADD_RULE("/lib", ACCESS_FS_READ);
+    ADD_RULE("/lib64", ACCESS_FS_READ);
+    ADD_RULE("/bin", ACCESS_FS_READ);
+    ADD_RULE("/sbin", ACCESS_FS_READ);
+    ADD_RULE("/etc", ACCESS_FS_READ);
+    ADD_RULE("/proc", ACCESS_FS_READ);
+    ADD_RULE("/dev", ACCESS_FS_READ | LANDLOCK_ACCESS_FS_WRITE_FILE);
+
+    /* 4. Parse packed paths and add user rules */
+
+    /* Read-only paths */
+    if (packed_read && packed_read[0]) {
+        const char *p = packed_read;
+        while (*p) {
+            const char *end = p;
+            while (*end && *end != '\001') end++;
+            char path[4096];
+            int len = end - p;
+            if (len > 0 && len < (int)sizeof(path)) {
+                memcpy(path, p, len);
+                path[len] = '\0';
+                ADD_RULE(path, ACCESS_FS_READ);
+            }
+            p = *end ? end + 1 : end;
+        }
+    }
+
+    /* Read+write paths */
+    if (packed_write && packed_write[0]) {
+        const char *p = packed_write;
+        while (*p) {
+            const char *end = p;
+            while (*end && *end != '\001') end++;
+            char path[4096];
+            int len = end - p;
+            if (len > 0 && len < (int)sizeof(path)) {
+                memcpy(path, p, len);
+                path[len] = '\0';
+                ADD_RULE(path, ACCESS_FS_READ | ACCESS_FS_WRITE);
+            }
+            p = *end ? end + 1 : end;
+        }
+    }
+
+    /* Execute paths (read + execute) */
+    if (packed_exec && packed_exec[0]) {
+        const char *p = packed_exec;
+        while (*p) {
+            const char *end = p;
+            while (*end && *end != '\001') end++;
+            char path[4096];
+            int len = end - p;
+            if (len > 0 && len < (int)sizeof(path)) {
+                memcpy(path, p, len);
+                path[len] = '\0';
+                ADD_RULE(path, ACCESS_FS_READ | LANDLOCK_ACCESS_FS_EXECUTE);
+            }
+            p = *end ? end + 1 : end;
+        }
+    }
+
+    #undef ADD_RULE
+
+    /* 5. Set no_new_privs (mandatory before landlock_restrict_self) */
+    if (prctl(PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0)) {
+        close(ruleset_fd);
+        return -1;
+    }
+
+    /* 6. Enforce — PERMANENT and IRREVERSIBLE */
+    if (syscall(__NR_landlock_restrict_self, ruleset_fd, 0)) {
+        close(ruleset_fd);
+        return -1;
+    }
+
+    close(ruleset_fd);
+    return 0;
+}