security: inventory ffi audit surface

Jaime Fournier <jaimef@linbsd.org>

0266200afc4d858d6800d9c9e2566a0bc5cd0273

diff --git a/.jerboa-system b/.jerboa-system
index 722b946..1f84577 100644
--- a/.jerboa-system
+++ b/.jerboa-system
@@ -37,6 +37,7 @@
               "tools/capability-plan.ss"
               "tools/check-capability-use.ss"
               "tools/check-native-boundary.ss"
+              "tools/ffi-audit-report.ss"
               "tools/check-install-policy.ss"
               "tools/tcb-report.ss"))
     (libraries ("lib/" "src/" "tools/"))
@@ -91,7 +92,7 @@
                    "restrict-closure-check" "test-worker"
                    "workspace-health" "capability-plan"
                    "capability-use-check" "native-boundary-check"
-                   "install-policy-check" "tcb-report"
+                   "ffi-audit-report" "install-policy-check" "tcb-report"
                    "unification-release-check" "jerboa-smoke" "mcp-test-binary"
                    "jlsp"))
     (outputs ("dist/jerboa" "dist/jerbuild" "dist/jmcp" "dist/jlsp"))
diff --git a/Makefile b/Makefile
index 6c56754..eca5c15 100644
--- a/Makefile
+++ b/Makefile
@@ -108,6 +108,7 @@ help:
 	@echo "  capability-plan Emit machine-readable capability plan"
 	@echo "  capability-use-check Validate source capability use is declared"
 	@echo "  native-boundary-check Validate native Rust/C/FFI boundaries"
+	@echo "  ffi-audit-report Emit machine-readable FFI audit surface"
 	@echo "  install-policy-check Enforce no install-time code policy"
 	@echo "  tcb-report       Emit machine-readable TCB inventory"
 	@echo "  unification-check Run manifest/report/provenance/diff/audit checks"
@@ -383,6 +384,10 @@ capability-use-check:
 native-boundary-check:
 	@$(SCHEME) --libdirs $(LIBDIRS) --script tools/check-native-boundary.ss .jerboa-system
 
+.PHONY: ffi-audit-report
+ffi-audit-report:
+	@$(SCHEME) --libdirs $(LIBDIRS) --script tools/ffi-audit-report.ss
+
 .PHONY: install-policy-check
 install-policy-check:
 	@$(SCHEME) --libdirs $(LIBDIRS) --script tools/check-install-policy.ss .jerboa-system
@@ -392,10 +397,10 @@ tcb-report:
 	@$(SCHEME) --libdirs $(LIBDIRS) --script tools/tcb-report.ss .jerboa-system
 
 .PHONY: unification-check
-unification-check: system-check generated-policy-check workspace-health capability-plan capability-use-check native-boundary-check install-policy-check system-report system-provenance tcb-report system-diff audit-event-check
+unification-check: system-check generated-policy-check workspace-health capability-plan capability-use-check native-boundary-check ffi-audit-report install-policy-check system-report system-provenance tcb-report system-diff audit-event-check
 
 .PHONY: unification-release-check
-unification-release-check: system-strict generated-policy-check workspace-health capability-plan capability-use-check native-boundary-check install-policy-check system-report system-provenance tcb-report system-diff audit-event-check
+unification-release-check: system-strict generated-policy-check workspace-health capability-plan capability-use-check native-boundary-check ffi-audit-report install-policy-check system-report system-provenance tcb-report system-diff audit-event-check
 
 # End-to-end smoke test: all four modes from the single binary + its symlinks.
 jerboa-smoke: jerboa
