seccomp: add default-allow blocklist + safe-blocklist; sandbox: wire syscalls/capsicum

ober

94244be1e40e2b7850ed2bde356d367b171a500e

diff --git a/lib/std/os/limits/sandbox.ss b/lib/std/os/limits/sandbox.ss
index 968fea4..4736819 100644
--- a/lib/std/os/limits/sandbox.ss
+++ b/lib/std/os/limits/sandbox.ss
@@ -132,7 +132,15 @@
                 process-result-child-status)
           (only (std net allowlist)
                 net-allowlist-target-matches?
-                net-allowlist-host-denial-reason))
+                net-allowlist-host-denial-reason)
+          (only (std security seccomp)
+                seccomp-available?
+                seccomp-install!
+                safe-blocklist
+                compute-only-filter)
+          (only (std security capsicum)
+                capsicum-available?
+                capsicum-enter!))
 
   ;; ---------- Egress policy ----------
 
@@ -278,14 +286,20 @@
        (egress-policy . #f)
        (syscalls      . safe)
        (ptrace?       . #f)
-       (no-new-privs? . #t)))
+       (no-new-privs? . #t)
+       ;; FreeBSD only: opt in to Capsicum capability mode (cap_enter).
+       ;; Drops the global namespace entirely — no opening files or sockets
+       ;; by name after entry.  Strong lockdown for in-process or statically
+       ;; linked work; a dynamically linked child cannot exec afterwards, so
+       ;; this is OFF by default and must be requested explicitly.
+       (capsicum?     . #f)))
 
   (def *sandbox-policy-keys*
     '(read-paths: write-paths: exec-paths:
       deny-read-paths: deny-write-paths: deny-exec-paths:
       net: net-allow: net-connect-ports:
       egress-policy:
-      syscalls: ptrace?: no-new-privs?:))
+      syscalls: ptrace?: no-new-privs?: capsicum?:))
 
   (def (sandbox-policy . args)
     ;; Accepts keyword args (e.g. `'net: 'deny`) to override individual
@@ -527,12 +541,38 @@
                     [(= ret 0) (if has-denies? 'degraded 'installed)]
                     [(= ret 1) 'unavailable]
                     [else 'failed])))
-              (catch (e) 'unavailable))])
+              (catch (e) 'unavailable))]
+           [syscalls-status (linux-seccomp-status pol)])
       `((backend  . landlock)
         (fs       . ,fs-status)
         (exec     . ,fs-status)
         (net      . ,(linux-net-status-for pol net-install? fs-status))
-        (syscalls . degraded))))
+        (syscalls . ,syscalls-status))))
+
+  (def (linux-seccomp-status pol)
+    ;; Install a seccomp-BPF filter matching the policy's `syscalls` axis.
+    ;; Runs in the forked child before exec; the filter is inherited across
+    ;; execve.  Returns 'installed | 'degraded | 'unavailable.
+    ;;
+    ;;   'unrestricted → install nothing (caller opted out); report 'degraded
+    ;;   'safe (default) → default-allow blocklist of dangerous syscalls
+    ;;                     (ptrace, kernel-module/kexec, bpf, perf, mount, …)
+    ;;                     returning EPERM — robust for arbitrary programs.
+    ;;   'minimal      → strict compute-only allowlist (KILL on violation);
+    ;;                   may break programs needing syscalls outside that set.
+    (let ([mode (sandbox-policy-get pol 'syscalls)])
+      (cond
+        [(eq? mode 'unrestricted) 'degraded]
+        [(not (seccomp-available?)) 'unavailable]
+        [else
+         (try
+           (begin
+             (seccomp-install!
+              (case mode
+                [(minimal) compute-only-filter]
+                [else      safe-blocklist]))
+             'installed)
+           (catch (e) 'degraded))])))
 
   (def (prepare-macos! pol)
     ;; In-child sandbox_init works for simple allow-default profiles
@@ -660,15 +700,42 @@
       [else cmd]))
 
   (def (prepare-freebsd! pol)
-    ;; Capsicum is all-or-nothing capability mode.  We can pre-open the
-    ;; declared paths and then enter capsicum.  Without the FFI plumbed
-    ;; in here, we surface degraded so callers know the sandbox is on a
-    ;; weaker footing.
-    `((backend  . capsicum)
-      (fs       . degraded)
-      (exec     . degraded)
-      (net      . ,(net-status-for pol))
-      (syscalls . degraded)))
+    ;; FreeBSD Capsicum is a capability (fd-based) sandbox, not a path-ACL one.
+    ;; cap_enter(2) drops the global namespace: the process can no longer open
+    ;; files or create sockets by name — only already-open fds work.  That is a
+    ;; strong "no new resources" lockdown, but it cannot express per-path
+    ;; allow/deny, and a dynamically linked program cannot exec afterwards (the
+    ;; runtime loader can't open its libraries).  So capability mode is only
+    ;; entered when the caller explicitly opts in via `capsicum?: #t` (intended
+    ;; for in-process or statically linked work); rlimits still apply via the
+    ;; separate limit policy.  Without opt-in we report degraded honestly.
+    (let* ([want? (sandbox-policy-get pol 'capsicum?)]
+           [entered?
+            (and want?
+                 (capsicum-available?)
+                 (try (begin (capsicum-enter!) #t)
+                      (catch (e) #f)))])
+      (cond
+        [entered?
+         ;; In capability mode no new file or socket can be opened by name,
+         ;; which subsumes net=deny and any read/write restriction.
+         `((backend  . capsicum)
+           (fs       . installed)
+           (exec     . degraded)      ;; only statically linked execs survive
+           (net      . installed)
+           (syscalls . degraded))]    ;; Capsicum is not a syscall filter
+        [(and want? (not (capsicum-available?)))
+         `((backend  . capsicum)
+           (fs       . unavailable)
+           (exec     . unavailable)
+           (net      . unavailable)
+           (syscalls . unavailable))]
+        [else
+         `((backend  . capsicum)
+           (fs       . degraded)
+           (exec     . degraded)
+           (net      . ,(net-status-for pol))
+           (syscalls . degraded))])))
 
   (def (prepare-openbsd! pol)
     ;; pledge/unveil — would call into the FFI from (std os sandbox);
diff --git a/lib/std/security/seccomp.ss b/lib/std/security/seccomp.ss
index e8febfd..05c0bc9 100644
--- a/lib/std/security/seccomp.ss
+++ b/lib/std/security/seccomp.ss
@@ -13,7 +13,9 @@
   (export
     ;; Filter construction
     make-seccomp-filter
+    make-seccomp-blocklist
     seccomp-filter?
+    seccomp-filter-kind
     seccomp-filter-default-action
     seccomp-filter-allowed-syscalls
 
@@ -25,6 +27,8 @@
     compute-only-filter
     network-server-filter
     io-only-filter
+    dangerous-syscalls
+    safe-blocklist
 
     ;; Actions
     seccomp-kill
@@ -212,6 +216,45 @@
                (list (bpf-stmt (bitwise-ior BPF_RET BPF_K) SECCOMP_RET_ALLOW)))])
       insns))
 
+  (def (generate-bpf-blocklist blocked-syscall-numbers blocked-action)
+    ;; Default-allow filter: listed (blocked) syscalls return blocked-action,
+    ;; everything else is allowed.  Returns (code jt jf k) tuples.
+    ;;
+    ;;   [0]       LD arch
+    ;;   [1]       JEQ arch → skip 1 (over kill), else fall through to kill
+    ;;   [2]       RET KILL (wrong arch)
+    ;;   [3]       LD syscall_nr
+    ;;   [4..N+3]  JEQ blocked_i → jump to BLOCK (index N+5)
+    ;;   [N+4]     RET ALLOW            (fall-through for non-blocked syscalls)
+    ;;   [N+5]     RET blocked-action
+    (let* ([n (length blocked-syscall-numbers)]
+           [insns
+             (append
+               (list (bpf-stmt (bitwise-ior BPF_LD BPF_W BPF_ABS)
+                               SECCOMP_DATA_ARCH))
+               (list (bpf-jump (bitwise-ior BPF_JMP BPF_JEQ BPF_K)
+                               (current-audit-arch) 1 0))
+               (list (bpf-stmt (bitwise-ior BPF_RET BPF_K)
+                               SECCOMP_RET_KILL_PROCESS))
+               (list (bpf-stmt (bitwise-ior BPF_LD BPF_W BPF_ABS)
+                               SECCOMP_DATA_NR))
+               ;; [4..N+3] For each blocked syscall, JEQ → jump to BLOCK.
+               ;; From index (4+i), BLOCK is at (4+n+1); jt = n - i.
+               (let loop ([syscalls blocked-syscall-numbers] [i 0] [acc '()])
+                 (if (null? syscalls)
+                   (reverse acc)
+                   (loop (cdr syscalls) (+ i 1)
+                         (cons (bpf-jump (bitwise-ior BPF_JMP BPF_JEQ BPF_K)
+                                         (car syscalls)
+                                         (- n i)  ;; jt: jump to BLOCK
+                                         0)        ;; jf: fall through
+                               acc))))
+               ;; [N+4] ALLOW (non-blocked syscalls fall through to here)
+               (list (bpf-stmt (bitwise-ior BPF_RET BPF_K) SECCOMP_RET_ALLOW))
+               ;; [N+5] Blocked action
+               (list (bpf-stmt (bitwise-ior BPF_RET BPF_K) blocked-action)))])
+      insns))
+
   ;; ========== Syscall Tables ==========
 
   ;; x86_64 syscall numbers (Linux)
@@ -242,7 +285,18 @@
       (openat . 257) (newfstatat . 262)
       (set_robust_list . 273) (getrandom . 318)
       (rseq . 334) (clone3 . 435)
-      (close_range . 436) (prlimit64 . 302)))
+      (close_range . 436) (prlimit64 . 302)
+      ;; --- dangerous syscalls (for blocklists / the 'safe profile) ---
+      (ptrace . 101) (personality . 135) (pivot_root . 155)
+      (settimeofday . 164) (mount . 165) (umount2 . 166)
+      (swapon . 167) (swapoff . 168) (reboot . 169)
+      (init_module . 175) (delete_module . 176)
+      (clock_settime . 227) (kexec_load . 246)
+      (add_key . 248) (request_key . 249) (keyctl . 250)
+      (perf_event_open . 298) (setns . 308)
+      (process_vm_readv . 310) (process_vm_writev . 311)
+      (finit_module . 313) (kexec_file_load . 320)
+      (bpf . 321) (userfaultfd . 323)))
 
   ;; aarch64 (ARM64) syscall numbers (Linux)
   ;; ARM64 uses a clean numbering starting from the generic Linux asm-generic/unistd.h.
@@ -275,7 +329,18 @@
       (openat . 56) (newfstatat . 79)
       (set_robust_list . 99) (getrandom . 278)
       (rseq . 293) (clone3 . 435)
-      (close_range . 436) (prlimit64 . 261)))
+      (close_range . 436) (prlimit64 . 261)
+      ;; --- dangerous syscalls (for blocklists / the 'safe profile) ---
+      (ptrace . 117) (personality . 92) (pivot_root . 41)
+      (settimeofday . 170) (mount . 40) (umount2 . 39)
+      (swapon . 224) (swapoff . 225) (reboot . 142)
+      (init_module . 105) (delete_module . 106)
+      (clock_settime . 112) (kexec_load . 104)
+      (add_key . 217) (request_key . 218) (keyctl . 219)
+      (perf_event_open . 241) (setns . 268)
+      (process_vm_readv . 270) (process_vm_writev . 271)
+      (finit_module . 273) (kexec_file_load . 294)
+      (bpf . 280) (userfaultfd . 282)))
 
   ;; Select table based on detected architecture
   (def *syscall-table*
@@ -299,15 +364,27 @@
 
   ;; ========== Filter Record ==========
 
-  (defstruct %seccomp-filter-rec (default-action allowed-syscalls))
+  ;; kind is 'allow (allowlist: listed syscalls permitted, default-action for
+  ;; the rest) or 'block (blocklist: listed syscalls get default-action, all
+  ;; others permitted).  listed-syscalls holds the relevant syscall names.
+  (defstruct %seccomp-filter-rec (kind default-action listed-syscalls))
   (def seccomp-filter? %seccomp-filter-rec?)
   (def %make-seccomp-filter make-%seccomp-filter-rec)
+  (def seccomp-filter-kind %seccomp-filter-rec-kind)
   (def seccomp-filter-default-action %seccomp-filter-rec-default-action)
-  (def seccomp-filter-allowed-syscalls %seccomp-filter-rec-allowed-syscalls)
+  (def seccomp-filter-allowed-syscalls %seccomp-filter-rec-listed-syscalls)
 
   (def (make-seccomp-filter default-action . allowed)
-    ;; allowed: list of syscall name symbols
-    (%make-seccomp-filter default-action allowed))
+    ;; Allowlist: only `allowed` syscalls are permitted; everything else
+    ;; gets default-action (typically seccomp-kill).
+    (%make-seccomp-filter 'allow default-action allowed))
+
+  (def (make-seccomp-blocklist blocked-action . blocked)
+    ;; Blocklist: `blocked` syscalls get blocked-action (e.g. seccomp-errno
+    ;; EPERM or seccomp-kill); everything else is allowed.  This is the robust
+    ;; default-allow shape used by the 'safe profile — it never SIGSYS-kills a
+    ;; program for using an ordinary syscall, only denies the dangerous ones.
+    (%make-seccomp-filter 'block blocked-action blocked))
 
   ;; ========== Availability Check ==========
 
@@ -337,8 +414,10 @@
            [syscall-numbers (map syscall-name->number syscall-names)]
            [default-action (seccomp-filter-default-action filter)])
 
-      ;; Step 3: Generate BPF program
-      (let* ([insns (generate-bpf-program syscall-numbers default-action)]
+      ;; Step 3: Generate BPF program (allowlist or blocklist)
+      (let* ([insns (if (eq? (seccomp-filter-kind filter) 'block)
+                        (generate-bpf-blocklist syscall-numbers default-action)
+                        (generate-bpf-program syscall-numbers default-action))]
              [num-insns (length insns)]
              [filter-size (* num-insns BPF_INSN_SIZE)])
 
@@ -383,6 +462,24 @@
 
   ;; ========== Pre-built Filters ==========
 
+  ;; The "dangerous" syscall set: process introspection, kernel-module and
+  ;; kernel-image loading, perf/bpf, namespace/mount escapes, system clock and
+  ;; reboot.  These are almost never needed by ordinary sandboxed commands but
+  ;; are the primitives used to escape a sandbox or attack the host.
+  (def dangerous-syscalls
+    '(ptrace process_vm_readv process_vm_writev personality
+      kexec_load kexec_file_load init_module finit_module delete_module
+      bpf perf_event_open userfaultfd
+      add_key request_key keyctl
+      pivot_root setns mount umount2
+      swapon swapoff reboot settimeofday clock_settime))
+
+  ;; The 'safe profile: default-allow, deny the dangerous set with EPERM.
+  ;; EPERM (not KILL) so a program that merely probes e.g. perf_event_open
+  ;; sees a clean failure instead of being SIGSYS-killed.
+  (def safe-blocklist
+    (apply make-seccomp-blocklist (seccomp-errno 1) dangerous-syscalls))
+
   (def compute-only-filter
     (make-seccomp-filter seccomp-kill
       'read 'write 'close 'fstat 'mmap 'mprotect