Add FreeBSD Capsicum support to (std security cage)
ober
7675e31eb4877e14b52c6f52b86095742b6e8623
--- a/lib/std/security/cage.sls +++ b/lib/std/security/cage.sls @@ -57,6 +57,7 @@ (import (chezscheme) (std security landlock) + (std security capsicum) (std error conditions)) ;; ========== libc ========== @@ -85,6 +86,7 @@ [(string-contains-ci mt "le") 'linux] [(string-contains-ci mt "osx") 'macos] [(string-contains-ci mt "ob") 'openbsd] + [(string-contains-ci mt "fb") 'freebsd] [else 'unknown]))) (define *current-platform* (detect-platform)) @@ -293,13 +295,14 @@ "cage already active — can only tighten, not replace"))) (case *current-platform* - [(linux) (cage-linux! cfg)] + [(linux) (cage-linux! cfg)] [(openbsd) (cage-openbsd! cfg)] + [(freebsd) (cage-freebsd! cfg)] [else (raise (make-cage-error "cage" 'platform - (format "cage! not yet supported on ~a (Linux and OpenBSD only)" + (format "cage! not yet supported on ~a" *current-platform*)))])) ;; ========== Linux implementation (Landlock) ========== @@ -375,4 +378,153 @@ 'platform "OpenBSD cage! not yet implemented (needs unveil(2) FFI bindings)"))) + ;; ========== FreeBSD implementation (Capsicum) ========== + ;; + ;; Capsicum's capability mode is fundamentally different from Landlock: + ;; - After cap_enter(), NO new open() calls work from the global namespace + ;; - Only pre-opened file descriptors (and their descendants) are usable + ;; - openat() with a pre-opened directory fd works for relative paths + ;; + ;; We pre-open all allowed directories as O_DIRECTORY fds with + ;; appropriate capability rights, then enter capability mode. + ;; The pre-opened fds are stored globally so higher-level code + ;; can use openat() to access files within allowed directories. + + ;; FreeBSD-specific system paths + (define *freebsd-system-read-only-paths* + '("/usr/lib" + "/lib" + "/libexec" + ;; TLS certificates + "/etc/ssl" + "/usr/share/certs" + "/etc/ssl/cert.pem" + ;; DNS resolution + "/etc/resolv.conf" + "/etc/hosts" + "/etc/nsswitch.conf" + ;; Terminal + "/usr/share/terminfo" + ;; Devices + "/dev/urandom" + "/dev/random" + "/dev/null" + "/dev/zero" + "/dev/tty" + "/dev/pts" + "/dev/fd" + ;; Timezone + "/etc/localtime" + "/usr/share/zoneinfo" + ;; Locale + "/usr/share/locale" + ;; Shared library config + "/var/run/ld-elf.so.hints")) + + (define *freebsd-system-execute-paths* + '("/usr/bin" + "/bin" + "/usr/local/bin" + "/usr/sbin" + "/sbin" + "/usr/lib" + "/lib" + "/libexec" + "/usr/local/lib")) + + ;; Track pre-opened directory fds for the cage + (define *cage-dir-fds* '()) ;; alist of (path . fd) + + (define c-open-dir + (guard (e [#t #f]) + (foreign-procedure "open" (string int) int))) + + (define (cage-freebsd! cfg) + (unless (capsicum-available?) + (raise (make-cage-error + "cage" + 'platform + "Capsicum not available on this FreeBSD system"))) + + (let* ([root (resolve-path 'cage! (cage-config-root cfg))] + [extra-ro (resolve-paths 'cage! (cage-config-read-only cfg))] + [extra-rw (resolve-paths 'cage! (cage-config-read-write cfg))] + [extra-exec (resolve-paths 'cage! (cage-config-execute cfg))] + [temp (and (cage-config-temp-dir cfg) + (resolve-path 'cage! (cage-config-temp-dir cfg)))] + ;; Build system paths + [sys-ro (case (cage-config-system-paths cfg) + [(auto) (existing-paths *freebsd-system-read-only-paths*)] + [(#f) '()] + [else (cage-config-system-paths cfg)])] + [sys-exec (case (cage-config-system-paths cfg) + [(auto) (existing-paths *freebsd-system-execute-paths*)] + [(#f) '()] + [else '()])] + ;; Collect all paths to pre-open + [rw-paths (append (list root) (if temp (list temp) '()) extra-rw)] + [ro-paths (append sys-ro extra-ro)] + [exec-paths (append sys-exec extra-exec)]) + + ;; Pre-open directories with appropriate Capsicum rights + ;; Read-write directories + (for-each + (lambda (path) + (guard (e [#t (void)]) ;; skip paths that fail to open + (let ([fd (capsicum-open-path path + '(read write seek fstat ftruncate lookup))]) + (set! *cage-dir-fds* + (cons (cons path fd) *cage-dir-fds*))))) + (filter (lambda (p) (guard (e [#t #f]) (file-directory? p))) + rw-paths)) + + ;; Read-only directories + (for-each + (lambda (path) + (guard (e [#t (void)]) + (let ([fd (capsicum-open-path path '(read fstat seek lookup))]) + (set! *cage-dir-fds* + (cons (cons path fd) *cage-dir-fds*))))) + (filter (lambda (p) (guard (e [#t #f]) (file-directory? p))) + ro-paths)) + + ;; Execute directories (need read + lookup for path resolution) + (for-each + (lambda (path) + (guard (e [#t (void)]) + (let ([fd (capsicum-open-path path '(read fstat lookup))]) + (set! *cage-dir-fds* + (cons (cons path fd) *cage-dir-fds*))))) + (filter (lambda (p) (guard (e [#t #f]) (file-directory? p))) + exec-paths)) + + ;; Restrict stdio fds + (guard (e [#t (void)]) + (capsicum-limit-fd! 0 '(read fstat event))) + (guard (e [#t (void)]) + (capsicum-limit-fd! 1 '(write fstat event))) + (guard (e [#t (void)]) + (capsicum-limit-fd! 2 '(write fstat event))) + + ;; Enter capability mode — IRREVERSIBLE + (guard (exn + [#t (raise (make-cage-error + "cage" + 'platform + (if (message-condition? exn) + (condition-message exn) + "cap_enter() failed")))]) + (capsicum-enter!)) + + ;; Record state + (set! *cage-active* #t) + (set! *cage-root-path* root) + (set! *cage-all-paths* + (append + (map (lambda (p) (cons 'read-write p)) rw-paths) + (map (lambda (p) (cons 'read-only p)) ro-paths) + (map (lambda (p) (cons 'execute p)) exec-paths))) + + (void))) + ) ;; end library --- a/tests/test-cage.ss +++ b/tests/test-cage.ss @@ -1,6 +1,24 @@ (import (jerboa prelude)) (import (std security cage)) (import (std security landlock)) +(import (std security capsicum)) + +;; fork-process and waitpid for subprocess tests +(guard (e [#t (void)]) + (load-shared-object "libc.so.7")) +(guard (e [#t (void)]) + (load-shared-object "libc.so.6")) +(define fork-process + (guard (e [#t (lambda () (error 'fork "not available"))]) + (foreign-procedure "fork" () int))) +(define waitpid + (let ([c-waitpid + (guard (e [#t (lambda (pid buf flags) -1)]) + (foreign-procedure "waitpid" (int u8* int) int))]) + (lambda (pid) + (let ([status-buf (make-bytevector 4 0)]) + (let ([result (c-waitpid pid status-buf 0)]) + (values result (bytevector-s32-native-ref status-buf 0))))))) (displayln "=== cage tests ===") @@ -149,6 +167,70 @@ (unless (landlock-available?) (displayln " [skipped — Landlock not available]")) +;; ---- FreeBSD Capsicum cage test ---- + +(displayln "--- FreeBSD Capsicum cage ---") + +(when (capsicum-available?) + ;; Create a temp directory for the cage root + (let ((cage-dir "/tmp/jerboa-cage-test-fb")) + ;; Setup + (when (file-exists? cage-dir) + (system (str "rm -rf " cage-dir))) + (mkdir cage-dir) + (write-file-string (str cage-dir "/hello.txt") "hello from capsicum cage") + + ;; Fork and cage the child + (let ((pid (fork-process))) + (cond + ((= pid 0) + ;; === CHILD === + (guard (exn + (#t + (display "CHILD ERROR: ") + (display-condition exn) + (newline) + (exit 1))) + + ;; Apply cage via Capsicum + (cage! (make-cage-config + 'root: cage-dir + 'system-paths: 'auto + 'temp-dir: "/tmp")) + + ;; Verify cage is active + (assert! (cage-active?)) + (assert! (string? (cage-root))) + + ;; Verify we're in Capsicum capability mode + (assert! (capsicum-in-capability-mode?)) + + ;; Cannot open new files from global namespace (cap_enter blocks this) + (let ((blocked (not #t))) + (guard (exn (#t (set! blocked #t))) + (open-input-file "/etc/passwd")) + (assert! blocked)) + + (displayln " child capsicum cage: ok") + (exit 0))) + + (else + ;; === PARENT === + (let-values (((wpid status) (waitpid pid))) + (let ((exit-code (bitwise-arithmetic-shift-right + (bitwise-and status #xFF00) 8))) + (if (= exit-code 0) + (displayln " capsicum cage! fork test: ok") + (begin + (displayln (str " capsicum cage! fork test: FAILED (exit " exit-code ")")) + (exit 1)))))))) + + ;; Cleanup + (system (str "rm -rf " cage-dir)))) + +(unless (capsicum-available?) + (displayln " [skipped — Capsicum not available]")) + ;; ---- Double-cage prevention ---- (displayln "--- double cage prevention ---") @@ -187,4 +269,38 @@ (unless (landlock-available?) (displayln " [skipped — Landlock not available]")) +;; FreeBSD double-cage prevention +(when (capsicum-available?) + (let ((pid (fork-process))) + (cond + ((= pid 0) + (guard (exn + (#t (display "CHILD ERROR: ") + (display-condition exn) (newline) + (exit 1))) + (let ((cage-dir "/tmp/jerboa-cage-test2-fb")) + (when (file-exists? cage-dir) (system (str "rm -rf " cage-dir))) + (mkdir cage-dir) + (cage! (make-cage-config 'root: cage-dir 'temp-dir: "/tmp")) + ;; Second cage! should raise + (let ((got-error (not #t))) + (try + (cage! (make-cage-config 'root: cage-dir 'temp-dir: "/tmp")) + (catch (e) (set! got-error #t))) + (assert! got-error) + (displayln " FreeBSD double cage blocked: ok") + (exit 0))))) + (else + (let-values (((wpid status) (waitpid pid))) + (let ((exit-code (bitwise-arithmetic-shift-right + (bitwise-and status #xFF00) 8))) + (if (= exit-code 0) + (displayln " FreeBSD double cage test: ok") + (begin + (displayln (str " FreeBSD double cage test: FAILED (exit " exit-code ")")) + (exit 1))))))))) + +(unless (capsicum-available?) + (displayln " [skipped — Capsicum not available]")) + (displayln "=== all cage tests passed ===")