security: complete K3 regression suite

ober

4c32033c725354dc06d262c5a870be559fb157d2

diff --git a/docs/kimi3-security-recommmendations.md b/docs/kimi3-security-recommmendations.md
index b92de4e..9707b0e 100644
--- a/docs/kimi3-security-recommmendations.md
+++ b/docs/kimi3-security-recommmendations.md
@@ -206,7 +206,7 @@ when" must be answerable from `dist/release-evidence/` in minutes.
 | Safe-by-default prelude (no FFI, no `fork-thread`, no `eval`) | `(jerboa prelude safe)`, `(std safe)` | exists; has a known cosmetic import-conflict warning | [safety-guide.md](safety-guide.md) §1 |
 | Allowlist sandbox (closed env, bounded `jerboa-read`) | `(std security restrict)` | exists; `safe-bindings` at `restrict.ss:24` | [security-reference.md](security-reference.md) §2 |
 | In-process bounded eval (engine timeout, result cap, fails closed on process controls) | `(std security sandbox)` `run-safe-eval` | exists; no memory limit, no FFI preemption (documented) | security-reference §6 |
-| Capability tokens (sealed, CSPRNG nonce, monotone attenuation, revocation) | `(std security capability)` | exists; path check is prefix-string based (limitation documented) | [capability.md](capability.md) |
+| Capability tokens (sealed, CSPRNG nonce, monotone attenuation, revocation) | `(std security capability)` | exists; path checks reject symlink escapes and keep create-target compatibility | [security-reference.md](security-reference.md#3-capability-based-security) |
 | Typed capability declarations | `(std security capability-typed)` | exists | security-reference §3 |
 | Taint tracking + safe sinks | `(std security taint)` | exists; opt-in only (limitation documented) | security-reference §4 |
 | Kernel FS confinement (Linux 5.13+, ABI v1–v3) | `(std security landlock)`, `(std os landlock-native)` | real syscalls | security-reference §5 |
@@ -503,15 +503,18 @@ Current tests verify features work; almost none verify *attacks fail*.
 
 - **Where:** new `tests/security/` tree (keeps attack tests separate from
   feature tests), wired into `make test-security`.
-- **Status:** first suite landed 2026-07-27 in
-  `tests/security/test-k3-regressions.ss`. It currently pins restricted eval
-  closure, fail-closed sandbox thunk entry, default-deny network hosts,
-  authenticated actor frame replay/tamper rejection, safe-FASL rejection,
-  bounded actor deserialization, taint sink enforcement, bounded `read`,
-  `gensym`/FFI absence, direct Chez import-audit detection, and URL scheme
-  sanitization. Remaining additions should extend this file or sibling files
-  under `tests/security/`, not scatter attack-shaped tests through feature
-  tests.
+- **Status:** complete for v1. The suite landed and was expanded 2026-07-27
+  in `tests/security/test-k3-regressions.ss`. It pins restricted eval
+  closure, sandbox default-env closure, fail-closed sandbox thunk entry,
+  bounded `run-safe-eval` input/output, degradation refusal without
+  `allow-degraded?`, default-deny network hosts, monotone capability
+  attenuation/intersection, symlink escape rejection, authenticated actor frame
+  replay/tamper rejection, safe-FASL rejection, bounded actor deserialization,
+  taint sink enforcement, bounded `read`, `gensym`/FFI absence, direct Chez
+  import-audit detection, URL scheme sanitization, and P0-02 worker escape,
+  timeout, and fail-closed required-axis behavior. Future attack-shaped tests
+  should extend this file or sibling files under `tests/security/`, not scatter
+  through feature tests.
 - **Do:** One test per historical finding so regressions are impossible:
   sandbox default-env closure (#1 from the AI-attack table), unbounded
   reader budgets (#2/#10), capability intersection attenuation (#3),
diff --git a/docs/security-reference.md b/docs/security-reference.md
index ebb0b72..41eeb37 100644
--- a/docs/security-reference.md
+++ b/docs/security-reference.md
@@ -232,7 +232,10 @@ Access rights are unforgeable tokens (sealed, opaque records with CSPRNG nonces)
 
 - **Sealed records**: cannot be subtyped or inspected via `record-type-descriptor`
 - **CSPRNG nonces**: each capability carries a unique random nonce from `/dev/urandom`
-- **Path canonicalization**: uses `realpath(3)` via FFI to resolve symlinks before path checks
+- **Path canonicalization**: loads libc through the native-loader policy,
+  resolves existing paths with fd/`realpath(3)` checks, rejects existing
+  symlink escapes, and keeps lexical checks only for missing create-target
+  leaves
 - **Default deny for hosts**: empty host list means no hosts allowed (not all allowed)
 - **Intersection**: `with-capabilities` intersects child capabilities against parent per-permission (ANDs booleans, set-intersects lists)
 - **Thread-safe**: nonce generation is mutex-protected; capability context is a thread parameter
@@ -573,8 +576,10 @@ is run by `make test-security`. `tests/security/test-k3-regressions.ss` names
 the K3 finding each check protects, including restricted-eval closure,
 fail-closed sandbox thunk execution, default-deny capability behavior,
 authenticated distributed actor frames, safe FASL rejection, bounded actor
-deserialization, taint sink enforcement, bounded `read`, import auditing, and
-URL scheme sanitization.
+deserialization, taint sink enforcement, bounded `read`, capability
+attenuation/intersection, symlink escape rejection, import auditing,
+run-safe degradation refusal, worker escape/timeouts, and URL scheme
+sanitization.
 
 ---
 
diff --git a/lib/std/security/capability.ss b/lib/std/security/capability.ss
index 52fd847..7858fc1 100644
--- a/lib/std/security/capability.ss
+++ b/lib/std/security/capability.ss
@@ -43,6 +43,7 @@
 
   (import (chezscheme)
           (std crypto random)
+          (only (std native-loader) native-loader-ensure-libc-symbol!)
           (only (jerboa core) def defstruct try catch finally))
 
   ;; ========== Capability Record ==========
@@ -117,14 +118,18 @@
   ;; This closes the race window because the fd pins the inode.
 
   ;; FFI bindings
+  (def _libc
+    (native-loader-ensure-libc-symbol! 'std/security/capability "realpath"))
+
   (def c-open
-    (try (foreign-procedure "open" (string int int) int)
+    (try (foreign-procedure "open" (string int) int)
          (catch (exn) #f)))
 
   (def c-close-fd
     (try (foreign-procedure "close" (int) int)
          (catch (exn) #f)))
 
+  ;; jerboa-security: suppress u8star-ffi-with-foreign-alloc -- c-readlink receives a Scheme bytevector buffer, not a foreign-alloc pointer
   (def c-readlink
     (try (foreign-procedure "readlink" (string u8* size_t) ssize_t)
          (catch (exn) #f)))
@@ -158,12 +163,14 @@
     ;; Falls back to realpath(3) if fd-based resolution is unavailable.
     (if (and c-open c-close-fd)
       (let ([flags (bitwise-ior (if (> O_PATH 0) O_PATH O_RDONLY) O_NOFOLLOW)])
-        (let ([fd (try (c-open path flags 0)
-         (catch (exn) -1))])
+        (let ([fd (try (c-open path flags)
+                       (catch (exn) -1))])
           (if (< fd 0)
-            ;; O_NOFOLLOW failed (symlink or doesn't exist) — reject or fallback
-            ;; If the path doesn't exist, realpath will also fail → return #f
-            (fallback-canonicalize path)
+            ;; O_NOFOLLOW failed. Existing symlink paths must fail closed; a
+            ;; missing leaf may still be lexically checked for create/write use.
+            (if (file-symbolic-link? path)
+                #f
+                (fallback-canonicalize path))
             (dynamic-wind
               (lambda () (void))
               (lambda () (resolve-fd-path fd path))
@@ -188,11 +195,13 @@
         (fallback-canonicalize path)))
 
   (def (fallback-canonicalize path)
-    ;; Fallback: realpath(3) or string-based canonicalization.
+    ;; Fallback for hosts without fd resolution: realpath(3) for existing
+    ;; paths, lexical normalization only for missing create-target leaves.
     (or (and c-realpath
              (try (c-realpath path)
-         (catch (exn) #f)))
-        (canonicalize-path/string-only path)))
+                  (catch (exn) #f)))
+        (and (not (file-exists? path #f))
+             (canonicalize-path/string-only path))))
 
   (def (canonicalize-path/string-only path)
     ;; String-only path canonicalization (resolve . and ..)
diff --git a/tests/security/test-k3-regressions.ss b/tests/security/test-k3-regressions.ss
index b6edc6c..e060a64 100644
--- a/tests/security/test-k3-regressions.ss
+++ b/tests/security/test-k3-regressions.ss
@@ -9,6 +9,7 @@
         (std security sandbox)
         (std security sanitize)
         (std security taint)
+        (std security worker)
         (std security restrict))
 
 (define pass-count 0)
@@ -73,6 +74,124 @@
     (raises? (lambda ()
                (deserialize-authenticated-message receiver frame)))))
 
+(define (string-contains? s sub)
+  (and (string? s)
+       (string? sub)
+       (let ([ns (string-length s)]
+             [nsub (string-length sub)])
+         (let lp ([i 0])
+           (cond
+             [(> (+ i nsub) ns) #f]
+             [(string=? (substring s i (+ i nsub)) sub) #t]
+             [else (lp (+ i 1))])))))
+
+(define (absolute-path path)
+  (cond
+    [(or (not path) (string=? path "")) path]
+    [(char=? (string-ref path 0) #\/) path]
+    [else
+     (let ([cwd (current-directory)])
+       (if (char=? (string-ref cwd (- (string-length cwd) 1)) #\/)
+           (string-append cwd path)
+           (string-append cwd "/" path)))]))
+
+(define (eval-only-config . opts)
+  (apply make-sandbox-config
+         (append '(timeout 1 seccomp #f landlock #f seatbelt #f capsicum #f
+                   max-memory-size #f)
+                 opts)))
+
+(define (permission-value cap key)
+  (cond
+    [(assq key (capability-permissions cap)) => cdr]
+    [else #f]))
+
+(define (capability-attenuation-denies-escalation?)
+  (let* ([cap (make-fs-capability 'read: #t 'write: #f 'paths: '("/tmp"))]
+         [attempt (attenuate-capability cap 'write: #t 'paths: '("/tmp" "/etc"))])
+    (and (not (fs-write? attempt))
+         (equal? (permission-value attempt 'paths) '("/tmp")))))
+
+(define (capability-intersection-denies-escalation?)
+  (let* ([root (current-directory)]
+         [parent (make-fs-capability 'read: #t 'write: #f 'paths: (list root))]
+         [child (make-fs-capability 'read: #t 'write: #t 'paths: (list root "/etc"))]
+         [effective (with-capabilities (list parent)
+                      (lambda ()
+                        (with-capabilities (list child)
+                          (lambda () (current-capabilities)))))])
+    (and (= (length effective) 1)
+         (let ([cap (car effective)])
+           (and (fs-read? cap)
+                (not (fs-write? cap))
+                (equal? (permission-value cap 'paths) (list root)))))))
+
+(define (delete-if-exists path)
+  (guard (exn [#t (void)])
+    (when (or (file-exists? path) (file-symbolic-link? path))
+      (delete-file path))))
+
+(define (capability-symlink-escape-rejected?)
+  (let* ([root "/tmp/jerboa-k3-cap-root"]
+         [link (string-append root "/link")]
+         [cap (make-fs-capability 'read: #t 'write: #f 'paths: (list root))])
+    (guard (exn [#t (delete-if-exists link)
+                    (guard (e [#t (void)]) (delete-directory root))
+                    #t])
+      (delete-if-exists link)
+      (guard (e [#t (void)]) (delete-directory root))
+      (mkdir root)
+      (let ([rc (system (string-append "ln -s /etc/passwd " link))])
+        (if (not (equal? rc 0))
+            #t
+            (let ([ok (not (fs-allowed-path? cap link))])
+              (delete-if-exists link)
+              (guard (e [#t (void)]) (delete-directory root))
+              ok))))))
+
+(define worker-command
+  (list (or (getenv "SCHEME") (absolute-path ".chez/bin/scheme"))
+        "--libdirs"
+        (or (getenv "JERBOA_TEST_LIBDIRS")
+            (string-append (absolute-path "lib") ":"
+                           (absolute-path "vendor/jsqlite/src")))
+        "--script"
+        (absolute-path "support/security-worker-main.ss")))
+
+(define (k3-worker-policy timeout-ms)
+  (worker-policy
+   'command: worker-command
+   'timeout-ms: timeout-ms
+   'stdout-cap-bytes: 65536
+   'stderr-cap-bytes: 65536))
+
+(define (worker-eval-error? expr)
+  (let ([result (worker-run-eval expr (k3-worker-policy 3000))])
+    (and (worker-result? result)
+         (worker-result-launched? result)
+         (not (equal? (worker-result-status result) 0))
+         (string-contains? (worker-result-stdout result) "(error"))))
+
+(define (worker-eval-timeout? expr)
+  (let ([result (worker-run-eval expr (k3-worker-policy 50))])
+    (and (worker-result? result)
+         (worker-result-launched? result)
+         (eq? (worker-result-status result) 'timeout))))
+
+(define (worker-refuses-required-axis?)
+  (let ([result (worker-run-eval
+                 "(+ 1 1)"
+                 (worker-policy
+                  'command: worker-command
+                  'timeout-ms: 3000
+                  'require: '(definitely-unavailable-worker-axis)
+                  'fail-closed?: #t))])
+    (and (worker-result? result)
+         (not (worker-result-launched? result))
+         (equal? (worker-result-status result) 126)
+         (equal? (worker-result-refused-axes result)
+                 '(definitely-unavailable-worker-axis)))))
+
 (check "K3-AI-01 restricted eval blocks system"
        (raises? (lambda () (restricted-eval-string "(system \"true\")"))) => #t)
 (check "K3-P0-03 restricted eval blocks eval"
@@ -87,8 +206,22 @@
        (raises-pred? sandbox-error? (lambda () (run-safe (lambda () 1)))) => #t)
 (check "K3-AI-01 run-safe-eval blocks system"
        (raises-pred? sandbox-error? (lambda () (run-safe-eval "(system \"true\")"))) => #t)
+(check "K3-AI-01 sandbox default environment blocks getenv"
+       (raises-pred? sandbox-error? (lambda () (run-safe-eval "(getenv \"HOME\")" (eval-only-config)))) => #t)
+(check "K3-AI-10 run-safe-eval rejects oversized input"
+       (raises-pred? sandbox-error? (lambda () (run-safe-eval "(+ 1 2)" (eval-only-config 'max-output-size 3)))) => #t)
+(check "K3-AI-10 run-safe-eval rejects oversized output"
+       (raises-pred? sandbox-error? (lambda () (run-safe-eval "\"abcdef\"" (eval-only-config 'max-output-size 4)))) => #t)
+(check "K3-AI-14 run-safe-eval refuses process controls without allow-degraded"
+       (raises-pred? sandbox-error? (lambda () (run-safe-eval "(+ 1 2)" (eval-only-config 'max-memory-size 1024)))) => #t)
 (check "K3-AI-04 empty network host policy denies connects"
        (empty-host-capability-denies-network?) => #f)
+(check "K3-AI-03 attenuate-capability cannot add write or paths"
+       (capability-attenuation-denies-escalation?) => #t)
+(check "K3-AI-03 nested capability scopes intersect permissions"
+       (capability-intersection-denies-escalation?) => #t)
+(check "K3-AI-05 filesystem capability rejects symlink escape"
+       (capability-symlink-escape-rejected?) => #t)
 (check "K3-AI-06 authenticated actor frame rejects replay"
        (authenticated-frame-replay-rejected?) => #t)
 (check "K3-AI-06 authenticated actor frame rejects tampering"
@@ -114,6 +247,14 @@
        (import-audit-blocks-direct-chezscheme?) => #t)
 (check "K3-AI-12 javascript URL attributes are rejected"
        (raises-pred? url-scheme-violation? (lambda () (sanitize-url-attribute "javascript:alert(1)"))) => #t)
+(check "K3-P0-02 worker blocks system escape"
+       (worker-eval-error? "(system \"true\")") => #t)
+(check "K3-P0-02 worker blocks foreign-procedure escape"
+       (worker-eval-error? "(foreign-procedure \"system\" (string) int)") => #t)
+(check "K3-P0-02 worker times out CPU spin"
+       (worker-eval-timeout? "(let loop () (loop))") => #t)
+(check "K3-P0-02 worker refuses unavailable required axis before launch"
+       (worker-refuses-required-axis?) => #t)
 
 (display "  k3-security-regressions: ")
 (display pass-count) (display " passed")