Add Capsicum presets and path pre-opening for FreeBSD sandbox parity
ober
ca7b0ad731cb2c57ad68eab33d3d44bbd13ba0bb
--- a/lib/std/os/sandbox.sls +++ b/lib/std/os/sandbox.sls @@ -42,7 +42,8 @@ sandbox-run/capsicum sandbox-available?) - (import (chezscheme)) + (import (chezscheme) + (std security capsicum)) ;; ========== Platform Detection ========== @@ -149,18 +150,10 @@ (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")))) + ;; Capsicum availability (delegates to the capsicum module) + ;; capsicum-available?, capsicum-enter!, capsicum-limit-fd!, + ;; capsicum-open-path, capsicum-apply-preset! imported from + ;; (std security capsicum) ;; ========== Landlock helpers ========== @@ -237,13 +230,16 @@ (let ([sbpl (paths->sbpl-profile read-paths write-paths exec-paths)]) (apply-seatbelt! sbpl)))] [(freebsd) - ;; Enter Capsicum capability mode + ;; Pre-open paths as restricted fds, then enter capability mode. + ;; This gives Landlock-equivalent path-based restrictions via Capsicum. (when (capsicum-available?) - (let ([rc (c-cap-enter)]) - (when (< rc 0) - (display "sandbox: Capsicum cap_enter failed\n" - (current-error-port)) - (c-exit 126))))] + (guard (e [#t + (display "sandbox: Capsicum enforcement failed: " + (current-error-port)) + (display-condition e (current-error-port)) + (newline (current-error-port)) + (c-exit 126)]) + (capsicum-sandbox-paths! read-paths write-paths exec-paths)))] [else (void)]) ;; Run the thunk in the sandboxed child (guard (e [#t @@ -285,18 +281,25 @@ (wait-for-child pid))))) ;; FreeBSD-specific: run a thunk in Capsicum capability mode. - (define (sandbox-run/capsicum thunk) + ;; Optional fd-rights: alist of (fd . (right-symbol ...)) for per-fd restriction. + (define (sandbox-run/capsicum thunk . maybe-fd-rights) (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)))) + ;; CHILD: apply fd restrictions then enter Capsicum mode + (guard (e [#t + (display "sandbox: " (current-error-port)) + (display-condition e (current-error-port)) + (newline (current-error-port)) + (c-exit 1)]) + (when (capsicum-available?) + (if (and (pair? maybe-fd-rights) (pair? (car maybe-fd-rights))) + ;; Apply preset with fd restrictions + (capsicum-apply-preset! (car maybe-fd-rights)) + ;; Bare cap_enter + (capsicum-enter!)))) (guard (e [#t (display "sandbox: " (current-error-port)) (display-condition e (current-error-port)) @@ -307,6 +310,47 @@ (else (wait-for-child pid))))) + ;; ========== Capsicum Path Pre-opening ========== + + (define (capsicum-sandbox-paths! read-paths write-paths exec-paths) + ;; Pre-open paths as fds with appropriate Capsicum rights, restrict + ;; stdio, then enter capability mode. This maps Landlock-style path + ;; restrictions to the Capsicum fd-capability model. + ;; + ;; After this call, the process can only operate on pre-opened fds + ;; with their restricted rights. No new fds from global namespace. + ;; + ;; Returns the list of opened fds (caller can use with openat(2)). + (let ([opened-fds '()]) + ;; Pre-open read-only paths + (for-each + (lambda (p) + (guard (e [#t (void)]) ;; skip paths that can't be opened + (let ([fd (capsicum-open-path p '(read fstat seek lookup))]) + (set! opened-fds (cons fd opened-fds))))) + (if (list? read-paths) read-paths '())) + ;; Pre-open read-write paths + (for-each + (lambda (p) + (guard (e [#t (void)]) + (let ([fd (capsicum-open-path p '(read write fstat seek ftruncate lookup))]) + (set! opened-fds (cons fd opened-fds))))) + (if (list? write-paths) write-paths '())) + ;; Pre-open execute paths (read-only access for loading) + (for-each + (lambda (p) + (guard (e [#t (void)]) + (let ([fd (capsicum-open-path p '(read fstat lookup))]) + (set! opened-fds (cons fd opened-fds))))) + (if (list? exec-paths) exec-paths '())) + ;; Restrict stdio fds + (guard (e [#t (void)]) (capsicum-limit-fd! 0 '(read fstat))) + (guard (e [#t (void)]) (capsicum-limit-fd! 1 '(write fstat))) + (guard (e [#t (void)]) (capsicum-limit-fd! 2 '(write fstat))) + ;; Enter capability mode + (capsicum-enter!) + (reverse opened-fds))) + ;; ========== Internal ========== ;; Generate an SBPL profile string from path lists. --- a/lib/std/security/capsicum.sls +++ b/lib/std/security/capsicum.sls @@ -20,6 +20,12 @@ ;;; ;; Restrict an fd to read-only before entering capability mode: ;;; (capsicum-limit-fd! fd '(read)) ;;; +;;; ;; Apply a preset (restrict fds + enter cap mode in one call): +;;; (capsicum-apply-preset! (capsicum-compute-only-preset pipe-fd)) +;;; +;;; ;; Pre-open a path as a restricted fd: +;;; (capsicum-open-path "/data" '(read fstat seek lookup)) +;;; ;;; ;; Check availability: ;;; (capsicum-available?) @@ -33,6 +39,14 @@ ;; FD rights management capsicum-limit-fd! + ;; Presets (analogous to seccomp presets) + capsicum-compute-only-preset + capsicum-io-only-preset + capsicum-apply-preset! + + ;; Path pre-opening + capsicum-open-path + ;; Rights constants capsicum-right-read capsicum-right-write @@ -237,4 +251,86 @@ (lambda () (foreign-free rights-mem))))) + ;; ========== Path Pre-opening ========== + + ;; FreeBSD open(2) flags + (define O_RDONLY #x0000) + (define O_RDWR #x0002) + (define O_DIRECTORY #x00020000) ;; FreeBSD O_DIRECTORY + + (define c-open + (if (freebsd?) + (guard (e [#t (lambda (path flags) -1)]) + (foreign-procedure "open" (string int) int)) + (lambda (path flags) -1))) + + (define c-close + (if (freebsd?) + (guard (e [#t (lambda (fd) -1)]) + (foreign-procedure "close" (int) int)) + (lambda (fd) -1))) + + (define (capsicum-open-path path right-symbols) + ;; Pre-open a path and restrict the resulting fd. + ;; Returns the fd number (caller must track it). + ;; The fd is restricted to the given rights via cap_rights_limit. + ;; + ;; If 'write is in right-symbols, opens O_RDWR; otherwise O_RDONLY. + ;; If 'lookup is in right-symbols, adds O_DIRECTORY for directories. + (unless (freebsd?) + (error 'capsicum-open-path "Capsicum is only available on FreeBSD")) + (let* ([has-write (memq 'write right-symbols)] + [flags (if has-write O_RDWR O_RDONLY)] + [fd (c-open path flags)]) + (when (< fd 0) + (error 'capsicum-open-path + (format "open(~s) failed (errno ~a)" path (get-errno)))) + ;; Restrict the fd to the requested rights + (capsicum-limit-fd! fd right-symbols) + fd)) + + ;; ========== Presets ========== + ;; + ;; Presets are alists of (fd . (right-symbol ...)) that specify + ;; how each fd should be restricted before entering capability mode. + ;; Analogous to seccomp's compute-only-filter / io-only-filter. + + (define (capsicum-compute-only-preset pipe-fd) + ;; Minimal preset: restrict stdio + pipe fd. + ;; No file I/O, no network — just computation with stdio. + ;; Analogous to seccomp compute-only-filter. + `((0 . (read fstat)) ;; stdin: read-only + (1 . (write fstat)) ;; stdout: write-only + (2 . (write fstat)) ;; stderr: write-only + (,pipe-fd . (write fstat)))) ;; pipe to parent: write-only + + (define (capsicum-io-only-preset pipe-fd extra-fds) + ;; Like compute-only but with additional pre-opened fds. + ;; extra-fds: list of (fd . (right-symbol ...)) pairs for + ;; fds the caller pre-opened via capsicum-open-path. + ;; Analogous to seccomp io-only-filter + Landlock paths. + (append + (capsicum-compute-only-preset pipe-fd) + extra-fds)) + + (define (capsicum-apply-preset! preset) + ;; Apply a preset: restrict each fd then enter capability mode. + ;; preset: alist of (fd . (right-symbol ...)) + ;; + ;; This is the single-call entry point for Capsicum sandboxing + ;; with per-fd restrictions. IRREVERSIBLE. + (unless (freebsd?) + (error 'capsicum-apply-preset! "Capsicum is only available on FreeBSD")) + (unless (and (list? preset) (not (null? preset))) + (error 'capsicum-apply-preset! "expected non-empty preset alist" preset)) + ;; Step 1: Restrict each fd + (for-each + (lambda (entry) + (let ([fd (car entry)] + [rights (cdr entry)]) + (capsicum-limit-fd! fd rights))) + preset) + ;; Step 2: Enter capability mode + (capsicum-enter!)) + ) ;; end library --- a/lib/std/security/sandbox.sls +++ b/lib/std/security/sandbox.sls @@ -124,11 +124,13 @@ (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. + ;; #f to skip, #t for bare cap_enter(), or a preset symbol: + ;; 'compute-only — restrict stdio fds + cap_enter (analogous to seccomp compute-only) + ;; 'io-only — like compute-only but allows pre-opened fds + ;; Default: 'compute-only on FreeBSD, #f elsewhere. (define *sandbox-capsicum* (make-parameter - (if (eq? *current-platform* 'freebsd) #t #f))) + (if (eq? *current-platform* 'freebsd) 'compute-only #f))) ;; ========== Sandbox config record ========== @@ -214,6 +216,25 @@ "invalid seatbelt spec; expected #f, a profile symbol, or an SBPL string" spec)])) + ;; ========== Capsicum mode resolution (FreeBSD) ========== + + (define (resolve-capsicum-mode spec pipe-fd) + ;; Resolve capsicum config to an actionable value. + ;; Returns: #f, 'bare, or a preset alist. + (cond + [(eq? spec #f) #f] + [(eq? spec #t) 'bare] ;; backward compat + [(eq? spec 'compute-only) + (capsicum-compute-only-preset pipe-fd)] + [(eq? spec 'io-only) + (capsicum-io-only-preset pipe-fd '())] + [(and (list? spec) (pair? spec) + (pair? (car spec)) (integer? (caar spec))) + spec] ;; raw preset alist + [else (error 'run-safe + "invalid capsicum spec; expected #f, #t, 'compute-only, 'io-only, or preset alist" + spec)])) + ;; ========== Core: fork-based sandbox ========== ;; ;; We fork a child process to apply irreversible kernel protections. @@ -331,11 +352,18 @@ ;; (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 + (define (install-freebsd-protections! resolved-capsicum) + ;; Apply Capsicum protections based on resolved mode: + ;; #f — skip + ;; 'bare — just cap_enter() (backward compat with 'capsicum #t) + ;; alist — restrict fds per preset, then cap_enter() + (when resolved-capsicum (if (capsicum-available?) - (capsicum-enter!) + (cond + [(eq? resolved-capsicum 'bare) + (capsicum-enter!)] + [(list? resolved-capsicum) + (capsicum-apply-preset! resolved-capsicum)]) ;; Capsicum not available — warn but don't fail (void)))) @@ -377,7 +405,9 @@ [(macos) (install-macos-protections! seatbelt-profile)] [(freebsd) - (install-freebsd-protections! capsicum-mode)] + ;; Resolve capsicum mode here in the child, where we know the pipe fd + (let ([resolved (resolve-capsicum-mode capsicum-mode write-fd)]) + (install-freebsd-protections! resolved))] [else (void)]) ;; Unknown platform — run without kernel protections ;; Set capabilities (cross-platform runtime enforcement) --- a/tests/test-capsicum.ss +++ b/tests/test-capsicum.ss @@ -72,6 +72,46 @@ (not (= capsicum-right-read capsicum-right-write)) #t) +;; ========== Presets ========== + +(printf "~%-- Presets --~%") + +(test "capsicum-compute-only-preset returns alist" + (let ([preset (capsicum-compute-only-preset 5)]) + (and (list? preset) + (pair? preset) + (pair? (car preset)))) + #t) + +(test "capsicum-compute-only-preset includes pipe fd" + (let ([preset (capsicum-compute-only-preset 7)]) + (assv 7 preset)) + '(7 . (write fstat))) + +(test "capsicum-compute-only-preset includes stdin" + (let ([preset (capsicum-compute-only-preset 5)]) + (assv 0 preset)) + '(0 . (read fstat))) + +(test "capsicum-compute-only-preset includes stdout" + (let ([preset (capsicum-compute-only-preset 5)]) + (assv 1 preset)) + '(1 . (write fstat))) + +(test "capsicum-io-only-preset includes extra fds" + (let ([preset (capsicum-io-only-preset 5 '((10 . (read fstat seek))))]) + (assv 10 preset)) + '(10 . (read fstat seek))) + +(test "capsicum-io-only-preset includes compute-only fds" + (let ([preset (capsicum-io-only-preset 5 '((10 . (read))))]) + (and (assv 0 preset) ;; stdin + (assv 1 preset) ;; stdout + (assv 5 preset) ;; pipe + (assv 10 preset) ;; extra + #t)) + #t) + ;; ========== Error handling for non-FreeBSD ========== (printf "~%-- Error handling --~%") @@ -87,6 +127,18 @@ (guard (exn [#t #t]) (capsicum-limit-fd! 0 '(read)) #f) + #t) + + (test "capsicum-apply-preset! raises on non-FreeBSD" + (guard (exn [#t #t]) + (capsicum-apply-preset! '((0 . (read fstat)))) + #f) + #t) + + (test "capsicum-open-path raises on non-FreeBSD" + (guard (exn [#t #t]) + (capsicum-open-path "/tmp" '(read fstat)) + #f) #t)) ;; ========== Summary ========== --- a/tests/test-sandbox.ss +++ b/tests/test-sandbox.ss @@ -261,6 +261,34 @@ 'seatbelt #f 'capsicum #f)) 42) +;; ========== Capsicum preset config values ========== + +(printf "~%-- Capsicum presets --~%") + +(test "make-sandbox-config accepts capsicum compute-only" + (sandbox-config-capsicum (make-sandbox-config 'capsicum 'compute-only)) + 'compute-only) + +(test "make-sandbox-config accepts capsicum io-only" + (sandbox-config-capsicum (make-sandbox-config 'capsicum 'io-only)) + 'io-only) + +(test "make-sandbox-config accepts capsicum #t (backward compat)" + (sandbox-config-capsicum (make-sandbox-config 'capsicum #t)) + #t) + +(test "run-safe works with capsicum compute-only (non-FreeBSD skips)" + (run-safe (lambda () (+ 10 20)) + (make-sandbox-config 'timeout 5 'seccomp #f 'landlock #f + 'seatbelt #f 'capsicum 'compute-only)) + 30) + +(test "run-safe works with capsicum io-only (non-FreeBSD skips)" + (run-safe (lambda () (string-append "a" "b")) + (make-sandbox-config 'timeout 5 'seccomp #f 'landlock #f + 'seatbelt #f 'capsicum 'io-only)) + "ab") + ;; ========== Summary ========== (printf "~%Sandbox tests: ~a passed, ~a failed~%" pass fail) --- a/tests/vm/run-freebsd-tests.sh +++ b/tests/vm/run-freebsd-tests.sh @@ -220,6 +220,47 @@ cat > /tmp/fbsd-capsicum-functional.ss <<'SCHEME_EOF' (begin (set! pass (+ pass 1)) (printf " ok cap_rights_limit blocks write~%")) (begin (set! fail (+ fail 1)) (printf "FAIL child=~a~%" c))))])) +;; capsicum-apply-preset! enforcement +(printf "~%-- capsicum-apply-preset! enforcement --~%") +(let ([pid (c-fork)]) + (cond + [(< pid 0) (set! fail (+ fail 1)) (printf "FAIL fork~%")] + [(= pid 0) + ;; Apply compute-only preset with pipe fd 5 (dummy) + (capsicum-apply-preset! + (capsicum-compute-only-preset 1)) ;; use stdout as "pipe fd" + ;; Should be in cap mode now + (if (not (capsicum-in-capability-mode?)) (c-exit 2) + ;; open should fail + (let ([fd (c-open "/etc/passwd" 0)]) + (if (< fd 0) (c-exit 0) (begin (c-close fd) (c-exit 1)))))] + [else + (let ([c (wait-child pid)]) + (if (= c 0) + (begin (set! pass (+ pass 1)) (printf " ok apply-preset! blocks open()~%")) + (begin (set! fail (+ fail 1)) (printf "FAIL child=~a~%" c))))])) + +;; capsicum-open-path pre-opens and restricts +(printf "~%-- capsicum-open-path enforcement --~%") +(let ([pid (c-fork)]) + (cond + [(< pid 0) (set! fail (+ fail 1)) (printf "FAIL fork~%")] + [(= pid 0) + (let* ([c-wr (foreign-procedure "write" (int u8* size_t) ssize_t)] + ;; Pre-open /tmp as read-only + [dir-fd (capsicum-open-path "/tmp" '(read fstat seek lookup))]) + ;; Enter cap mode + (capsicum-enter!) + ;; The dir-fd should be restricted to read-only rights + ;; Writing should fail on this fd + (let ([n (c-wr dir-fd (string->utf8 "test") 4)]) + (if (< n 0) (c-exit 0) (c-exit 1))))] + [else + (let ([c (wait-child pid)]) + (if (= c 0) + (begin (set! pass (+ pass 1)) (printf " ok open-path restricts fd rights~%")) + (begin (set! fail (+ fail 1)) (printf "FAIL child=~a~%" c))))])) + (printf "~%Capsicum functional: ~a passed, ~a failed~%" pass fail) (when (> fail 0) (exit 1)) SCHEME_EOF