diff --git a/docs/ffi-audit.md b/docs/ffi-audit.md
new file mode 100644
index 0000000..93f9214
--- /dev/null
+++ b/docs/ffi-audit.md
@@ -0,0 +1,68 @@
+# FFI Audit
+
+Updated 2026-07-27.
+
+This is the committed audit record for K3-P1-01, parser-hardening phase 5.
+Reproduce the current inventory with:
+
+```sh
+make ffi-audit-report
+```
+
+For the full site list:
+
+```sh
+.chez/bin/scheme --libdirs lib:vendor/jsqlite/src --script tools/ffi-audit-report.ss --full
+```
+
+## Current Inventory
+
+Latest summary from `tools/ffi-audit-report.ss`:
+
+```scheme
+(ffi-audit-report
+  (schema "jerboa.ffi-audit/1")
+  (scheme
+    (file-count 1202)
+    (site-count 956)
+    (foreign-procedure 855)
+    (load-shared-object 87)
+    (define-ftype 7)
+    (foreign-callable 7)
+    (pointer-sites 334)
+    (width-sensitive-sites 180)
+    (blocking-candidates 130)
+    (blocking-without-collect-safe 68))
+  (native
+    (rust-file-count 29)
+    (c-file-count 5)
+    (no-mangle-exports 231)
+    (unsafe-sites 432)
+    (unsafe-sites-with-nearby-safety-comment 2)
+    (unsafe-sites-without-nearby-safety-comment 430))
+  (vendor
+    (jsqlite (path "vendor/jsqlite") (status accepted-risk-pending-cve-gate)))
+  (verdict needs-per-binding-review))
+```
+
+## Verdict
+
+K3-P1-01 is now started and reproducibly inventoried, but not complete. The
+current release gate has a machine-readable count of Scheme FFI sites, native
+C/Rust files, Rust C ABI exports, pointer/width-sensitive bindings, blocking
+candidate calls, and unsafe Rust sites.
+
+Remaining work before closing K3-P1-01:
+
+- Review every `foreign-procedure`, `foreign-callable`, and `define-ftype`
+  binding for null returns, bounds derivation, ownership, and GC safety.
+- Convert blocking candidates without `__collect_safe` or justify them as
+  nonblocking.
+- Add targeted scanner rules for null-return checks, integer width confusion,
+  caller-supplied length trust, and bytevector pointer lifetime hazards.
+- Add `SAFETY:` invariant comments near Rust unsafe sites and enable
+  `#![deny(unsafe_op_in_unsafe_fn)]` where supported.
+- Reconcile the 231 Rust `#[no_mangle]` exports with live Scheme callers and
+  unexport or document unused exports.
+- Keep `vendor/jsqlite` in the TCB until consumers move to the Rust sqlite
+  path or release gates include a dedicated CVE freshness check.
diff --git a/docs/index.md b/docs/index.md
index 6345afe..2b2619e 100644
--- a/docs/index.md
+++ b/docs/index.md
@@ -101,6 +101,7 @@ work.
 
 - [native-rust.md](native-rust.md) - Rust native backend and boundary rules
 - [ffi.md](ffi.md) - C FFI DSL, ownership tracking, and callback safety
+- [ffi-audit.md](ffi-audit.md) - current native/FFI audit inventory and remaining remediation gates
 - [wasm.md](wasm.md) - WebAssembly compiler and runtime
 - [wasm-example.md](wasm-example.md) - worked WASM examples
 - [slang.md](slang.md) - secure static subset for hardened binaries
diff --git a/docs/kimi3-security-recommmendations.md b/docs/kimi3-security-recommmendations.md
index fe41d34..9ac940e 100644
--- a/docs/kimi3-security-recommmendations.md
+++ b/docs/kimi3-security-recommmendations.md
@@ -589,6 +589,12 @@ not started."
   per-binding verdict; scanner gains null-check/width/bounds rules; zero
   un-annotated `unsafe`; export count reduced and justified; findings
   fixed or tracked.
+- **Status:** started. `docs/ffi-audit.md` and `tools/ffi-audit-report.ss`
+  now provide a reproducible inventory for Scheme FFI sites, Rust C ABI
+  exports, pointer/width-sensitive bindings, blocking candidates, and unsafe
+  Rust sites. Remaining work: per-binding verdicts, scanner rules for
+  null/width/bounds/GC-safety hazards, unsafe invariant comments, export
+  shrinking/justification, and the `vendor/jsqlite` CVE/replacement decision.
 
 ### K3-P1-02 — TOCTOU-safe filesystem capability checks
 **Serves:** G2. **Effort:** 1 week.
