build: fetch vendor repos at build time
ober
424a01521f416801d2e8df5c2b75f88b6c225bbf
--- a/.gitignore +++ b/.gitignore @@ -28,3 +28,10 @@ gui-snapshots.tar.gz lib/libjerboa_native.* lib/libyubikey_native.* **/*.sls + +# Build-time vendor checkouts. These are fetched and lock-verified by +# support/ensure-vendor.sh; do not commit repository copies here. +/vendor/jerboa-fuse/ +/vendor/jerboa-yubikey/ +/vendor/.jerboa-fuse.tmp.*/ +/vendor/.jerboa-yubikey.tmp.*/ --- a/Makefile +++ b/Makefile @@ -8,12 +8,20 @@ JERBUILD ?= $(JERBOA_TOOL_DIR)/jerbuild # Recursive on purpose: check-jerbuild may install the pinned local tool before # recipes expand this value. JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) +JERBOA_NATIVE_CRATE_DIR := $(JH)/jerboa-native-rs +JERBOA_NATIVE_A ?= $(JERBOA_NATIVE_CRATE_DIR)/target/release/libjerboa_native.a +export JERBOA_NATIVE_A +JERBOA_FUSE_URL ?= https://git.sr.ht/~lisp/jerboa-fuse +JERBOA_FUSE_COMMIT ?= 7a51f44b68c681f59f21a918770c48268cb3d82f +JERBOA_FUSE_TREE ?= 732b29b042aee8bef2fe4131fa2d12f467a10599 +JERBOA_FUSE_DIR := vendor/jerboa-fuse +JERBOA_FUSE_LIB := $(JERBOA_FUSE_DIR)/lib JERBOA_YUBIKEY_URL ?= https://git.sr.ht/~lisp/jerboa-yubikey JERBOA_YUBIKEY_COMMIT ?= e448afca926ca9ad40fd98effa8d6264cb1019f5 JERBOA_YUBIKEY_TREE ?= 67e4417511b63c0b41b1b9c5dc1c7d897df51f08 JERBOA_YUBIKEY_DIR := vendor/jerboa-yubikey JERBOA_YUBIKEY_LIB := $(JERBOA_YUBIKEY_DIR)/lib -JEXEC = JERBOA_BROWSER_DEV_NATIVE=1 JERBOA_BROWSER_LIB=$(CURDIR)/qt-webengine/build/libjerboa_browser.$(SOEXT) $(JERBUILD) exec --libdirs $(CURDIR)/$(JERBOA_YUBIKEY_LIB):$(CURDIR)/scheme:$(CURDIR)/vendor/jerboa-fuse/lib:$(JH)/lib +JEXEC = JERBOA_BROWSER_DEV_NATIVE=1 JERBOA_BROWSER_LIB=$(CURDIR)/qt-webengine/build/libjerboa_browser.$(SOEXT) $(JERBUILD) exec --libdirs $(CURDIR)/$(JERBOA_YUBIKEY_LIB):$(CURDIR)/scheme:$(CURDIR)/$(JERBOA_FUSE_LIB):$(JH)/lib JERBUILD_ERROR := "ERROR: jerbuild unavailable (or '$(JERBUILD) --jerboa-home' failed). Run make ensure-jerboa-tools, install jerbuild, or set JERBUILD=/path/to/jerbuild." BIN_DIR ?= $(HOME)/.local/bin BIN ?= jerboa-browser @@ -69,12 +77,19 @@ lib/libjerboa_native.$(SOEXT): FORCE | check-jerbuild if [ -f "$$src" ]; then ln -sf "$$src" "$@" && echo "staged $@ -> $$src"; \ else echo "note: libjerboa_native.$(SOEXT) unavailable; crypto tests may fail"; fi -$(FUSE_SHIM): vendor/jerboa-fuse/src/mount_helper.c support/browser_secure_fs.c support/browser_secure_fs.h +$(FUSE_SHIM): vendor-fuse $(JERBOA_FUSE_DIR)/src/mount_helper.c support/browser_secure_fs.c support/browser_secure_fs.h $(CC) $(FUSE_SHARED_FLAG) -fPIC -O2 -Wall -Wextra -Werror \ $(FUSE_OPENSSL_CFLAGS) -I support -o $@ \ - vendor/jerboa-fuse/src/mount_helper.c support/browser_secure_fs.c \ + $(JERBOA_FUSE_DIR)/src/mount_helper.c support/browser_secure_fs.c \ $(FUSE_OPENSSL_LIBS) +vendor-fuse: check-jerbuild + sh support/ensure-vendor.sh jerboa-fuse "$(JERBOA_FUSE_URL)" \ + "$(JERBOA_FUSE_COMMIT)" "$(JERBOA_FUSE_TREE)" + $(MAKE) -C "$(JERBOA_FUSE_DIR)" JERBUILD="$(JERBUILD)" transpile + @test -f "$(JERBOA_FUSE_LIB)/jerboa-fuse/mount.sls" || \ + { echo "ERROR: missing $(JERBOA_FUSE_LIB)/jerboa-fuse/mount.sls" >&2; exit 1; } + vendor-yubikey: sh support/ensure-vendor.sh jerboa-yubikey "$(JERBOA_YUBIKEY_URL)" \ "$(JERBOA_YUBIKEY_COMMIT)" "$(JERBOA_YUBIKEY_TREE)" @@ -91,7 +106,7 @@ lib/libyubikey_native.$(SOEXT): vendor-yubikey yubikey-native: lib/libyubikey_native.$(SOEXT) -.PHONY: all build binary install run test test-all test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-pass test-polish test-securestore test-adblock test-gui test-buffers test-native test-supply-chain test-native-loader repl security audit sbom reproducibility-report binary-smoke webengine-sandbox-evidence verify release-evidence clean help check-jerbuild check-podman ensure-jerboa-tools static-qt podman-static-qt vendor-yubikey yubikey-native lint +.PHONY: all build binary install run test test-all test-keymap test-minibuffer test-commands test-keys test-nav test-hint test-pass test-polish test-securestore test-adblock test-gui test-buffers test-native test-supply-chain test-native-loader repl security audit sbom reproducibility-report binary-smoke webengine-sandbox-evidence verify release-evidence clean help check-jerbuild check-podman ensure-jerboa-tools static-qt podman-static-qt native-static vendor-fuse vendor-yubikey yubikey-native lint .DEFAULT_GOAL := help all: binary @@ -128,7 +143,16 @@ check-podman: { echo "ERROR: Podman executable '$(PODMAN)' is installed but not reachable. On macOS/Windows, run 'podman machine start' and retry."; exit 1; } # Build the self-contained native ./jerboa-browser via .jerbuild. -binary: check-jerbuild vendor-yubikey $(FUSE_SHIM) +native-static: check-jerbuild + @if [ ! -f "$(JERBOA_NATIVE_A)" ]; then \ + test -f "$(JERBOA_NATIVE_CRATE_DIR)/Cargo.toml" || \ + { echo "ERROR: missing Jerboa native crate: $(JERBOA_NATIVE_CRATE_DIR)" >&2; exit 1; }; \ + echo "building $(JERBOA_NATIVE_A) via cargo (one-time)..."; \ + $(CARGO) build --locked --release --no-default-features --features crypto \ + --manifest-path "$(JERBOA_NATIVE_CRATE_DIR)/Cargo.toml"; \ + fi + +binary: check-jerbuild native-static vendor-yubikey $(FUSE_SHIM) $(JERBUILD) build @echo "" && ls -lh jerboa-browser && file jerboa-browser @@ -145,7 +169,7 @@ install: binary # The crypto-using interpreter suites load (std crypto native-rust), so stage the # Rust crypto lib (rule above) as a prerequisite of each. test-securestore test-commands test-keys test-nav test-hint test-pass test-polish test-adblock: lib/libjerboa_native.$(SOEXT) vendor-yubikey -test test-keymap test-minibuffer test-gui test-buffers repl: check-jerbuild vendor-yubikey +test test-keymap test-minibuffer test-gui test-buffers repl: check-jerbuild vendor-fuse vendor-yubikey # Run the (browser) test suite in the interpreter (no binary needed). Depends on # the pure secure-store unit tests so they run as part of `make test`. --- a/scheme/browser.ss +++ b/scheme/browser.ss @@ -104,11 +104,134 @@ partition make-date make-time) (except (jerboa prelude) meta atom?) - (jerboa ffi) - (only (std native-loader) - native-loader-privileged? - native-loader-development-enabled? - native-loader-validate-library!)) + (jerboa ffi)) + + (def browser-native-loader-st-mode #o170000) + (def browser-native-loader-st-dir #o040000) + (def browser-native-loader-st-reg #o100000) + (def browser-native-loader-stat-size 256) + (def browser-native-loader-path-max 4096) + (def browser-native-loader-machine (symbol->string (machine-type))) + (def browser-native-loader-macos? + (let loop ([index 0]) + (cond + [(> (+ index 3) (string-length browser-native-loader-machine)) #f] + [(string=? (substring browser-native-loader-machine index (+ index 3)) "osx") #t] + [else (loop (+ index 1))]))) + + (def browser-native-getuid (c-lambda () unsigned-int "getuid")) + (def browser-native-geteuid (c-lambda () unsigned-int "geteuid")) + (def browser-native-getgid (c-lambda () unsigned-int "getgid")) + (def browser-native-getegid (c-lambda () unsigned-int "getegid")) + (def browser-native-realpath (c-lambda (string u8*) void* "realpath")) + (def browser-native-lstat (c-lambda (string u8*) int "lstat")) + + (def (native-loader-privileged?) + (let ([uid (browser-native-getuid)] + [euid (browser-native-geteuid)] + [gid (browser-native-getgid)] + [egid (browser-native-getegid)]) + (or (= uid 0) (= euid 0) + (not (= uid euid)) + (not (= gid egid))))) + + (def (native-loader-development-enabled? variable) + (and (not (native-loader-privileged?)) + (let ([value (getenv variable)]) + (and value (string=? value "1"))))) + + (def (browser-native-absolute-path? path) + (and (string? path) + (> (string-length path) 1) + (char=? (string-ref path 0) #\/))) + + (def (browser-native-contains-nul? value) + (let loop ([index 0]) + (cond + [(= index (string-length value)) #f] + [(char=? (string-ref value index) #\nul) #t] + [else (loop (+ index 1))]))) + + (def (browser-native-realpath* path) + (let ([buffer (make-bytevector browser-native-loader-path-max 0)]) + (let ([result (browser-native-realpath path buffer)]) + (and (not (= result 0)) + (let loop ([index 0] [chars '()]) + (cond + [(= index browser-native-loader-path-max) #f] + [(= (bytevector-u8-ref buffer index) 0) + (list->string (reverse chars))] + [else + (loop (+ index 1) + (cons (integer->char (bytevector-u8-ref buffer index)) + chars))])))))) + + (def (browser-native-path-prefixes path) + (let ([length (string-length path)]) + (let loop ([index 1] [start 1] [prefix ""] [result (list "/")]) + (cond + [(= index length) + (reverse + (cons (string-append prefix "/" (substring path start index)) + result))] + [(char=? (string-ref path index) #\/) + (let ([next (string-append prefix "/" (substring path start index))]) + (loop (+ index 1) (+ index 1) next (cons next result)))] + [else (loop (+ index 1) start prefix result)])))) + + (def (browser-native-stat-mode buffer) + (if browser-native-loader-macos? + (bytevector-u16-native-ref buffer 4) + (bytevector-u32-native-ref buffer 24))) + + (def (browser-native-stat-uid buffer) + (bytevector-u32-native-ref buffer (if browser-native-loader-macos? 16 28))) + + (def (browser-native-validate-component! who path final? final-type development?) + (let ([buffer (make-bytevector browser-native-loader-stat-size 0)]) + (unless (= (browser-native-lstat path buffer) 0) + (error who "native path component could not be inspected" path)) + (let* ([mode (browser-native-stat-mode buffer)] + [type (bitwise-and mode browser-native-loader-st-mode)] + [owner (browser-native-stat-uid buffer)] + [euid (browser-native-geteuid)]) + (unless (or (= owner 0) (= owner euid)) + (error who "native path component has an unexpected owner" path owner euid)) + (when (or (not (= (bitwise-and mode #o002) 0)) + (and (not (= (bitwise-and mode #o020) 0)) + (not (and development? (= owner euid) + (not (native-loader-privileged?)))))) + (error who "native path component is group/world-writable" + path (bitwise-and mode #o7777))) + (unless (= type (if final? final-type browser-native-loader-st-dir)) + (error who + (if final? + "native path has the wrong file type" + "native path ancestor is not a real directory") + path))))) + + (def (browser-native-validate-path! who path final-type development?) + (unless (and (browser-native-absolute-path? path) + (not (browser-native-contains-nul? path))) + (error who "native path must be an absolute non-empty pathname" path)) + (let ([canonical (browser-native-realpath* path)]) + (unless (and canonical (string=? canonical path)) + (error who + "native path must be canonical and contain no symbolic-link components" + path canonical))) + (let loop ([remaining (browser-native-path-prefixes path)]) + (unless (null? remaining) + (browser-native-validate-component! + who (car remaining) (null? (cdr remaining)) final-type development?) + (loop (cdr remaining)))) + path) + + (def* native-loader-validate-library! + ((who path) + (browser-native-validate-path! who path browser-native-loader-st-reg #f)) + ((who path development?) + (browser-native-validate-path! + who path browser-native-loader-st-reg (and development? #t)))) ;; --- load the backend dylib -------------------------------------------- ;; This MUST precede the define-c-lambda binds: foreign-procedure resolution --- a/support/ensure-vendor.sh +++ b/support/ensure-vendor.sh @@ -47,6 +47,31 @@ install_consumer_overlay() { fi cp -f "$lock_overlay" "$destination/yubikey-native/Cargo.lock" cmp -s "$lock_overlay" "$destination/yubikey-native/Cargo.lock" + elif [ "$name" = jerboa-fuse ]; then + source_overlay="$script_dir/jerboa-fuse-browser-overlay.patch" + [ -f "$source_overlay" ] || { + echo "ERROR: missing consumer-owned jerboa-fuse overlay" >&2 + exit 1 + } + destination_abs=$(CDPATH= cd -- "$destination" && pwd) + case "$destination_abs" in + "$repo_root"/*) destination_rel=${destination_abs#"$repo_root"/} ;; + *) + echo "ERROR: vendor destination escaped repository root" >&2 + exit 1 + ;; + esac + if git -C "$repo_root" apply --reverse --check \ + --directory="$destination_rel" "$source_overlay" >/dev/null 2>&1; then + : # already overlaid + elif git -C "$repo_root" apply --check \ + --directory="$destination_rel" "$source_overlay"; then + git -C "$repo_root" apply \ + --directory="$destination_rel" "$source_overlay" + else + echo "ERROR: jerboa-fuse overlay does not match pinned base" >&2 + exit 1 + fi fi } new file mode 100644 --- /dev/null +++ b/support/jerboa-fuse-browser-overlay.patch @@ -0,0 +1,2931 @@ +diff --git a/.gitignore b/.gitignore +index e63d98d..8b502f4 100644 +--- a/.gitignore ++++ b/.gitignore +@@ -1,11 +1,4 @@ + *.so + *.wpo + *.dylib +-*.o + .jerbuild-hashes +-.jerboa/* +-!.jerboa/ +-!.jerboa/security.json +-dist/ +-tests/tmp/ +-lib/ +diff --git a/AGENTS.md b/AGENTS.md +index 0f5b749..ca30460 100644 +--- a/AGENTS.md ++++ b/AGENTS.md +@@ -1,34 +1,3 @@ +-## STOP: Editing `.ss`/`.sls` Files — Mandatory Rules +- +-These rules exist because local-model sessions have lost **hours** fighting +-parenthesis imbalances that these rules would have prevented in seconds. +-They override every habit from other editors and languages. +- +-1. **NEVER use `edit`, `write`, `sed`, `python`, `perl`, or `awk` to modify +- `*.ss` or `*.sls` files.** Use the jerboa-mcp tools instead: +- - Add a top-level form → `jerboa_balanced_insert` (anchor = one unique +- complete form, e.g. the `def` above the insertion point). +- - Replace exact text → `jerboa_balanced_replace`. It is **dry-run by +- default** — pass `dry_run: false` to actually write. +- - Create a whole new file → `jerboa_write_file` (use `verify: true` to +- reject unbalanced content before it lands). +-2. **After EVERY `.ss` change, run `jerboa_check_balance` before building.** +- The balanced tools check automatically; if you bypassed them, check now. +-3. **If a file ever becomes unbalanced, STOP.** Do NOT count parens by hand, +- do NOT write paren-counting scripts, do NOT poke one character at a time. +- Recovery is exactly one of: +- - `git checkout -- <file>` and redo the edit with `jerboa_balanced_insert` +- (preferred — one command, seconds), or +- - `jerboa_repair_balance` (dry-run shows the plan; `apply: true` writes). +-4. **Keep closer-runs short.** Never hand-write code that ends in more than +- ~4 consecutive closers (`))))]` runs). Flatten deep nesting with helper +- `def`s, `let*`, or cond `=>` clauses so no edit ever depends on counting +- a long `)` run. +-5. **`(def ...)` after an expression in a body is invalid.** Internal defines +- must come first in a body, or use `let`/`let*`. The build error +- "invalid context for definition" means you violated this — or a missing +- paren above glued two top-level forms together (check balance first). +- + ## The Jerboa Language — Quick Reference + + Jerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files. +@@ -48,7 +17,7 @@ Every Jerboa file looks like this: + (displayln (my-function 1 2)) + ``` + +-Run with: `~/.local/bin/jerboa run file.ss` (or `jerboa run file.ss` if `~/.local/bin` is on your PATH). ++Run with: `scheme --libdirs lib --script file.ss` + + **NEVER** write `(library ...)` forms — that's `.sls` internal syntax. + +@@ -121,7 +90,7 @@ The following names from other Scheme dialects are aliased in `(jerboa prelude)` + - `(string-split str delimiter)` where delimiter is a CHAR: `(string-split "a,b" #\,)` + - `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not) + - `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg) +-- `(sort list predicate)` — Jerboa `(std sort)`/prelude order. Raw Chez `sort` is predicate-first, but Jerboa-facing code should use list first. ++- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order + + ### Core Forms (all from `(import (jerboa prelude))`) + +@@ -372,30 +341,13 @@ When working in a Jerboa project, **ONLY modify files in the current repo** unle + + Common sibling repos that exist but must NOT be touched without explicit instruction: + - `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it. +-- `~/mine/jerboa-mcp` — Legacy node MCP, superseded. The active MCP server now lives in THIS repo at `mcp/` + `data/`. Don't modify the legacy repo unless told. ++- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there. + - `~/mine/jerboa-shell` — Only modify when user explicitly says to work there. + - `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated. + - `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify. + + If a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo. + +-### Never Reference Sibling Checkouts in Build Files +- +-Build files (Makefile, shell scripts, CI config) must **never** resolve a +-dependency via a relative sibling path (`../jerboa-foo`) or an absolute +-`~/mine/jerboa-foo` path. That layout is specific to this one machine — +-other users and CI do not have it. Always vendor instead: fetch/clone the +-dependency into `vendor/` (or this repo's equivalent) at build time, or use +-a pinned-release fetch script, so the build is reproducible without +-assuming any sibling checkout exists. +- +-A sibling-path fallback is not just a portability bug: it can silently +-substitute a full alternate source tree (build config, embedded data, +-secrets) for the vendored one, with no equivalent safety default, changing +-what actually gets built without any indication. If you find one +-(`grep -rn '\.\./jerboa\|~/mine/jerboa'` over Makefiles/scripts), remove it +-and vendor properly instead. +- + --- + + ## Build & Verification +@@ -410,22 +362,6 @@ find lib -name "*.so" -delete && find lib -name "*.wpo" -delete && make build + ``` + Run `jerboa_stale_static` to detect stale `.so` files before debugging "why doesn't my edit work?". + +-## Pre-commit Requirements +- +-**ALWAYS** run a clean build **before** committing any code to this repository. Pick the right target for the *current* platform: +- +-- **Linux**: run `make docker-build` — the Docker image must build cleanly against the full musl-static release pipeline. +-- **macOS / FreeBSD / other**: run `make binary` — the native local build must succeed. Do **not** run `make docker-build` here; Docker on non-Linux hosts is slow and not the canonical pipeline for those platforms. +- +-Do not commit if the build fails. +- +-## Act First, Read Less +- +-When making changes, read only what you need to make the edit, then make it. +-Do not read more than 3 files before acting. Do not re-read files you already +-read. Do not verify things you already know. If you have enough context to make +-a change, make it. The user will interrupt you if you are wrong. +- + ## Jerboa MCP Tools — MANDATORY Usage + + Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool. +@@ -453,16 +389,13 @@ Jerboa is a niche Scheme dialect with limited training data. **Never guess — a + | Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity | + | Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` | + | Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` | +-| Run tests | `jerboa_run_tests` — prefer over ad hoc shell test invocations | ++| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` | + | Check for stale .so artifacts | `jerboa_stale_static` — common cause of "edit has no effect" | + | Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` | + | Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature | + | FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` | + | Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` | + | Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits | +-| Edit a `.ss` file | `jerboa_balanced_insert` / `jerboa_balanced_replace` — NEVER raw `edit`/`sed`/`python` (see top of file) | +-| Create a `.ss` file | `jerboa_write_file` — whole-file atomic write, `verify: true` rejects unbalanced content | +-| File already unbalanced | `jerboa_repair_balance` — dry-run repair plan; or `git checkout -- <file>` and redo with `balanced_insert` | + | Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates | + | Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` | + | Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` | +@@ -476,13 +409,10 @@ Jerboa is a niche Scheme dialect with limited training data. **Never guess — a + - **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial) + - **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work + - **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes +-- **`jerboa_anti_pattern_lookup`**: Search reusable local-model mistakes and failed strategies +- +-**The knowledge base is `data/*.sexp` in THIS repo**, embedded into `jmcp` at build time. The write tools above edit it live — the server reads `data/` from disk first, with the embedded copy as fallback (`JERBOA_MCP_REPO` points every client at this repo). When you add a stdlib/language feature, also update `data/` (a cookbook recipe + `api-signatures.sexp` + `changelog.sexp`) and **commit it**. Run `make jmcp` (or `make jmcp-portable`) only to refresh the embedded copy shipped in portable binaries. + + ### Code Generation & Refactoring + +-`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_balanced_insert`, `jerboa_write_file`, `jerboa_repair_balance`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold` ++`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold` + + ### Feature Suggestions + +@@ -503,25 +433,6 @@ Jerboa is niche — every non-trivial pattern you discover prevents future sessi + + **Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives). + +-### Save anti-patterns (`data/anti-patterns.sexp`) whenever you: +-- See a plausible local-model strategy that failed verification +-- Find a weak verifier pattern that allowed false success +-- See a repeated repair loop, such as broad-reading after a concrete error +-- Find a generic runtime mistake, such as missing lower-bound checks before vector access +- +-**Before saving**: check `jerboa_anti_pattern_lookup` to avoid duplicates. If none exists, call `jerboa_anti_pattern_add`; only edit `data/anti-patterns.sexp` directly if the writer tool is unavailable. Save the normalized reusable mistake, not the whole trace or benchmark name. +- +-**Anti-pattern format**: `id`, `title`, `kinds`, `severity`, `tags`, `pattern`, `avoid`, `advice`, `tools`. +- +-### Save error fixes (`jerboa_error_fix_add`) whenever you: +-- See exact compiler/runtime/verifier text with a repeatable repair +-- Hit an error that `jerboa_failure_advisor` should classify better next time +-- Debug a local-model generated-code failure where a short diagnosis prevents another failed iteration +- +-**Before saving**: check `jerboa_error_fix_lookup` with the exact error text. **Do NOT save**: one-off project business-logic mistakes. +- +-**Error-fix format**: `id`, `pattern`, `fix`; optional `type`, `explanation`, `code_example`. +- + ### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you: + - Make multiple sequential tool calls that could be one tool + - Fall back to bash because an MCP tool is missing or insufficient +@@ -529,7 +440,7 @@ Jerboa is niche — every non-trivial pattern you discover prevents future sessi + **Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists. + + ### Save Discoveries Mechanisms +-- **`/save-discoveries` skill**: invoke anytime to review session and save recipes, anti-patterns, error fixes, feature suggestions, and security patterns ++- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions + - **PreCompact hook**: add `PreCompact` hook with `type: "prompt"` in `.claude/settings.json` to auto-save before context compaction + + --- +diff --git a/Makefile b/Makefile +index 5804cac..d2228e6 100644 +--- a/Makefile ++++ b/Makefile +@@ -1,60 +1,46 @@ +-JERBOA_VERSION ?= v0.2.3 +-JERBOA_TOOL_DIR ?= $(CURDIR)/.jerboa/bin +-JERBUILD ?= $(shell if [ -x "$(CURDIR)/../jerboa/dist/jerbuild" ]; then printf '%s\n' "$(CURDIR)/../jerboa/dist/jerbuild"; elif command -v jerbuild >/dev/null 2>&1; then command -v jerbuild; else printf '%s\n' "$(JERBOA_TOOL_DIR)/jerbuild"; fi) +-JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) +-LIBDIRS = lib:$(JH)/lib ++JERBUILD ?= jerbuild ++JH := $(shell $(JERBUILD) --jerboa-home 2>/dev/null) ++ifeq ($(JH),) ++$(error jerbuild not found on PATH (or '$(JERBUILD) --jerboa-home' failed). Install jerbuild, or set JERBUILD=/path/to/jerbuild) ++endif ++ ++LIBDIRS = lib:$(JH)/lib + + CC ?= cc +-DIST_DIR ?= dist/release-evidence +-SBOM_DIR ?= dist/sbom +-REPRO_DIR ?= dist/reproducibility +-TARGET_EVIDENCE_DIR ?= dist/target-evidence +-WARN_CFLAGS ?= -Wall -Wextra -Werror +-HARDEN_CFLAGS ?= -D_FORTIFY_SOURCE=2 -fstack-protector-strong +-HARDEN_LDFLAGS ?= + + UNAME_S := $(shell uname -s) + ifeq ($(UNAME_S),Darwin) +- SHARED_FLAG = -dynamiclib +- SO_EXT = .so +- LD_VAR = DYLD_LIBRARY_PATH +- OPENSSL_PREFIX ?= $(shell brew --prefix openssl@4 2>/dev/null || brew --prefix openssl@3 2>/dev/null || echo /opt/homebrew/opt/openssl@4) +- OPENSSL_CFLAGS ?= -I$(OPENSSL_PREFIX)/include +- OPENSSL_LIBS ?= -L$(OPENSSL_PREFIX)/lib -lcrypto +- OPENSSL_BIN ?= $(OPENSSL_PREFIX)/bin/openssl ++ SHARED_FLAG = -dynamiclib ++ SO_EXT = .so ++ LD_VAR = DYLD_LIBRARY_PATH ++ OPENSSL_PREFIX ?= $(shell brew --prefix openssl@3 2>/dev/null || echo /opt/homebrew/opt/openssl@3) ++ CFLAGS_EXTRA = -I$(OPENSSL_PREFIX)/include ++ LDFLAGS_EXTRA = -L$(OPENSSL_PREFIX)/lib + else +- SHARED_FLAG = -shared +- SO_EXT = .so +- LD_VAR = LD_LIBRARY_PATH +- OPENSSL_CFLAGS ?= $(shell pkg-config --cflags openssl 2>/dev/null) +- OPENSSL_LIBS ?= $(shell pkg-config --libs openssl 2>/dev/null || printf '%s\n' -lcrypto) +- OPENSSL_BIN ?= openssl +- HARDEN_LDFLAGS += -Wl,-z,relro -Wl,-z,now ++ SHARED_FLAG = -shared ++ SO_EXT = .so ++ LD_VAR = LD_LIBRARY_PATH ++ CFLAGS_EXTRA = ++ LDFLAGS_EXTRA = + endif + +-CFLAGS ?= -O2 -fPIC $(WARN_CFLAGS) $(HARDEN_CFLAGS) ++CFLAGS = $(SHARED_FLAG) -fPIC -O2 $(CFLAGS_EXTRA) $(LDFLAGS_EXTRA) + + SHIM := libjerboa_fuse_mount$(SO_EXT) + +-.PHONY: all build transpile test test-loader-policy test-native-hardening test-memfs test-secmem test-access test-vault clean shim ensure-jerboa-tools audit security openssl-advisory-check sbom reproducibility-report target-evidence verify release-evidence ++.PHONY: all build transpile test test-memfs test-secmem test-access test-vault clean shim + + all: build + +-ensure-jerboa-tools: +- @if ! "$(JERBUILD)" --jerboa-home >/dev/null 2>&1; then \ +- echo "=== Installing Jerboa toolchain $(JERBOA_VERSION) into $(JERBOA_TOOL_DIR) ==="; \ +- sh support/ensure-jerboa.sh "$(JERBOA_VERSION)" "$(JERBOA_TOOL_DIR)"; \ +- fi +- + shim: $(SHIM) + + $(SHIM): src/mount_helper.c +- $(CC) $(CFLAGS) $(OPENSSL_CFLAGS) $(SHARED_FLAG) $(HARDEN_LDFLAGS) -o $@ $< $(OPENSSL_LIBS) ++ $(CC) $(CFLAGS) -o $@ $< + +-transpile: ensure-jerboa-tools +- @$(JERBUILD) transpile src lib --force ++transpile: ++ $(JERBUILD) transpile src lib --force + +-build: ensure-jerboa-tools shim transpile ++build: shim transpile + + ifeq ($(UNAME_S),Darwin) + EXTRA_LDPATH = :$(OPENSSL_PREFIX)/lib +@@ -62,20 +48,9 @@ else + EXTRA_LDPATH = + endif + +-RUNTEST = JERBOA_FUSE_DEV_NATIVE=1 JERBOA_FUSE_LIB=$(CURDIR) $(LD_VAR)=$(CURDIR)$(EXTRA_LDPATH) $(JERBUILD) exec --libdirs "$(LIBDIRS)" ++RUNTEST = JERBOA_FUSE_LIB=$(CURDIR) $(LD_VAR)=$(CURDIR)$(EXTRA_LDPATH) $(JERBUILD) exec --libdirs "$(LIBDIRS)" + +-test: test-loader-policy test-native-hardening test-memfs test-secmem test-access test-vault +- +-test-loader-policy: build +- @REPO_ROOT="$(CURDIR)" JERBUILD="$(JERBUILD)" \ +- LIBDIRS="$(LIBDIRS)" SHIM="$(CURDIR)/$(SHIM)" \ +- sh tests/loader-policy.sh +- +-test-native-hardening: shim +- $(CC) $(CFLAGS) $(OPENSSL_CFLAGS) -o tests/test_mount_helper \ +- tests/test_mount_helper.c src/mount_helper.c $(OPENSSL_LIBS) +- ./tests/test_mount_helper +- rm -f tests/test_mount_helper ++test: test-memfs test-secmem test-access + + test-memfs: build + $(RUNTEST) tests/test-memfs.ss +@@ -89,93 +64,6 @@ test-access: build + test-vault: build + $(RUNTEST) tests/test-vault.ss + +-audit: shim +- @echo "==> Platform" +- @uname -srm +- @echo "==> OpenSSL" +- @if [ -x "$(OPENSSL_BIN)" ] || command -v "$(OPENSSL_BIN)" >/dev/null 2>&1; then "$(OPENSSL_BIN)" version -a; else echo "openssl CLI not found; shim compile/link is the local dependency check."; fi +- @echo "==> pkg-config OpenSSL (informational)" +- @if command -v pkg-config >/dev/null 2>&1; then \ +- if [ -n "$(OPENSSL_PREFIX)" ] && [ -d "$(OPENSSL_PREFIX)/lib/pkgconfig" ]; then \ +- printf 'openssl via %s: ' "$(OPENSSL_PREFIX)/lib/pkgconfig"; \ +- PKG_CONFIG_PATH="$(OPENSSL_PREFIX)/lib/pkgconfig:$${PKG_CONFIG_PATH:-}" pkg-config --modversion openssl || true; \ +- else \ +- printf 'openssl via default pkg-config path: '; \ +- pkg-config --modversion openssl || true; \ +- fi; \ +- else \ +- echo "pkg-config not found."; \ +- fi +- @echo "==> Native linkage for $(SHIM)" +- @if command -v otool >/dev/null 2>&1; then \ +- otool -L "$(SHIM)"; \ +- elif command -v ldd >/dev/null 2>&1; then \ +- ldd "$(SHIM)"; \ +- else \ +- echo "No otool or ldd available for linkage audit."; \ +- fi +- +-openssl-advisory-check: +- @OPENSSL="$(OPENSSL_BIN)" scripts/openssl-advisory-check.sh +- +-security: scripts/security-check.sh +- @sh scripts/security-check.sh +- +-sbom: build +- @SHIM="$(SHIM)" OPENSSL_BIN="$(OPENSSL_BIN)" OPENSSL_PREFIX="$(OPENSSL_PREFIX)" JERBUILD="$(JERBUILD)" CC="$(CC)" scripts/sbom.sh "$(SBOM_DIR)" +- +-reproducibility-report: +- @JERBUILD="$(JERBUILD)" OPENSSL_PREFIX="$(OPENSSL_PREFIX)" OPENSSL_BIN="$(OPENSSL_BIN)" scripts/reproducibility-report.sh "$(REPRO_DIR)" +- +-target-evidence: +- @JERBOA_FUSE_TARGET_EVIDENCE_DIR="$(TARGET_EVIDENCE_DIR)" scripts/target-evidence.sh +- +-.PHONY: lint +-lint: security +- +-verify: security test audit openssl-advisory-check sbom reproducibility-report target-evidence +- +-release-evidence: security test audit sbom target-evidence +- rm -rf "$(DIST_DIR)" +- mkdir -p "$(DIST_DIR)" +- OPENSSL="$(OPENSSL_BIN)" scripts/openssl-advisory-check.sh "$(DIST_DIR)/openssl-advisory-check.txt" +- JERBUILD="$(JERBUILD)" OPENSSL_PREFIX="$(OPENSSL_PREFIX)" OPENSSL_BIN="$(OPENSSL_BIN)" scripts/reproducibility-report.sh "$(REPRO_DIR)" +- rm -rf "$(DIST_DIR)/reproducibility" "$(DIST_DIR)/sbom" "$(DIST_DIR)/target-evidence" +- cp -R "$(REPRO_DIR)" "$(DIST_DIR)/reproducibility" +- cp -R "$(SBOM_DIR)" "$(DIST_DIR)/sbom" +- cp -R "$(TARGET_EVIDENCE_DIR)" "$(DIST_DIR)/target-evidence" +- git rev-parse HEAD > "$(DIST_DIR)/git-commit.txt" +- git status --short > "$(DIST_DIR)/git-status.txt" +- { printf 'platform='; uname -srm; printf 'jerbuild_version='; "$(JERBUILD)" --version; if "$(JERBUILD)" --jerboa-home >/dev/null 2>&1; then printf 'jerboa_home_status=present\n'; else printf 'jerboa_home_status=missing\n'; fi; } > "$(DIST_DIR)/build-environment.txt" +- ($(CC) --version || $(CC) -v) > "$(DIST_DIR)/cc-version.txt" 2>&1 || true +- $(MAKE) security > "$(DIST_DIR)/security.log" 2>&1 +- @if [ -x "$(OPENSSL_BIN)" ] || command -v "$(OPENSSL_BIN)" >/dev/null 2>&1; then "$(OPENSSL_BIN)" version -a > "$(DIST_DIR)/openssl-version.txt"; else echo "openssl CLI not found." > "$(DIST_DIR)/openssl-version.txt"; fi +- @if command -v otool >/dev/null 2>&1; then \ +- otool -L "$(SHIM)" > "$(DIST_DIR)/native-linkage.txt"; \ +- elif command -v ldd >/dev/null 2>&1; then \ +- ldd "$(SHIM)" > "$(DIST_DIR)/native-linkage.txt"; \ +- else \ +- echo "No native linkage inspector found." > "$(DIST_DIR)/native-linkage.txt"; \ +- fi +- { test -f .jerboa/security.json && printf '%s\n' .jerboa/security.json; find Makefile src lib tests docs scripts examples -type f \( -name 'Makefile' -o -name '*.c' -o -name '*.h' -o -name '*.sh' -o -name '*.ss' -o -name '*.sls' -o -name '*.md' \) -print; } | sort > "$(DIST_DIR)/source-inputs.txt" +- @{ \ +- echo "privilege_policy_status=present"; \ +- grep -E 'privilege_model_status: documented|mount_permission_status: operator-granted-not-root-by-default|allow_other_status: disabled-by-default|sandbox_policy_status: documented|mountpoint_policy_status: private-owned-empty-directory|unmount_teardown_status: target-host-required|vault_secret_policy_status: no-passphrase-in-argv-or-env' docs/deployment-hardening.md; \ +- } > "$(DIST_DIR)/privilege-policy.txt" +- grep -q 'privilege_model_status: documented' "$(DIST_DIR)/privilege-policy.txt" +- grep -q 'allow_other_status: disabled-by-default' "$(DIST_DIR)/privilege-policy.txt" +- grep -q 'sandbox_policy_status: documented' "$(DIST_DIR)/privilege-policy.txt" +- shasum -a 256 src/mount_helper.c "$(SHIM)" > "$(DIST_DIR)/native-sha256.txt" +- sh scripts/sanitize-evidence.sh "$(DIST_DIR)" +- sh scripts/sanitize-evidence.sh "$(SBOM_DIR)" +- sh scripts/sanitize-evidence.sh "$(REPRO_DIR)" +- sh scripts/sanitize-evidence.sh "$(TARGET_EVIDENCE_DIR)" +- grep -q '^sbom_status=present$$' "$(DIST_DIR)/sbom/manifest.txt" +- grep -q '^deployment_hardening_status=present$$' "$(DIST_DIR)/sbom/manifest.txt" +- grep -q '^platform_notes_status=present$$' "$(DIST_DIR)/sbom/manifest.txt" +- grep -q '^status=' "$(DIST_DIR)/target-evidence/status.txt" +- grep -q '^status=match$$' "$(DIST_DIR)/reproducibility/result.txt" +- + clean: + rm -f $(SHIM) src/libchez_fuse_mount.* +- rm -rf lib tests/tmp .jerboa/bin ++ rm -rf lib +diff --git a/examples/vault-shell.ss b/examples/vault-shell.ss +index eaafd92..2b0c806 100644 +--- a/examples/vault-shell.ss ++++ b/examples/vault-shell.ss +@@ -10,7 +10,7 @@ + ;;; make all + ;;; scheme --libdirs lib --script examples/vault-shell.ss /tmp/my.vault /mnt/vault + +-(import (jerboa prelude)) ++(import (chezscheme)) + (import (jerboa-fuse vault)) + + (define (usage) +diff --git a/src/jerboa-fuse.ss b/src/jerboa-fuse.ss +index 424c89b..1a193cd 100644 +--- a/src/jerboa-fuse.ss ++++ b/src/jerboa-fuse.ss +@@ -48,10 +48,7 @@ + + ;; Re-exports: Access control + make-access-controller access-check +- access-controller-lock! access-controller-unlock! access-controller-locked? +- +- ;; Access gate predicate (which opcodes bypass the access controller) +- always-allowed-opcode?) ++ access-controller-lock! access-controller-unlock! access-controller-locked?) + + (import + (jerboa prelude) +@@ -157,14 +154,14 @@ + (def (create-session ops mountpoint options) + (let* ([fsname (get-option options 'fsname "chez-fuse")] + [debug? (get-option options 'debug #f)] +- [allow-other? (get-option options 'allow-other #f)] ++ [allow-other? (get-option options 'allow-other #t)] + [fd (fuse-open-device)] + [mtx (make-mutex)] + [ac (get-option options 'access-controller #f)] + [session (make-fuse-session + fd mountpoint #f #f + FUSE-KERNEL-VERSION FUSE-KERNEL-MINOR-VERSION +- 131072 131072 ;; max_write, max_readahead ++ 131072 131072 ;; max-write, max-readahead + ops + mtx ;; dispatch mutex + #f ;; thread handle +@@ -172,12 +169,7 @@ + ac)] ;; access controller + [uid (fuse-current-uid)] + [gid (fuse-current-gid)]) +- (guard (exn +- [else +- (fuse-close-device fd) +- (fuse-session-fd-set! session -1) +- (raise exn)]) +- (fuse-mount! fd mountpoint fsname uid gid allow-other?)) ++ (fuse-mount! fd mountpoint fsname uid gid allow-other?) + (fuse-session-mounted?-set! session #t) + (fuse-session-running?-set! session #t) + (when debug? +@@ -228,13 +220,10 @@ + ;; Request handler — dispatches a single request + ;; ====================================================================== + +- ;; Opcodes that are always allowed (protocol handshake, no data exposure). +- ;; FUSE-STATFS is intentionally NOT here: a denied caller would otherwise +- ;; learn vault block counts, so it is routed through the access gate and +- ;; answered with a generic empty statfs (see stealth-deny-response). ++ ;; Opcodes that are always allowed (protocol handshake, no data exposure) + (def (always-allowed-opcode? op) + (or (= op FUSE-INIT) (= op FUSE-DESTROY) +- (= op FUSE-INTERRUPT))) ++ (= op FUSE-INTERRUPT) (= op FUSE-STATFS))) + + ;; Stealth deny: denied processes see an empty directory, not errors. + ;; GETATTR on root → valid empty dir attr. Everything else → ENOENT. +@@ -251,10 +240,7 @@ + (encode-out-header unique 0 0)] + ;; OPENDIR on root → allow (so readdir works) + [(and (= opcode FUSE-OPENDIR) (= nodeid FUSE-ROOT-ID)) +- (encode-open-out unique 0 0)] +- ;; STATFS → generic empty stats (deny block-count leak) +- [(= opcode FUSE-STATFS) +- (encode-statfs-out unique (stealth-deny-statfs))] ++ (encode-open-out unique 0 0)] + ;; RELEASEDIR → always OK + [(= opcode FUSE-RELEASEDIR) + (encode-out-header unique 0 0)] +@@ -312,9 +298,6 @@ + ;; Opcode dispatch + ;; ====================================================================== + +- (def (handler-error-code result) +- (and (integer? result) (negative? result) (- result))) +- + (def (dispatch-opcode session ops opcode unique nodeid ctx buf off limit) + (cond + +@@ -389,13 +372,10 @@ + atime mtime ctime + atimensec mtimensec ctimensec + mode uid gid ctx)]) +- (cond +- [(handler-error-code result) +- => (lambda (e) (encode-error unique e))] +- [result +- (encode-attr-out unique 1 0 result)] +- [else (encode-error unique EIO)]))) +- (encode-error unique ENOSYS)))] ++ (if result ++ (encode-attr-out unique 1 0 result) ++ (encode-error unique EIO)))) ++ (encode-error unique ENOSYS)))] + + ;; ---- FUSE_READLINK ---- + [(= opcode FUSE-READLINK) +@@ -435,14 +415,11 @@ + (let ([handler (get-op ops 'mkdir)]) + (if handler + (let-values ([(mode umask) (decode-mkdir-in buf off)]) +- (let* ([name (extract-name buf (+ off 8) limit)] +- [result (handler nodeid name mode ctx)]) +- (cond +- [(handler-error-code result) +- => (lambda (e) (encode-error unique e))] +- [result +- (encode-entry-out unique result)] +- [else (encode-error unique EIO)]))) ++ (let* ([name (extract-name buf (+ off 8) limit)] ++ [result (handler nodeid name mode ctx)]) ++ (if result ++ (encode-entry-out unique result) ++ (encode-error unique EIO)))) + (encode-error unique ENOSYS)))] + + ;; ---- FUSE_UNLINK ---- +@@ -474,13 +451,10 @@ + (let ([newdir (decode-rename-in buf off)]) + (let-values ([(oldname newname) + (extract-two-names buf (+ off 8) limit)]) +- (let ([result (handler nodeid oldname newdir newname ctx)]) +- (cond +- [(handler-error-code result) +- => (lambda (e) (encode-error unique e))] +- [result +- (encode-out-header unique 0 0)] +- [else (encode-error unique EIO)])))) ++ (let ([result (handler nodeid oldname newdir newname ctx)]) ++ (if result ++ (encode-out-header unique 0 0) ++ (encode-error unique EIO))))) + (encode-error unique ENOSYS)))] + + ;; ---- FUSE_LINK ---- +@@ -514,20 +488,17 @@ + (if handler + (let-values ([(fh offset size read-flags) + (decode-read-in buf off)]) +- (let ([data (handler nodeid fh size offset ctx)]) +- (cond +- [(handler-error-code data) +- => (lambda (e) (encode-error unique e))] +- [data +- (let* ([dlen (bytevector-length data)] +- [total (+ FUSE-OUT-HEADER-SIZE dlen)] +- [resp (make-bytevector total 0)]) +- (bytevector-u32-native-set! resp 0 total) +- (bytevector-s32-native-set! resp 4 0) +- (bytevector-u64-native-set! resp 8 unique) +- (bytevector-copy! data 0 resp FUSE-OUT-HEADER-SIZE dlen) +- resp)] +- [else (encode-error unique EIO)]))) ++ (let ([data (handler nodeid fh size offset ctx)]) ++ (if data ++ (let* ([dlen (bytevector-length data)] ++ [total (+ FUSE-OUT-HEADER-SIZE dlen)] ++ [resp (make-bytevector total 0)]) ++ (bytevector-u32-native-set! resp 0 total) ++ (bytevector-s32-native-set! resp 4 0) ++ (bytevector-u64-native-set! resp 8 unique) ++ (bytevector-copy! data 0 resp FUSE-OUT-HEADER-SIZE dlen) ++ resp) ++ (encode-error unique EIO)))) + (encode-error unique ENOSYS)))] + + ;; ---- FUSE_WRITE ---- +@@ -536,18 +507,14 @@ + (if handler + (let-values ([(fh offset size write-flags) + (decode-write-in buf off)]) +- (let* ([data-off (+ off 40)]) +- (if (> (+ data-off size) limit) +- (encode-error unique EINVAL) +- (let ([data (make-bytevector size)]) +- (bytevector-copy! buf data-off data 0 size) +- (let ([written (handler nodeid fh data offset ctx)]) +- (cond +- [(handler-error-code written) +- => (lambda (e) (encode-error unique e))] +- [written (encode-write-out unique written)] +- [else (encode-error unique EIO)])))))) +- (encode-error unique ENOSYS)))] ++ (let* ([data-off (+ off 40)] ++ [data (make-bytevector size)]) ++ (bytevector-copy! buf data-off data 0 size) ++ (let ([written (handler nodeid fh data offset ctx)]) ++ (if written ++ (encode-write-out unique written) ++ (encode-error unique EIO))))) ++ (encode-error unique ENOSYS)))] + + ;; ---- FUSE_STATFS ---- + [(= opcode FUSE-STATFS) +@@ -635,33 +602,30 @@ + (if handler + (let-values ([(flags mode umask open-flags) + (decode-create-in buf off)]) +- (let* ([name (extract-name buf (+ off 16) limit)] +- [result (handler nodeid name mode flags ctx)]) +- (cond +- [(handler-error-code result) +- => (lambda (e) (encode-error unique e))] +- [result +- (let* ([entry (car result)] +- [fh-part (cdr result)] +- [fh (if (pair? fh-part) (car fh-part) fh-part)] +- [oflags (if (pair? fh-part) (cdr fh-part) 0)] +- [total (+ FUSE-OUT-HEADER-SIZE +- FUSE-ENTRY-OUT-SIZE +- FUSE-OPEN-OUT-SIZE)] +- [resp (make-bytevector total 0)] +- [entry-bv (encode-entry-out unique entry)]) +- (bytevector-u32-native-set! resp 0 total) +- (bytevector-s32-native-set! resp 4 0) +- (bytevector-u64-native-set! resp 8 unique) +- (bytevector-copy! entry-bv FUSE-OUT-HEADER-SIZE +- resp FUSE-OUT-HEADER-SIZE +- FUSE-ENTRY-OUT-SIZE) +- (bytevector-u64-native-set! resp +- (+ FUSE-OUT-HEADER-SIZE FUSE-ENTRY-OUT-SIZE) fh) +- (bytevector-u32-native-set! resp +- (+ FUSE-OUT-HEADER-SIZE FUSE-ENTRY-OUT-SIZE 8) oflags) +- resp)] +- [else (encode-error unique EIO)]))) ++ (let* ([name (extract-name buf (+ off 16) limit)] ++ [result (handler nodeid name mode flags ctx)]) ++ (if result ++ (let* ([entry (car result)] ++ [fh-part (cdr result)] ++ [fh (if (pair? fh-part) (car fh-part) fh-part)] ++ [oflags (if (pair? fh-part) (cdr fh-part) 0)] ++ [total (+ FUSE-OUT-HEADER-SIZE ++ FUSE-ENTRY-OUT-SIZE ++ FUSE-OPEN-OUT-SIZE)] ++ [resp (make-bytevector total 0)] ++ [entry-bv (encode-entry-out unique entry)]) ++ (bytevector-u32-native-set! resp 0 total) ++ (bytevector-s32-native-set! resp 4 0) ++ (bytevector-u64-native-set! resp 8 unique) ++ (bytevector-copy! entry-bv FUSE-OUT-HEADER-SIZE ++ resp FUSE-OUT-HEADER-SIZE ++ FUSE-ENTRY-OUT-SIZE) ++ (bytevector-u64-native-set! resp ++ (+ FUSE-OUT-HEADER-SIZE FUSE-ENTRY-OUT-SIZE) fh) ++ (bytevector-u32-native-set! resp ++ (+ FUSE-OUT-HEADER-SIZE FUSE-ENTRY-OUT-SIZE 8) oflags) ++ resp) ++ (encode-error unique EIO)))) + (encode-error unique ENOSYS)))] + + ;; ---- FUSE_INTERRUPT ---- +@@ -731,4 +695,3 @@ + (if (message-condition? c) + (condition-message c) + "unknown error")) +- +diff --git a/src/jerboa-fuse/access.ss b/src/jerboa-fuse/access.ss +index b7bce99..0368551 100644 +--- a/src/jerboa-fuse/access.ss ++++ b/src/jerboa-fuse/access.ss +@@ -9,7 +9,6 @@ + ;; Stealth deny helpers (for FUSE dispatch) + stealth-deny-attr ;; → fuse-attr (empty root-like) + stealth-deny-readdir ;; → list of dirents (just . and ..) +- stealth-deny-statfs ;; → fuse-statfs (generic/empty, no block counts) + + ;; Process tree inspection + access-current-pid +@@ -26,14 +25,12 @@ + + (def c-getpid #f) + (def c-getppid-of #f) +- (def c-get-start-time #f) + (def *bindings-ready?* #f) + + (def (ensure-access-bindings!) + (when (and (ensure-mount-lib!) (not *bindings-ready?*)) + (set! c-getpid (c-lambda () int "jerboa_fuse_getpid")) + (set! c-getppid-of (c-lambda (int) int "jerboa_fuse_getppid_of")) +- (set! c-get-start-time (c-lambda (int) integer-64 "jerboa_fuse_get_start_time")) + (set! *bindings-ready?* #t)) + (unless *bindings-ready?* + (error 'jerboa-fuse/access "unable to load native process helpers"))) +@@ -61,9 +58,8 @@ + + ;; ---- Access controller ---- + +- ;; Cache entry: pid → (start-time . expiry-time) ++ ;; Cache entry: (pid . expiry-time) + ;; Trusted PIDs are cached for a short TTL to avoid repeated sysctl calls. +- ;; The start-time guards against PID reuse within the TTL window. + ;; Denied PIDs are NOT cached (process might become a child later, though + ;; unlikely — and we want to re-check in case of PID reuse). + (def CACHE-TTL 5) ;; seconds +@@ -105,23 +101,18 @@ + [else + (let* ([cache (access-controller-state-cache ac)] + [now (time-second (current-time))] +- [entry (eq-hashtable-ref cache pid #f)]) ++ [expiry (eq-hashtable-ref cache pid #f)]) + (cond +- ;; Cache hit, not expired, and start time matches (no PID reuse) +- [(and entry +- (> (cdr entry) now) +- (let ([st (c-get-start-time pid)]) +- (and (>= st 0) (= st (car entry))))) +- #t]