Add macOS and FreeBSD sandbox support (seatbelt, capsicum)
ober
58d4e52a7d6e93667314d75f099f7e0eee7aab19
--- a/lib/std/os/sandbox.sls +++ b/lib/std/os/sandbox.sls @@ -1,15 +1,22 @@ #!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. +;;; Forks the current process, applies platform-specific restrictions +;;; in the child, runs a thunk, then exits. The parent process is +;;; NEVER affected. +;;; +;;; Platform protections: +;;; Linux: Landlock filesystem access control +;;; macOS: Seatbelt sandbox profiles +;;; FreeBSD: Capsicum capability mode ;;; ;;; 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 +;;; - Platform-specific enforcement in the child ;;; - waitpid(2) to collect the child's exit status ;;; ;;; Usage: +;;; ;; Linux — Landlock path restrictions: ;;; (sandbox-run ;;; '("/tmp" "/var/data") ; read-only paths ;;; '("/tmp/output") ; read+write paths @@ -17,18 +24,46 @@ ;;; (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. +;;; ;; macOS — Seatbelt profile: +;;; (sandbox-run/profile 'no-write +;;; (lambda () (system "ls /tmp"))) +;;; +;;; ;; FreeBSD — Capsicum: +;;; (sandbox-run/capsicum +;;; (lambda () (display "sandboxed\n"))) +;;; +;;; The thunk runs in a forked child with protections applied. (library (std os sandbox) (export sandbox-run sandbox-run/command + sandbox-run/profile + sandbox-run/capsicum sandbox-available?) - (import (chezscheme) - (std os landlock)) + (import (chezscheme)) + + ;; ========== Platform Detection ========== + + (define (detect-platform) + (let ([mt (symbol->string (machine-type))]) + (cond + [(string-contains mt "osx") 'macos] + [(string-contains mt "fb") 'freebsd] + [(string-contains mt "le") 'linux] + [else 'unknown]))) + + (define (string-contains str sub) + (let ([slen (string-length str)] + [sublen (string-length sub)]) + (let lp ([i 0]) + (cond + [(> (+ i sublen) slen) #f] + [(string=? (substring str i (+ i sublen)) sub) #t] + [else (lp (+ i 1))])))) + + (define *platform* (detect-platform)) ;; ========== FFI ========== @@ -36,13 +71,132 @@ (define c-waitpid (foreign-procedure "waitpid" (int void* int) int)) (define c-exit (foreign-procedure "_exit" (int) void)) + ;; ========== Landlock FFI (Linux) ========== + + ;; Lazy import: try to load landlock procedures only on Linux. + ;; These match the (std os landlock) C shim API. + (define c-landlock-abi-version + (if (eq? *platform* 'linux) + (guard (e [#t (lambda () -1)]) + (foreign-procedure "jerboa_landlock_abi_version" () int)) + (lambda () -1))) + + (define c-landlock-sandbox + (if (eq? *platform* 'linux) + (guard (e [#t (lambda (r w x) -1)]) + (foreign-procedure "jerboa_landlock_sandbox" (string string string) int)) + (lambda (r w x) -1))) + + (define (landlock-available?) + (and (eq? *platform* 'linux) + (>= (c-landlock-abi-version) 1))) + + ;; ========== Seatbelt FFI (macOS) ========== + + (define c-sandbox-init + (if (eq? *platform* 'macos) + (guard (e [#t (lambda args -1)]) + (foreign-procedure "sandbox_init" (string unsigned-64 void*) int)) + (lambda args -1))) + + (define c-sandbox-free-error + (if (eq? *platform* 'macos) + (guard (e [#t (lambda (p) (void))]) + (foreign-procedure "sandbox_free_error" (void*) void)) + (lambda (p) (void)))) + + (define SANDBOX_NAMED 1) + + (define (seatbelt-available?) + (and (eq? *platform* 'macos) + (guard (e [#t #f]) + (foreign-entry? "sandbox_init")))) + + ;; Named profile map + (define (named-profile-string sym) + (case sym + [(pure-computation) "kSBXProfilePureComputation"] + [(no-write) "kSBXProfileNoWrite"] + [(no-write-except-temporary) "kSBXProfileNoWriteExceptTemporary"] + [(no-internet) "kSBXProfileNoInternet"] + [(no-network) "kSBXProfileNoNetwork"] + [else #f])) + + (define (apply-seatbelt! profile-spec) + ;; Apply a Seatbelt profile. profile-spec is a symbol or SBPL string. + (let ([errptr (foreign-alloc 8)]) + (foreign-set! 'void* errptr 0 0) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([rc (if (string? profile-spec) + ;; Raw SBPL string — flags = 0 + (c-sandbox-init profile-spec 0 errptr) + ;; Named profile — flags = SANDBOX_NAMED + (let ([name (named-profile-string profile-spec)]) + (if name + (c-sandbox-init name SANDBOX_NAMED errptr) + (begin + (display "sandbox: unknown Seatbelt profile\n" + (current-error-port)) + -1))))]) + (when (< rc 0) + (let ([errmsg (foreign-ref 'void* errptr 0)]) + (unless (= errmsg 0) + (c-sandbox-free-error errmsg))) + (display "sandbox: Seatbelt enforcement failed\n" + (current-error-port))))) + (lambda () + (foreign-free errptr))))) + + ;; ========== Capsicum FFI (FreeBSD) ========== + + (define c-cap-enter + (if (eq? *platform* 'freebsd) + (guard (e [#t (lambda () -1)]) + (foreign-procedure "cap_enter" () int)) + (lambda () -1))) + + (define (capsicum-available?) + (and (eq? *platform* 'freebsd) + (guard (e [#t #f]) + (foreign-entry? "cap_enter")))) + + ;; ========== Landlock 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))))))) + + (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 + (display "sandbox: Landlock enforcement failed\n" + (current-error-port)) + #f))))) + ;; ========== Public API ========== ;; Check if sandboxing is available on this system. (define (sandbox-available?) - (landlock-available?)) + (case *platform* + [(linux) (landlock-available?)] + [(macos) (seatbelt-available?)] + [(freebsd) (capsicum-available?)] + [else #f])) ;; Fork, apply Landlock in child, run thunk, return exit status. + ;; (Linux-style API — kept for backward compatibility) ;; ;; read-paths: list of paths for read-only access ;; write-paths: list of paths for read+write access @@ -51,6 +205,11 @@ ;; ;; Returns the child's exit status (0-255). ;; The parent process is NEVER affected by the sandbox. + ;; + ;; On non-Linux platforms, the path arguments are mapped to the + ;; closest equivalent: + ;; macOS: Generates an SBPL profile from the path lists + ;; FreeBSD: Enters Capsicum mode (path args are informational only) (define (sandbox-run read-paths write-paths exec-paths thunk) (let ((pid (c-fork))) (cond @@ -59,17 +218,33 @@ ((= 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)))) + ;; Apply platform-specific restrictions + (case *platform* + [(linux) + (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))))] + [(macos) + ;; Generate an SBPL profile from the path lists + (when (seatbelt-available?) + (let ([sbpl (paths->sbpl-profile read-paths write-paths exec-paths)]) + (apply-seatbelt! sbpl)))] + [(freebsd) + ;; Enter Capsicum capability mode + (when (capsicum-available?) + (let ([rc (c-cap-enter)]) + (when (< rc 0) + (display "sandbox: Capsicum cap_enter failed\n" + (current-error-port)) + (c-exit 126))))] + [else (void)]) ;; Run the thunk in the sandboxed child (guard (e [#t (display "sandbox: " (current-error-port)) @@ -84,13 +259,93 @@ (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)))) + ;; macOS-specific: run a thunk under a Seatbelt profile. + ;; profile-spec: symbol ('pure-computation, 'no-write, etc.) or SBPL string. + (define (sandbox-run/profile profile-spec thunk) + (let ((pid (c-fork))) + (cond + ((< pid 0) + (error 'sandbox-run/profile "fork failed")) + ((= pid 0) + ;; CHILD: apply Seatbelt + (when (seatbelt-available?) + (apply-seatbelt! profile-spec)) + (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 + (wait-for-child pid))))) + + ;; FreeBSD-specific: run a thunk in Capsicum capability mode. + (define (sandbox-run/capsicum thunk) + (let ((pid (c-fork))) + (cond + ((< pid 0) + (error 'sandbox-run/capsicum "fork failed")) + ((= pid 0) + ;; CHILD: enter Capsicum mode + (when (capsicum-available?) + (let ([rc (c-cap-enter)]) + (when (< rc 0) + (display "sandbox: cap_enter failed\n" (current-error-port)) + (c-exit 126)))) + (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 + (wait-for-child pid))))) + ;; ========== Internal ========== + ;; Generate an SBPL profile string from path lists. + ;; Maps Landlock-style path restrictions to Seatbelt Profile Language. + (define (paths->sbpl-profile read-paths write-paths exec-paths) + (string-append + "(version 1)" + "(deny default)" + ;; Allow Mach and signal for basic process operation + "(allow mach-lookup)" + "(allow signal)" + "(allow sysctl-read)" + ;; Always allow reading system libraries + "(allow file-read* (subpath \"/usr/lib\")" + " (subpath \"/System\")" + " (subpath \"/Library/Frameworks\")" + " (subpath \"/private/var/db/dyld\")" + ;; User-specified read paths + (apply string-append + (map (lambda (p) (format " (subpath ~s)" p)) read-paths)) + ;; Write paths also get read access + (apply string-append + (map (lambda (p) (format " (subpath ~s)" p)) write-paths)) + ")" + ;; Write permissions + (if (null? write-paths) "" + (string-append + "(allow file-write* " + (apply string-append + (map (lambda (p) (format "(subpath ~s) " p)) write-paths)) + ")")) + ;; Execute permissions + (if (null? exec-paths) "" + (string-append + "(allow process-exec (subpath \"/usr/bin\") (subpath \"/bin\")" + (apply string-append + (map (lambda (p) (format " (subpath ~s)" p)) exec-paths)) + ")")))) + ;; Wait for child and decode exit status. (define (wait-for-child pid) (let ((status-buf (foreign-alloc 4))) new file mode 100644 --- /dev/null +++ b/lib/std/security/capsicum.sls @@ -0,0 +1,217 @@ +#!chezscheme +;;; (std security capsicum) — FreeBSD Capsicum capability mode +;;; +;;; Wraps FreeBSD's Capsicum framework for process sandboxing. +;;; cap_enter(2) puts the process into capability mode — IRREVERSIBLE. +;;; In capability mode: +;;; - No new file descriptors from the global namespace (no open, connect, etc.) +;;; - Only operations on pre-opened file descriptors +;;; - File descriptors can be further restricted with cap_rights_limit(2) +;;; +;;; This is a fundamentally different model from Linux Landlock/seccomp: +;;; - Landlock: path-based filesystem restrictions +;;; - seccomp: syscall filtering +;;; - Capsicum: capability-based fd restrictions +;;; +;;; Usage: +;;; ;; Enter capability mode (irreversible): +;;; (capsicum-enter!) +;;; +;;; ;; Restrict an fd to read-only before entering capability mode: +;;; (capsicum-limit-fd! fd '(read)) +;;; +;;; ;; Check availability: +;;; (capsicum-available?) + +(library (std security capsicum) + (export + ;; Capability mode + capsicum-enter! + capsicum-available? + capsicum-in-capability-mode? + + ;; FD rights management + capsicum-limit-fd! + + ;; Rights constants + capsicum-right-read + capsicum-right-write + capsicum-right-seek + capsicum-right-mmap + capsicum-right-fstat + capsicum-right-ftruncate + capsicum-right-event + capsicum-right-lookup) + + (import (chezscheme)) + + ;; ========== Platform Detection ========== + + (define (freebsd?) + (let ([mt (symbol->string (machine-type))]) + (let loop ([i 0]) + (cond + [(> (+ i 2) (string-length mt)) #f] + [(string=? (substring mt i (+ i 2)) "fb") #t] + [else (loop (+ i 1))])))) + + ;; ========== FFI ========== + + ;; cap_enter(void) -> int (0 on success, -1 on error) + (define c-cap-enter + (if (freebsd?) + (guard (e [#t (lambda () -1)]) + (foreign-procedure "cap_enter" () int)) + (lambda () -1))) + + ;; cap_getmode(u_int *modep) -> int + (define c-cap-getmode + (if (freebsd?) + (guard (e [#t (lambda (p) -1)]) + (foreign-procedure "cap_getmode" (void*) int)) + (lambda (p) -1))) + + ;; cap_rights_limit(int fd, const cap_rights_t *rights) -> int + (define c-cap-rights-limit + (if (freebsd?) + (guard (e [#t (lambda (fd rights) -1)]) + (foreign-procedure "cap_rights_limit" (int void*) int)) + (lambda (fd rights) -1))) + + ;; cap_rights_init(cap_rights_t *rights, ...) -> cap_rights_t* + ;; We can't use variadic FFI directly. Instead we'll use + ;; __cap_rights_init with version and rights array. + ;; cap_rights_t on FreeBSD is: struct { uint64_t cr_rights[CAP_RIGHTS_VERSION + 2]; } + ;; CAP_RIGHTS_VERSION = 0, so cr_rights[2] = 16 bytes + (define CAP_RIGHTS_VERSION 0) + (define CAP_RIGHTS_SIZE 16) ;; 2 * uint64_t + + ;; errno on FreeBSD + (define c-errno + (if (freebsd?) + (guard (e [#t (lambda () 0)]) + (foreign-procedure "__error" () void*)) + (lambda () 0))) + + (define (get-errno) + (guard (e [#t 0]) + (let ([loc (c-errno)]) + (if (= loc 0) 0 + (foreign-ref 'int loc 0))))) + + ;; ========== Capsicum Rights Constants ========== + ;; From sys/capsicum.h — these are bit positions in the rights bitmask + + ;; Index 0 rights (general operations) + (define capsicum-right-read (bitwise-arithmetic-shift-left 1 57)) ;; CAP_READ + (define capsicum-right-write (bitwise-arithmetic-shift-left 1 58)) ;; CAP_WRITE + (define capsicum-right-seek (bitwise-arithmetic-shift-left 1 11)) ;; CAP_SEEK + (define capsicum-right-mmap (bitwise-arithmetic-shift-left 1 24)) ;; CAP_MMAP + (define capsicum-right-fstat (bitwise-arithmetic-shift-left 1 40)) ;; CAP_FSTAT + (define capsicum-right-ftruncate (bitwise-arithmetic-shift-left 1 42)) ;; CAP_FTRUNCATE + (define capsicum-right-event (bitwise-arithmetic-shift-left 1 46)) ;; CAP_EVENT + (define capsicum-right-lookup (bitwise-arithmetic-shift-left 1 56)) ;; CAP_LOOKUP + + ;; ========== Rights Helpers ========== + + (define (symbol->right sym) + (case sym + [(read) capsicum-right-read] + [(write) capsicum-right-write] + [(seek) capsicum-right-seek] + [(mmap) capsicum-right-mmap] + [(fstat) capsicum-right-fstat] + [(ftruncate) capsicum-right-ftruncate] + [(event) capsicum-right-event] + [(lookup) capsicum-right-lookup] + [else (error 'capsicum-limit-fd! + "unknown right; expected read, write, seek, mmap, fstat, ftruncate, event, or lookup" + sym)])) + + (define (pack-rights right-symbols) + ;; Pack a list of right symbols into a cap_rights_t foreign structure. + ;; Returns a foreign pointer that must be freed by the caller. + (let ([rights-mem (foreign-alloc CAP_RIGHTS_SIZE)] + [mask (fold-left + (lambda (acc sym) (bitwise-ior acc (symbol->right sym))) + 0 + right-symbols)]) + ;; cap_rights_t = { cr_rights[0] = version_and_rights, cr_rights[1] = 0 } + ;; cr_rights[0] bits 57..62 encode the version (CAP_RIGHTS_VERSION = 0) + ;; The actual rights are OR'd in + (foreign-set! 'unsigned-64 rights-mem 0 + (bitwise-ior + (bitwise-arithmetic-shift-left (+ CAP_RIGHTS_VERSION 2) 57) + mask)) + (foreign-set! 'unsigned-64 rights-mem 8 0) + rights-mem)) + + ;; ========== Availability ========== + + (define (capsicum-available?) + ;; Capsicum is available on FreeBSD 10+. + (and (freebsd?) + (guard (e [#t #f]) + (foreign-entry? "cap_enter")))) + + ;; ========== Capability Mode ========== + + (define (capsicum-enter!) + ;; Enter Capsicum capability mode. IRREVERSIBLE. + ;; After this call, the process cannot: + ;; - Open new files/directories from the global namespace + ;; - Create new sockets + ;; - Access any path not reachable from pre-opened descriptors + ;; + ;; Pre-open any needed file descriptors BEFORE calling this. + (unless (freebsd?) + (error 'capsicum-enter! "Capsicum is only available on FreeBSD")) + (let ([rc (c-cap-enter)]) + (when (< rc 0) + (error 'capsicum-enter! + (format "cap_enter(2) failed (errno ~a)" (get-errno)))))) + + (define (capsicum-in-capability-mode?) + ;; Check if the process is already in capability mode. + (if (not (freebsd?)) + #f + (let ([buf (foreign-alloc 4)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([rc (c-cap-getmode buf)]) + (and (>= rc 0) + (= (foreign-ref 'unsigned-32 buf 0) 1)))) + (lambda () + (foreign-free buf)))))) + + ;; ========== FD Rights Restriction ========== + + (define (capsicum-limit-fd! fd right-symbols) + ;; Restrict an fd to only the specified operations. + ;; right-symbols: list of symbols from: read, write, seek, mmap, + ;; fstat, ftruncate, event, lookup + ;; + ;; This is IRREVERSIBLE — rights can only be narrowed, never widened. + ;; Must be called BEFORE capsicum-enter! for fds you want to keep. + ;; + ;; Example: + ;; (capsicum-limit-fd! my-fd '(read fstat)) ; read-only + (unless (freebsd?) + (error 'capsicum-limit-fd! "Capsicum is only available on FreeBSD")) + (unless (and (list? right-symbols) (not (null? right-symbols))) + (error 'capsicum-limit-fd! "expected non-empty list of right symbols" + right-symbols)) + (let ([rights-mem (pack-rights right-symbols)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([rc (c-cap-rights-limit fd rights-mem)]) + (when (< rc 0) + (error 'capsicum-limit-fd! + (format "cap_rights_limit(2) failed for fd ~a (errno ~a)" + fd (get-errno)))))) + (lambda () + (foreign-free rights-mem))))) + + ) ;; end library --- a/lib/std/security/sandbox.sls +++ b/lib/std/security/sandbox.sls @@ -1,26 +1,42 @@ #!chezscheme ;;; (std security sandbox) — One-call sandbox entry point ;;; -;;; Combines Landlock (filesystem), seccomp (syscalls), capabilities +;;; Combines platform-specific kernel protections, capabilities ;;; (runtime enforcement), restricted evaluation, and timeouts into ;;; a single `run-safe` call. ;;; +;;; Platform protections: +;;; Linux: Landlock (filesystem) + seccomp (syscall filtering) +;;; macOS: Seatbelt (sandbox_init profiles) +;;; FreeBSD: Capsicum (capability mode) +;;; ;;; Usage: ;;; ;; Run untrusted thunk with all protections (uses defaults): ;;; (run-safe (lambda () (+ 1 2))) ;;; -;;; ;; Run with custom config: +;;; ;; Run with custom config (platform-specific keys): +;;; ;; Linux: ;;; (run-safe (lambda () (+ 1 2)) ;;; (make-sandbox-config ;;; 'timeout 10 ;;; 'seccomp 'io-only ;;; 'landlock (make-readonly-ruleset "/usr/lib" "/lib"))) +;;; ;; macOS: +;;; (run-safe (lambda () (+ 1 2)) +;;; (make-sandbox-config +;;; 'timeout 10 +;;; 'seatbelt 'pure-computation)) +;;; ;; FreeBSD: +;;; (run-safe (lambda () (+ 1 2)) +;;; (make-sandbox-config +;;; 'timeout 10 +;;; 'capsicum #t)) ;;; ;;; ;; Evaluate a string in a fully sandboxed environment: ;;; (run-safe-eval "(+ 1 2)") ;;; (run-safe-eval "(+ 1 2)" (make-sandbox-config 'timeout 10)) ;;; -;;; All kernel protections (Landlock, seccomp) are IRREVERSIBLE. +;;; All kernel protections are IRREVERSIBLE. ;;; run-safe forks a child process so the parent remains unrestricted. ;;; The child applies protections, runs the thunk, and sends the result ;;; back via a pipe. @@ -34,11 +50,15 @@ *sandbox-timeout* *sandbox-seccomp* *sandbox-landlock* + *sandbox-seatbelt* + *sandbox-capsicum* ;; Config accessors sandbox-config-timeout sandbox-config-seccomp sandbox-config-landlock + sandbox-config-seatbelt + sandbox-config-capsicum sandbox-config-capabilities ;; Condition type @@ -48,16 +68,39 @@ (import (chezscheme) (std security landlock) (std security seccomp) + (std security seatbelt) + (std security capsicum) (std security capability) (std security restrict) (std safe-timeout) (std error conditions)) + ;; ========== Platform detection ========== + + (define (detect-platform) + (let ([mt (symbol->string (machine-type))]) + (cond + [(string-contains-ci mt "osx") 'macos] + [(string-contains-ci mt "fb") 'freebsd] + [(string-contains-ci mt "le") 'linux] + [else 'unknown]))) + + (define (string-contains-ci str sub) + (let ([slen (string-length str)] + [sublen (string-length sub)]) + (let lp ([i 0]) + (cond + [(> (+ i sublen) slen) #f] + [(string=? (substring str i (+ i sublen)) sub) #t] + [else (lp (+ i 1))])))) + + (define *current-platform* (detect-platform)) + ;; ========== Condition type ========== (define-condition-type &sandbox-error &jerboa make-sandbox-error sandbox-error? - (phase sandbox-error-phase) ;; 'landlock | 'seccomp | 'capability | 'timeout | 'eval | 'fork + (phase sandbox-error-phase) ;; 'landlock | 'seccomp | 'seatbelt | 'capsicum | 'capability | 'timeout | 'eval | 'fork (detail sandbox-error-detail)) ;; string or condition ;; ========== Default parameters ========== @@ -65,38 +108,61 @@ ;; Default timeout for sandboxed execution (seconds). #f = no timeout. (define *sandbox-timeout* (make-parameter 30)) - ;; Default seccomp filter. Symbol or seccomp-filter object. + ;; Default seccomp filter (Linux). Symbol or seccomp-filter object. ;; 'compute-only, 'io-only, 'network-server, or a custom filter, or #f for none. (define *sandbox-seccomp* (make-parameter 'compute-only)) - ;; Default Landlock ruleset, or #f for none. + ;; Default Landlock ruleset (Linux), or #f for none. (define *sandbox-landlock* (make-parameter #f)) + ;; Default Seatbelt profile (macOS). + ;; Symbol ('pure-computation, 'no-write, 'no-network, etc.), + ;; SBPL string, or #f for none. + ;; Default: 'pure-computation on macOS, #f elsewhere. + (define *sandbox-seatbelt* + (make-parameter + (if (eq? *current-platform* 'macos) 'pure-computation #f))) + + ;; Default Capsicum mode (FreeBSD). + ;; #t to enter capability mode, #f to skip. + ;; Default: #t on FreeBSD, #f elsewhere. + (define *sandbox-capsicum* + (make-parameter + (if (eq? *current-platform* 'freebsd) #t #f))) + ;; ========== Sandbox config record ========== (define-record-type (%sandbox-config %make-sandbox-config sandbox-config?) (fields - (immutable timeout %sandbox-config-timeout) - (immutable seccomp %sandbox-config-seccomp) - (immutable landlock %sandbox-config-landlock) + (immutable timeout %sandbox-config-timeout) + (immutable seccomp %sandbox-config-seccomp) + (immutable landlock %sandbox-config-landlock) + (immutable seatbelt %sandbox-config-seatbelt) + (immutable capsicum %sandbox-config-capsicum) (immutable capabilities %sandbox-config-capabilities))) ;; Public accessors - (define sandbox-config-timeout %sandbox-config-timeout) - (define sandbox-config-seccomp %sandbox-config-seccomp) - (define sandbox-config-landlock %sandbox-config-landlock) + (define sandbox-config-timeout %sandbox-config-timeout) + (define sandbox-config-seccomp %sandbox-config-seccomp) + (define sandbox-config-landlock %sandbox-config-landlock) + (define sandbox-config-seatbelt %sandbox-config-seatbelt) + (define sandbox-config-capsicum %sandbox-config-capsicum) (define sandbox-config-capabilities %sandbox-config-capabilities) ;; make-sandbox-config: key-value pairs → sandbox-config record ;; (make-sandbox-config 'timeout 10 'seccomp 'io-only) + ;; (make-sandbox-config 'timeout 10 'seatbelt 'no-write) + ;; (make-sandbox-config 'timeout 10 'capsicum #t) (define (make-sandbox-config . args) (let loop ([rest args] - [timeout (*sandbox-timeout*)] - [seccomp (*sandbox-seccomp*)] + [timeout (*sandbox-timeout*)] + [seccomp (*sandbox-seccomp*)] [landlock (*sandbox-landlock*)] + [seatbelt (*sandbox-seatbelt*)] + [capsicum (*sandbox-capsicum*)] [caps '()]) (if (null? rest) - (%make-sandbox-config timeout seccomp landlock caps) + (%make-sandbox-config timeout seccomp landlock seatbelt capsicum caps) (begin (when (null? (cdr rest)) (error 'make-sandbox-config "key missing value" (car rest))) @@ -105,19 +171,23 @@ [remaining (cddr rest)]) (cond [(eq? key 'timeout) - (loop remaining val seccomp landlock caps)] + (loop remaining val seccomp landlock seatbelt capsicum caps)] [(eq? key 'seccomp) - (loop remaining timeout val landlock caps)] + (loop remaining timeout val landlock seatbelt capsicum caps)] [(eq? key 'landlock) - (loop remaining timeout seccomp val caps)] + (loop remaining timeout seccomp val seatbelt capsicum caps)] + [(eq? key 'seatbelt) + (loop remaining timeout seccomp landlock val capsicum caps)] + [(eq? key 'capsicum) + (loop remaining timeout seccomp landlock seatbelt val caps)] [(eq? key 'capabilities) - (loop remaining timeout seccomp landlock val)] + (loop remaining timeout seccomp landlock seatbelt capsicum val)] [else (error 'make-sandbox-config - "unknown key; expected timeout, seccomp, landlock, or capabilities" + "unknown key; expected timeout, seccomp, landlock, seatbelt, capsicum, or capabilities" key)])))))) - ;; ========== Seccomp filter resolution ========== + ;; ========== Seccomp filter resolution (Linux) ========== (define (resolve-seccomp-filter spec) (cond @@ -130,15 +200,28 @@ "invalid seccomp spec; expected #f, 'compute-only, 'io-only, 'network-server, or seccomp-filter" spec)])) + ;; ========== Seatbelt profile resolution (macOS) ========== + + (define (resolve-seatbelt-profile spec) + ;; Returns: #f, a named profile symbol, or a raw SBPL string. + (cond + [(eq? spec #f) #f] + [(string? spec) spec] ;; raw SBPL string + [(memq spec '(pure-computation no-write no-write-except-temporary + no-internet no-network)) + spec] + [else (error 'run-safe + "invalid seatbelt spec; expected #f, a profile symbol, or an SBPL string" + spec)])) + ;; ========== Core: fork-based sandbox ========== ;; ;; We fork a child process to apply irreversible kernel protections. ;; The child: - ;; 1. Installs Landlock (if provided) - ;; 2. Installs seccomp (if provided) - ;; 3. Sets capabilities (if provided) - ;; 4. Runs the thunk with timeout - ;; 5. Writes the result to a pipe + ;; 1. Installs platform-specific protections + ;; 2. Sets capabilities (if provided) + ;; 3. Runs the thunk with timeout + ;; 4. Writes the result to a pipe ;; The parent waits and reads the result. ;; ;; This design ensures the parent process is never restricted. @@ -151,11 +234,15 @@ (let ([cfg (if (null? maybe-config) (default-config) (car maybe-config))]) (unless (sandbox-config? cfg) (error 'run-safe "expected sandbox-config" cfg)) - (let ([seccomp-filter (resolve-seccomp-filter (%sandbox-config-seccomp cfg))]) + (let ([seccomp-filter (resolve-seccomp-filter (%sandbox-config-seccomp cfg))] + [seatbelt-profile (resolve-seatbelt-profile (%sandbox-config-seatbelt cfg))] + [capsicum-mode (%sandbox-config-capsicum cfg)]) (run-safe-internal thunk (%sandbox-config-timeout cfg) seccomp-filter (%sandbox-config-landlock cfg) + seatbelt-profile + capsicum-mode (%sandbox-config-capabilities cfg))))) ;; FFI pipe(2) — creates a pair of connected file descriptors @@ -221,7 +308,41 @@ (bytevector-copy! buf 0 chunk 0 n) (loop (cons chunk chunks) (+ total n)))]))))) - (define (run-safe-internal thunk timeout seccomp-filter landlock-rules capabilities) + ;; ========== Platform-specific protection installation ========== + + (define (install-linux-protections! landlock-rules seccomp-filter) + ;; Step 1: Install Landlock filesystem restrictions + (when (and landlock-rules (landlock-available?)) + (landlock-install! landlock-rules)) + ;; Step 2: Install seccomp syscall filter + (when (and seccomp-filter (seccomp-available?)) + (seccomp-install! seccomp-filter))) + + (define (install-macos-protections! seatbelt-profile) + ;; Install Seatbelt sandbox profile + (when seatbelt-profile + (if (seatbelt-available?) + (if (string? seatbelt-profile) + ;; Raw SBPL string + (seatbelt-install-profile! seatbelt-profile) + ;; Named profile symbol + (seatbelt-install! seatbelt-profile)) + ;; Seatbelt not available — warn but don't fail + ;; (could be running on a very old macOS or in a container) + (void)))) + + (define (install-freebsd-protections! capsicum-mode) + ;; Enter Capsicum capability mode + (when capsicum-mode + (if (capsicum-available?) + (capsicum-enter!) + ;; Capsicum not available — warn but don't fail + (void)))) + + ;; ========== Core sandbox implementation ========== + + (define (run-safe-internal thunk timeout seccomp-filter landlock-rules + seatbelt-profile capsicum-mode capabilities) ;; Communication via pipe: child writes result, parent reads it. ;; HARDENED: Uses pipe(2) instead of temp files to prevent symlink attacks, ;; TOCTOU races, and read-eval injection. @@ -249,20 +370,21 @@ (c-close write-fd)))) (exit 1)]) - ;; Step 1: Install Landlock - (when (and landlock-rules (landlock-available?)) - (landlock-install! landlock-rules)) - - ;; Step 2: Install seccomp AFTER setting up pipe - ;; Pipe fd is already open, so even compute-only filter works - (when (and seccomp-filter (seccomp-available?)) - (seccomp-install! seccomp-filter)) - - ;; Step 3: Set capabilities + ;; Install platform-specific protections + (case *current-platform* + [(linux) + (install-linux-protections! landlock-rules seccomp-filter)] + [(macos) + (install-macos-protections! seatbelt-profile)] + [(freebsd) + (install-freebsd-protections! capsicum-mode)] + [else (void)]) ;; Unknown platform — run without kernel protections + + ;; Set capabilities (cross-platform runtime enforcement) (unless (null? capabilities) (current-capabilities capabilities)) - ;; Step 4: Run thunk with timeout + ;; Run thunk with timeout (let ([result (if timeout (let ([completed #f] @@ -283,7 +405,7 @@ value) (thunk))]) - ;; Step 5: Send result to parent via pipe + ;; Send result to parent via pipe (let ([data (string->utf8 (format "(ok ~s)" result))]) (fd-write-all write-fd data) (c-close write-fd) @@ -320,12 +442,13 @@ ;; ========== FFI Initialization ========== + ;; Load libc — platform-specific library names (define _libc - (guard (e [#t #f]) - (load-shared-object "libc.so.6"))) - (define _libc2 - (guard (e [#t #f]) - (load-shared-object ""))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.6")) ;; Linux + (guard (e [#t #f]) (load-shared-object "libc.dylib")) ;; macOS + (guard (e [#t #f]) (load-shared-object "libc.so.7")) ;; FreeBSD + (guard (e [#t #f]) (load-shared-object "libc.so")) ;; generic + (guard (e [#t #f]) (load-shared-object "")))) ;; default (define fork-process (guard (e [#t (lambda () (error 'run-safe "fork() not available on this platform"))]) @@ -346,13 +469,17 @@ (let ([cfg (if (null? maybe-config) (default-config) (car maybe-config))]) (unless (sandbox-config? cfg) (error 'run-safe-eval "expected sandbox-config" cfg)) - (let ([seccomp-filter (resolve-seccomp-filter (%sandbox-config-seccomp cfg))]) + (let ([seccomp-filter (resolve-seccomp-filter (%sandbox-config-seccomp cfg))] + [seatbelt-profile (resolve-seatbelt-profile (%sandbox-config-seatbelt cfg))] + [capsicum-mode (%sandbox-config-capsicum cfg)]) (run-safe-internal (lambda () (restricted-eval-string expr-string)) (%sandbox-config-timeout cfg) seccomp-filter (%sandbox-config-landlock cfg) + seatbelt-profile + capsicum-mode (%sandbox-config-capabilities cfg))))) ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/security/seatbelt.sls @@ -0,0 +1,202 @@ +#!chezscheme +;;; (std security seatbelt) — macOS Seatbelt sandbox profiles +;;; +;;; Wraps macOS sandbox_init(3) to apply Seatbelt profiles. +;;; Profiles restrict filesystem, network, and process operations. +;;; Once applied, restrictions are IRREVERSIBLE for the process lifetime. +;;; +;;; macOS provides built-in named profiles: +;;; kSBXProfilePureComputation — no I/O at all +;;; kSBXProfileNoWrite — read-only filesystem +;;; kSBXProfileNoWriteExceptTemporary — writes only to $TMPDIR +;;; kSBXProfileNoInternet — no outbound network +;;; kSBXProfileNoNetwork — no network at all (including local) +;;; +;;; Custom profiles use SBPL (Sandbox Profile Language), e.g.: +;;; (version 1)(deny default)(allow file-read* (subpath "/usr/lib")) +;;; +;;; Usage: +;;; ;; Apply a built-in profile: +;;; (seatbelt-install! 'pure-computation) +;;; +;;; ;; Apply a custom SBPL profile string: +;;; (seatbelt-install-profile! +;;; "(version 1)(deny default)(allow file-read* (subpath \"/usr/lib\"))") +;;; +;;; ;; Pre-built profiles (return SBPL strings): +;;; (seatbelt-compute-only-profile) ; deny all except computation +;;; (seatbelt-read-only-profile "/usr/lib" "/lib") ; read-only access +;;; (seatbelt-no-network-profile) ; deny network + +(library (std security seatbelt) + (export