diff --git a/docs/security-reference.md b/docs/security-reference.md
index fd628fa..fbaa0c3 100644
--- a/docs/security-reference.md
+++ b/docs/security-reference.md
@@ -599,7 +599,7 @@ Callers should not treat `allow-degraded?` as successful sandbox installation.
 
 ## 7. Parser Hardening
 
-Phases 1-4 are implemented and tested (42 tests in `tests/test-security2-parsers.ss`). Phase 5 (FFI audit) is not started.
+Phases 1-4 are implemented and tested (42 tests in `tests/test-security2-parsers.ss`). Phase 5 (FFI audit) now has a reproducible inventory in [ffi-audit.md](ffi-audit.md) via `make ffi-audit-report`; per-binding remediation remains open.
 
 ### Depth limits
 
@@ -874,7 +874,7 @@ These are known gaps documented as current limitations, not implementation promi
   `(std crypto native-rust)` / `(std crypto password)`. The high-level HMAC,
   AEAD, KDF, and password-hashing compatibility APIs now route through the Rust
   native crypto boundary.
-- **FFI audit (Phase 5 of parser hardening) is not started.** Null return checks, type validation, and SQL injection lint rules are unimplemented.
+- **FFI audit (Phase 5 of parser hardening) is in progress.** `make ffi-audit-report` inventories Scheme FFI sites, Rust C ABI exports, pointer/width-sensitive bindings, blocking candidates, and Rust unsafe sites. Per-binding null-return, bounds, ownership, GC-safety, and unsafe-invariant review remains open.
 - **No red team evaluation.** No independent adversarial testing has been performed.
 - **Secure memory still exposes a raw region escape hatch.** The high-level
   `secure-bytevector` API is bounds-checked and integrated with
diff --git a/tools/ffi-audit-report.ss b/tools/ffi-audit-report.ss
new file mode 100644
index 0000000..68422c8
--- /dev/null
+++ b/tools/ffi-audit-report.ss
@@ -0,0 +1,238 @@
+#!/usr/bin/env -S scheme --libdirs lib --script
+;;; ffi-audit-report.ss -- summarize Scheme/Rust/C FFI audit surface.
+
+(import (jerboa prelude))
+
+(define skipped-dirs
+  '("." ".." ".git" ".chez" ".chez-static" ".freebsd-sysroot" "build"
+    "dist" "target" "node_modules" "vendor" "fixtures" "lib-cross"))
+
+(define blocking-symbols
+  '("accept" "connect" "kevent" "poll" "ppoll" "read" "recv" "select"
+    "send" "sigwait" "signalfd" "wait" "wait4" "waitpid" "write"))
+
+(define pointer-markers '("void*" "u8*" "uptr" "ptr" "size_t"))
+(define width-markers '("unsigned-64" "integer-64" "size_t" "ssize_t" "long" "unsigned-long"))
+
+(define (usage)
+  (display "Usage: ffi-audit-report.ss [--full]\n")
+  (display "Emit a reproducible FFI audit surface report.\n"))
+
+(define (parse-args args)
+  (cond
+    [(null? args) #f]
+    [(string=? (car args) "--full") #t]
+    [(or (string=? (car args) "-h") (string=? (car args) "--help"))
+     (usage)
+     (exit 0)]
+    [else
+     (display "unknown argument: ") (display (car args)) (newline)
+     (usage)
+     (exit 1)]))
+
+(define (string-contains* str needle)
+  (let ([slen (string-length str)]
+        [nlen (string-length needle)])
+    (let loop ([i 0])
+      (cond
+        [(= nlen 0) #t]
+        [(> (+ i nlen) slen) #f]
+        [(string=? needle (substring str i (+ i nlen))) #t]
+        [else (loop (+ i 1))]))))
+
+(define (contains-any? line needles)
+  (let loop ([xs needles])
+    (and (pair? xs)
+         (or (string-contains* line (car xs))
+             (loop (cdr xs))))))
+
+(define (string-prefix? prefix str)
+  (let ([plen (string-length prefix)]
+        [len (string-length str)])
+    (and (>= len plen)
+         (string=? prefix (substring str 0 plen)))))
+
+(define (string-suffix? suffix str)
+  (let ([slen (string-length suffix)]
+        [len (string-length str)])
+    (and (>= len slen)
+         (string=? suffix (substring str (- len slen) len)))))
+
+(define (join-path dir entry)
+  (let ([n (string-length dir)])
+    (cond
+      [(= n 0) entry]
+      [(char=? (string-ref dir (- n 1)) #\/) (string-append dir entry)]
+      [else (string-append dir "/" entry)])))
+
+(define (skip-dir? entry)
+  (or (member entry skipped-dirs)
+      (string-prefix? ".chez-cross-" entry)))
+
+(define (walk-files root pred)
+  (let ([out '()])
+    (define (walk path)
+      (when (file-directory? path)
+        (for-each
+          (lambda (entry)
+            (let ([full (join-path path entry)])
+              (cond
+                [(and (file-directory? full)
+                      (not (file-symbolic-link? full))
+                      (not (skip-dir? entry)))
+                 (walk full)]
+                [(and (file-exists? full)
+                      (not (file-symbolic-link? full))
+                      (not (file-directory? full))
+                      (pred full))
+                 (set! out (cons full out))])))
+          (directory-list path))))
+    (walk root)
+    (reverse out)))
+
+(define (read-lines path)
+  (call-with-input-file path
+    (lambda (in)
+      (let loop ([out '()])
+        (let ([line (get-line in)])
+          (if (eof-object? line)
+              (reverse out)
+              (loop (cons line out))))))))
+
+(define (scheme-kind line)
+  (cond
+    [(string-contains* line "foreign-procedure") 'foreign-procedure]
+    [(string-contains* line "load-shared-object") 'load-shared-object]
+    [(string-contains* line "define-ftype") 'define-ftype]
+    [(string-contains* line "foreign-callable") 'foreign-callable]
+    [else #f]))
+
+(define (blocking-candidate? line)
+  (contains-any? line blocking-symbols))
+
+(define (scheme-sites path)
+  (guard (exn [else '()])
+    (let loop ([lines (read-lines path)] [n 1] [out '()])
+      (cond
+        [(null? lines) (reverse out)]
+        [(scheme-kind (car lines))
+         => (lambda (kind)
+              (let ([line (car lines)])
+                (loop (cdr lines)
+                      (+ n 1)
+                      (cons `(site (path ,path)
+                                   (line ,n)
+                                   (kind ,kind)
+                                   (pointer-args ,(contains-any? line pointer-markers))
+                                   (width-sensitive ,(contains-any? line width-markers))
+                                   (blocking-candidate ,(blocking-candidate? line))
+                                   (collect-safe ,(string-contains* line "__collect_safe"))
+                                   (snippet ,line))
+                            out))))]
+        [else (loop (cdr lines) (+ n 1) out)]))))
+
+(define (line-at lines index)
+  (if (and (>= index 0) (< index (length lines)))
+      (list-ref lines index)
+      ""))
+
+(define (near-safety-comment? lines zero-index)
+  (or (string-contains* (line-at lines (- zero-index 1)) "SAFETY:")
+      (string-contains* (line-at lines (- zero-index 1)) "Safety:")
+      (string-contains* (line-at lines (- zero-index 2)) "SAFETY:")
+      (string-contains* (line-at lines (- zero-index 2)) "Safety:")))
+
+(define (rust-sites path)
+  (guard (exn [else '()])
+    (let ([lines (read-lines path)])
+      (let loop ([rest lines] [zero 0] [out '()])
+        (cond
+          [(null? rest) (reverse out)]
+          [else
+           (let* ([line (car rest)]
+                  [no-mangle? (or (string-contains* line "#[no_mangle]")
+                                  (string-contains* line "no_mangle"))]
+                  [unsafe? (string-contains* line "unsafe")]
+                  [out* (if no-mangle?
+                            (cons `(rust-site (path ,path) (line ,(+ zero 1))
+                                              (kind no-mangle) (snippet ,line))
+                                  out)
+                            out)]
+                  [out** (if unsafe?
+                             (cons `(rust-site (path ,path) (line ,(+ zero 1))
+                                               (kind unsafe)
+                                               (safety-comment ,(near-safety-comment? lines zero))
+                                               (snippet ,line))
+                                   out*)
+                             out*)])
+             (loop (cdr rest) (+ zero 1) out**))])))))
+
+(define (count-if pred xs)
+  (let loop ([rest xs] [n 0])
+    (cond
+      [(null? rest) n]
+      [(pred (car rest)) (loop (cdr rest) (+ n 1))]
+      [else (loop (cdr rest) n)])))
+
+(define (site-kind site)
+  (cadr (assq 'kind (cdr site))))
+
+(define (site-bool site key)
+  (cadr (assq key (cdr site))))
+
+(define (kind-count sites kind)
+  (count-if (lambda (site) (eq? (site-kind site) kind)) sites))
+
+(define (report full?)
+  (let* ([scheme-files (walk-files "."
+                         (lambda (p)
+                           (or (string-suffix? ".ss" p)
+                               (string-suffix? ".sls" p))))]
+         [rust-files (walk-files "." (lambda (p) (string-suffix? ".rs" p)))]
+         [c-files (walk-files "."
+                    (lambda (p)
+                      (or (string-suffix? ".c" p)
+                          (string-suffix? ".h" p))))]
+         [scheme (apply append (map scheme-sites scheme-files))]
+         [rust (apply append (map rust-sites rust-files))]
+         [unsafe-count (kind-count rust 'unsafe)]
+         [unsafe-commented (count-if
+                             (lambda (site)
+                               (and (eq? (site-kind site) 'unsafe)
+                                    (site-bool site 'safety-comment)))
+                             rust)])
+    (write
+      `(ffi-audit-report
+         (schema "jerboa.ffi-audit/1")
+         (scheme
+           (file-count ,(length scheme-files))
+           (site-count ,(length scheme))
+           (foreign-procedure ,(kind-count scheme 'foreign-procedure))
+           (load-shared-object ,(kind-count scheme 'load-shared-object))
+           (define-ftype ,(kind-count scheme 'define-ftype))
+           (foreign-callable ,(kind-count scheme 'foreign-callable))
+           (pointer-sites ,(count-if (lambda (s) (site-bool s 'pointer-args)) scheme))
+           (width-sensitive-sites ,(count-if (lambda (s) (site-bool s 'width-sensitive)) scheme))
+           (blocking-candidates ,(count-if (lambda (s) (site-bool s 'blocking-candidate)) scheme))
+           (blocking-without-collect-safe
+             ,(count-if (lambda (s)
+                          (and (site-bool s 'blocking-candidate)
+                               (not (site-bool s 'collect-safe))))
+                        scheme)))
+         (native
+           (rust-file-count ,(length rust-files))
+           (c-file-count ,(length c-files))
+           (no-mangle-exports ,(kind-count rust 'no-mangle))
+           (unsafe-sites ,unsafe-count)
+           (unsafe-sites-with-nearby-safety-comment ,unsafe-commented)
+           (unsafe-sites-without-nearby-safety-comment
+             ,(- unsafe-count unsafe-commented)))
+         (vendor
+           (jsqlite (path "vendor/jsqlite") (status accepted-risk-pending-cve-gate)))
+         (verdict needs-per-binding-review)
+         ,@(if full?
+               `((scheme-sites ,scheme) (rust-sites ,rust))
+               '())))
+    (newline)))
+
+(report (parse-args (command-line-arguments)))