musl: route jcode-musl through Docker; migrate crypto to ring; expand FFI registry
ober
2769dd638ebef34b0a32bc12f4e23e3bc140c689
--- a/Dockerfile +++ b/Dockerfile @@ -20,6 +20,22 @@ FROM jerboa21/jerboa AS builder ARG CACHE_BUST +# ── Overlay the host's ~/mine/jerboa over the base image's bundled copy ───── +# The base image's /build/mine/jerboa is a snapshot and lags reality as soon +# as a new module lands upstream (e.g. (std os errno) added on 2026-05-13). +# Without this overlay the build fails with "library (std os errno) not +# found" every time jcode source references a fresh jerboa module. +# +# Source: --build-context host-jerboa=<path> from the Makefile docker target. +# We delete any compiled .so/.wpo from the overlay so the freshly-copied +# sources get recompiled against the container's Chez (a host-built .so +# from a different libc/version would be wrong inside the container). +COPY --from=host-jerboa . /build/mine/jerboa-host-overlay +RUN find /build/mine/jerboa-host-overlay \( -name '*.so' -o -name '*.wpo' \) -delete 2>/dev/null; \ + rm -rf /build/mine/jerboa && \ + mv /build/mine/jerboa-host-overlay /build/mine/jerboa && \ + find /build/mine/jerboa/lib \( -name '*.so' -o -name '*.wpo' \) -delete 2>/dev/null; true + # ── Copy jcode source ──────────────────────────────────────────────────────── COPY . /build/mine/jerboa-code --- a/Makefile +++ b/Makefile @@ -156,7 +156,15 @@ linux-check: gen docker: @echo "=== Building jcode-musl in Docker ===" - docker build --platform linux/amd64 --build-arg CACHE_BUST=$$(date +%s) -t jcode-builder . + @# Pass the host's ~/mine/jerboa as an additional build context. The base + @# image's bundled jerboa lags reality; without this overlay the build + @# breaks every time jcode source references a jerboa module added since + @# the base image was last rebuilt (e.g. (std os errno) added 2026-05-13). + DOCKER_BUILDKIT=1 docker build \ + --platform linux/amd64 \ + --build-arg CACHE_BUST=$$(date +%s) \ + --build-context host-jerboa=$(JERBOA_HOME) \ + -t jcode-builder . @id=$$(docker create --platform linux/amd64 jcode-builder) && \ docker cp $$id:/out/jcode-musl ./jcode-musl && \ docker rm $$id >/dev/null && \ @@ -174,7 +182,14 @@ linux-local: linux-check @echo "=== Building static jcode with musl ===" JERBOA_HOME=$(JERBOA_HOME) ./build-jcode-musl.sh -jcode-musl: linux-local +# jcode-musl routes through Docker by default. The native `linux-local` +# path depends on the host's Chez (musl + glibc) staying in lock-step +# with the source — this kept breaking every time the host scheme moved +# or a stale ~/chez-musl was around. The Docker path uses jerboa21/jerboa +# which ships pre-built host + musl Chez and the full Rust toolchain, so +# the build is reproducible and survives host drift. Use `make linux-local` +# if you specifically want a native build. +jcode-musl: docker freebsd: build JERBOA_HOME=$(JERBOA_HOME) \ --- a/build-jcode-musl.sh +++ b/build-jcode-musl.sh @@ -32,6 +32,39 @@ if ! command -v musl-gcc &>/dev/null; then exit 1 fi +# musl-built Chez prefix. We use an in-tree install at +# ~/mine/ChezScheme/musl-out so it's obviously a build artifact (not a +# system install) and stays version-locked to the source. /usr/local +# Chez on Linux is glibc-built (has __memcpy_chk/__fprintf_chk +# fortify symbols) and cannot satisfy a musl-static link. +MUSL_CHEZ_PREFIX="${JERBOA_MUSL_CHEZ_PREFIX:-${HOME_DIR}/mine/ChezScheme/musl-out}" +export JERBOA_MUSL_CHEZ_PREFIX="${MUSL_CHEZ_PREFIX}" + +# Auto-bootstrap musl Chez if the prefix is missing. Avoids the recurring +# breakage where ~/chez-musl gets stale/deleted and the build dies with +# a cryptic prefix-not-found error. +if [ ! -d "${MUSL_CHEZ_PREFIX}" ]; then + echo "" + echo "=== musl Chez not found at ${MUSL_CHEZ_PREFIX} — auto-bootstrapping ===" + CHEZ_SRC="${HOME_DIR}/mine/ChezScheme" + BOOTSTRAP="${HOME_DIR}/mine/jerboa/support/musl-chez-build.sh" + if [ ! -d "${CHEZ_SRC}" ]; then + echo "FATAL: Chez source not found at ${CHEZ_SRC}" + echo " git clone https://github.com/cisco/ChezScheme.git ${CHEZ_SRC}" + exit 1 + fi + if [ ! -f "${BOOTSTRAP}" ]; then + echo "FATAL: bootstrap script not found at ${BOOTSTRAP}" + exit 1 + fi + echo "(this takes ~5-10 minutes; subsequent runs reuse it)" + echo "" + bash "${BOOTSTRAP}" "${CHEZ_SRC}" "${MUSL_CHEZ_PREFIX}" + echo "" + echo "=== musl Chez bootstrap complete ===" + echo "" +fi + # Validate musl toolchain via jerboa echo "[1/2] Validating musl toolchain via jerboa..." scheme -q --libdirs "${JERBOA_LIB}" <<'VALIDATE' @@ -47,6 +80,7 @@ echo "[2/2] Running musl build..." LD_LIBRARY_PATH="${SCRIPT_DIR}/vendor/chez-sqlite:${SCRIPT_DIR}/vendor/termbox2:${JERBOA_LIB}:." \ JERBOA_HOME="${JERBOA_HOME}" \ +JERBOA_MUSL_CHEZ_PREFIX="${MUSL_CHEZ_PREFIX}" \ scheme -q --libdirs "${JERBOA_LIB}:./lib:vendor/chez-sqlite/src:vendor/jerboa-websearch/src" \ <build-jcode-musl.ss --- a/build-jcode-musl.ss +++ b/build-jcode-musl.ss @@ -21,6 +21,57 @@ (jerboa build) (jerboa build musl)) +;; ========== Auto-bootstrap musl Chez if missing ========== +;; +;; The musl-static binary requires a libkernel.a built with musl-gcc. +;; /usr/local Chez on Linux is glibc-built (its libkernel.a references +;; __memcpy_chk / __fprintf_chk / __stack_chk_fail — glibc-fortify ABI +;; symbols absent from musl) and therefore cannot satisfy a musl-static +;; link. So we need a *separate* musl-built Chez prefix. +;; +;; We keep it in-tree as ~/mine/ChezScheme/musl-out so it's obviously a +;; build artifact (not a system install) and stays version-locked to the +;; source. If missing, build it via support/musl-chez-build.sh. + +(define jcode-musl-chez-prefix + (or (getenv "JERBOA_MUSL_CHEZ_PREFIX") + (format "~a/mine/ChezScheme/musl-out" (or (getenv "HOME") "/root")))) + +;; Tell (jerboa build musl) where the prefix lives. We respect +;; JERBOA_MUSL_CHEZ_PREFIX (set by e.g. the jerboa21/jerboa Docker base +;; image, which ships a pre-built musl Chez at /build/chez-musl) and +;; otherwise default to an in-tree install. Overrides the default probe +;; order so we don't accidentally pick up a stale ~/chez-musl from a +;; previous setup. +(musl-chez-prefix-set! jcode-musl-chez-prefix) + +(unless (file-directory? jcode-musl-chez-prefix) + (let* ([home (or (getenv "HOME") "/root")] + [chez-src (format "~a/mine/ChezScheme" home)] + [bootstrap (format "~a/mine/jerboa/support/musl-chez-build.sh" home)]) + (printf "~n=== musl Chez not found — auto-bootstrapping ===~n") + (printf " source: ~a~n" chez-src) + (printf " prefix: ~a~n~n" jcode-musl-chez-prefix) + (cond + [(not (file-exists? "/usr/bin/musl-gcc")) + (printf "FATAL: musl-gcc not found. Install with: apt install musl-tools~n") + (exit 1)] + [(not (file-directory? chez-src)) + (printf "FATAL: Chez source not found at ~a~n" chez-src) + (printf " git clone https://github.com/cisco/ChezScheme.git ~a~n" chez-src) + (exit 1)] + [(not (file-exists? bootstrap)) + (printf "FATAL: bootstrap script not found: ~a~n" bootstrap) + (exit 1)] + [else + (printf "This takes ~~5-10 minutes; subsequent runs reuse it.~n~n") + (let ([rc (system (format "bash '~a' '~a' '~a'" bootstrap chez-src jcode-musl-chez-prefix))]) + (unless (= rc 0) + (printf "~nFATAL: musl Chez bootstrap failed (rc=~a)~n" rc) + (printf "Run manually to inspect:~n bash ~a ~a ~a~n" bootstrap chez-src jcode-musl-chez-prefix) + (exit 1)) + (printf "~n=== musl Chez bootstrap complete ===~n~n"))]))) + ;; ========== Validate musl setup ========== (let ([result (validate-musl-setup)]) @@ -28,12 +79,23 @@ (printf "Error: ~a~n" (cdr result)) (printf "~nTo build Chez Scheme with musl:~n") (printf " cd ~/mine/ChezScheme~n") - (printf " ./configure --threads --static CC=musl-gcc --installprefix=$HOME/chez-musl~n") + (printf " ./configure --threads --static CC=musl-gcc --installprefix=~a~n" + jcode-musl-chez-prefix) (printf " make -j$(nproc) && make install~n") (exit 1))) (printf "musl Chez found: ~a~n~n" (musl-chez-lib-dir)) +;; (Previously had a (scheme-version) vs csv-dir version-string check +;; here. It was buggy — (scheme-version) returns "Chez Scheme Version +;; 10.4.0" which can never equal the install-dir version "10.4.0-pre- +;; release.4" — so it produced false positives. The scenario it was +;; meant to catch (stale musl prefix vs newer host scheme) is now +;; prevented structurally: Docker uses the base image's matched pair, +;; and the native path auto-bootstraps musl Chez from the same source +;; tree the host scheme was built from. Boot-file FASL mismatches will +;; surface as a clear runtime error if they ever occur again.) + ;; ========== Locate directories ========== (define home-dir (or (getenv "HOME") "/root")) @@ -119,11 +181,34 @@ "No .sls files found under lib/jcode — run 'make gen' first")) (for-each (lambda (m) (printf " ~a~n" m)) jcode-modules) -;; libc symbols needed by std/net/tcp (already linked in from musl) +;; libc symbols needed by std/net/* and std/os/* (already linked from musl). +;; All are real libc functions, not macros — straight (void*)foo casts work. +;; Variadic/macro ones (open/fcntl/ioctl/umask) are intentionally omitted; +;; the modules that need them either run through the std/os shims (ffi_*) +;; or call into the patched (load-shared-object) path that no longer fires. (define libc-symbols - '("socket" "bind" "listen" "accept" "connect" "close" - "setsockopt" "read" "write" "htons" "inet_pton" - "getsockname" "fcntl" "__errno_location")) + '(;; sockets — std/net/tcp, std/net/udp + "socket" "bind" "listen" "accept" "connect" "close" + "setsockopt" "getsockopt" "getsockname" + "htons" "ntohs" "inet_pton" "inet_addr" + "read" "write" "recvfrom" "sendto" + ;; DNS resolver — std/net/resolve + "getaddrinfo" "freeaddrinfo" "inet_ntop" + ;; process / signals — std/misc/process, std/os/signal, aproc + "fork" "waitpid" "kill" "getpid" "getppid" + "getpgid" "setpgid" "setsid" + "getuid" "geteuid" "getgid" "getegid" + "sigemptyset" "sigfillset" "sigaddset" "sigdelset" + "sigismember" "sigprocmask" + ;; terminal / fd — TUI + REPL + "isatty" "tcgetattr" "tcsetattr" "tcgetpgrp" "tcsetpgrp" + "pipe" "dup" "dup2" "lseek" + ;; env / misc — std/os/env, std/text/time + "setenv" "unsetenv" "strerror" "localtime" "strftime" + "sysconf" "getpagesize" "getrlimit" + "system" "getenv" "putenv" "_exit" "exit" "execvp" "execve" + ;; errno location (Linux glibc + musl convention) + "__errno_location" "fcntl")) ;; FFI symbols that need Sforeign_symbol registration (define ffi-symbols @@ -160,7 +245,37 @@ "jerboa_tls_connect_mtls" "jerboa_tls_close" "jerboa_tls_read" "jerboa_tls_write" "jerboa_tls_flush" "jerboa_tls_get_fd" "jerboa_tls_set_nonblock" - "jerboa_last_error")) + "jerboa_last_error" + ;; jerboa-native (crypto/ring) — used by secrets.ss via (std crypto native-rust) + "jerboa_sha1" "jerboa_sha256" "jerboa_sha384" "jerboa_sha512" + "jerboa_random_bytes" "jerboa_timing_safe_equal" + "jerboa_hmac_sha256" "jerboa_hmac_sha256_verify" + "jerboa_aead_seal" "jerboa_aead_open" + "jerboa_chacha20_seal" "jerboa_chacha20_open" + "jerboa_scrypt" + "jerboa_pbkdf2_derive" "jerboa_pbkdf2_verify" + "jerboa_argon2id_hash" "jerboa_argon2id_verify" + ;; jerboa-native (regex) — pulled in transitively via (jerboa prelude) + ;; which imports (std regex). foreign-procedure forms run at library + ;; visit time, so these have to exist even if jcode never matches a regex. + "jerboa_regex_compile" "jerboa_regex_is_match" + "jerboa_regex_find" "jerboa_regex_replace_all" "jerboa_regex_free" + ;; jerboa-native (aproc) — used by (std os aproc) for bash tool + "jerboa_aproc_spawn" "jerboa_aproc_spawn_pty" + "jerboa_aproc_set_nonblock" "jerboa_aproc_killpg" "jerboa_aproc_wait4" + ;; jerboa-native (sqlite) — used by (std db sqlite) via sqlite-native.sls + "jerboa_sqlite_open" "jerboa_sqlite_close" "jerboa_sqlite_exec" + "jerboa_sqlite_prepare" "jerboa_sqlite_finalize" "jerboa_sqlite_reset" + "jerboa_sqlite_step" "jerboa_sqlite_changes" "jerboa_sqlite_errmsg" + "jerboa_sqlite_last_insert_rowid" + "jerboa_sqlite_bind_int" "jerboa_sqlite_bind_double" + "jerboa_sqlite_bind_text" "jerboa_sqlite_bind_blob" "jerboa_sqlite_bind_null" + "jerboa_sqlite_column_count" "jerboa_sqlite_column_type" + "jerboa_sqlite_column_int" "jerboa_sqlite_column_double" + "jerboa_sqlite_column_text" "jerboa_sqlite_column_blob" + "jerboa_sqlite_column_name" + ;; jerboa-native (net/io) — vectored I/O wrapper used by (std net io) + "jerboa_writev2")) ;; ========== Step 0: Clean stale .so/.wpo files ========== @@ -182,12 +297,26 @@ ;; load-shared-object is both unnecessary and unsupported. ;; This matches the approach used in jerboa-shell's musl build. (printf " Blanket-patching load-shared-object in all libs...~n") -(system (format "find '~a' -name '*.sls' -exec sed -i 's/(load-shared-object[^)]*)/(void)/g' {} +" jerboa-dir)) -(system "find vendor/chez-sqlite -name '*.sls' -exec sed -i 's/(load-shared-object[^)]*)/(void)/g' {} +") -(system "find lib -name '*.sls' -exec sed -i 's/(load-shared-object[^)]*)/(void)/g' {} +") - -;; Fix multi-line load-shared-object in tui-ffi.sls (sed only handles single-line) -(system "perl -0777 -i -pe 's/\\(load-shared-object\\s*\\n\\s*\\(path-join[^)]*\\)\\s*\"[^\"]*\"\\)\\)/(void)/gs' lib/jcode/ui/tui-ffi.sls") +;; Paren-aware substitution. The naive sed `[^)]*` form breaks on: +;; 1. Nested forms: (load-shared-object (car candidates)) <- stops at first ) +;; 2. Multi-line forms in tui-ffi.sls +;; 3. The public helper (load-shared-object* name) in (jerboa ffi) -- this +;; MUST be preserved, since rewriting its body to (define (void) (void)) +;; causes "multiple definitions for void in body" failures. +;; The perl regex below uses a recursive named group to match balanced parens +;; and quoted strings, and (?=\s) to require whitespace after `object` so +;; `load-shared-object*` is left untouched. +(define lso-patch-cmd + (string-append + "perl -i -0777 -pe 's/" + "\\(load-shared-object(?=\\s)" + "(?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|" + "(?<bal>\\((?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|(?&bal))*+\\))" + ")*+\\)/(void)/g'")) + +(system (format "find '~a' -name '*.sls' -exec ~a {} +" jerboa-dir lso-patch-cmd)) +(system (format "find vendor/chez-sqlite -name '*.sls' -exec ~a {} +" lso-patch-cmd)) +(system (format "find lib -name '*.sls' -exec ~a {} +" lso-patch-cmd)) ;; Delete ALL compiled .so in jerboa lib to force recompile with patches (printf " Deleting stale .so files in all libs...~n") @@ -246,8 +375,22 @@ (printf "[3/7] Discovering external libs compiled under ~a...~n" jerboa-dir) +;; Pick up jerboa stdlib .so files (~/mine/jerboa/lib) and any vendored +;; library sources that were compiled as part of main-binary.ss's import +;; graph. jerboa-websearch lives under vendor/ and is linked into jcode +;; through (jerbsearch ...) imports; its .so files won't show up under +;; jerboa-dir, so we scan vendor/ too. Without this, the static binary +;; tries to load (jerbsearch query) at runtime and dies with +;; "library (jerbsearch query) not found" because the import resolves +;; from --libdirs at start (and a static binary has none). +(define jerbsearch-vendor-dir "vendor/jerboa-websearch/src") + (define external-lib-paths - (find-files-with-suffix jerboa-dir ".so")) + (append + (find-files-with-suffix jerboa-dir ".so") + (if (file-directory? jerbsearch-vendor-dir) + (find-files-with-suffix jerbsearch-vendor-dir ".so") + '()))) (printf " Found ~a external lib .so file(s)~n" (length external-lib-paths)) (when (null? external-lib-paths) @@ -319,20 +462,107 @@ (display "}\n" out)) 'replace) -;; Rust native library +;; Rust native library — build a project-specific musl static lib with ONLY +;; the cargo features jcode actually uses. jcode's FFI surface is: +;; - jerboa_tls_* (provider/provider.ss) => feature `tls` +;; - sqlite3_* (via chez-sqlite shim) => feature `sqlite` +;; That's it. `crypto`, `duckdb_feat`, `pcap`, `spidermonkey`, `wasm`, +;; `postgres_feat` are not referenced from any jcode source. +;; +;; The old fall-back-to-glibc behaviour was the recurring source of "works on +;; Mac, breaks on Linux": cargo build --release during normal jerboa dev +;; rebuilds the glibc artifact, and the musl build silently picked it up +;; (yielding __memcpy_chk / libstdc++ link errors at the final step). +;; +;; We force cargo to use the rustup-managed rustc — some PATH setups (e.g. +;; Homebrew rust ahead of the rustup proxies) resolve `rustc` to a binary +;; that has no musl target installed. Doing it via env (not `rustup run`) is +;; critical, because `rustup run stable cargo build` only configures cargo's +;; environment — cargo still launches whichever `rustc` appears first on +;; PATH for the child compilations. +;; +;; A sentinel file under target/ records the exact feature set that produced +;; the .a, so future builds rebuild iff features changed or any .rs source +;; is newer than the .a (jerboa-shell uses the same pattern). +(define jcode-cargo-features "tls,sqlite,crypto") (define native-lib-path (format "~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/libjerboa_native.a" jerboa-dir-base)) -(define has-native-lib? (file-exists? native-lib-path)) -(unless has-native-lib? - ;; Fall back to non-musl release build - (set! native-lib-path - (format "~a/jerboa-native-rs/target/release/libjerboa_native.a" jerboa-dir-base)) - (set! has-native-lib? (file-exists? native-lib-path)) - (when has-native-lib? - (printf " Warning: using glibc jerboa-native (not musl target) — binary may not be fully static~n")) - (unless has-native-lib? - (printf " Warning: libjerboa_native.a not found — TLS will be unavailable~n"))) +(define native-features-sentinel + (format "~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/.built-with-~a" + jerboa-dir-base + (let ([s (string-copy jcode-cargo-features)]) + (let loop ([i 0]) + (cond [(= i (string-length s)) s] + [(char=? (string-ref s i) #\,) (string-set! s i #\-) (loop (+ i 1))] + [else (loop (+ i 1))]))))) + +(define (rs-source-newer-than? a-path) + (let ([src-dir (format "~a/jerboa-native-rs/src" jerboa-dir-base)]) + (and (file-directory? src-dir) + (file-exists? a-path) + (let ([a-mtime (file-modification-time a-path)]) + (let walk ([dirs (list src-dir)]) + (and (pair? dirs) + (let* ([d (car dirs)] + [entries (map (lambda (e) (format "~a/~a" d e)) + (directory-list d))] + [files (filter (lambda (p) (not (file-directory? p))) entries)] + [subs (filter file-directory? entries)]) + (or (ormap (lambda (f) + (and (let ([n (string-length f)]) + (and (> n 3) + (string=? ".rs" (substring f (- n 3) n)))) + (time>? (file-modification-time f) a-mtime))) + files) + (walk (append subs (cdr dirs))))))))))) + +(define (try-cargo-build cmd) + (printf " $ ~a~n" cmd) + (zero? (system cmd))) + +(define (rebuild-native-lib!) + (let* ([nrs-dir (format "~a/jerboa-native-rs" jerboa-dir-base)] + [rustup-active (string-append (getenv "HOME") + "/.rustup/toolchains/stable-x86_64-unknown-linux-gnu/bin")] + [cargo-args (format "build --release --no-default-features --features ~a --target x86_64-unknown-linux-musl" + jcode-cargo-features)] + [via-rustup + (format "cd '~a' && env PATH='~a:'$PATH RUSTC='~a/rustc' cargo ~a" + nrs-dir rustup-active rustup-active cargo-args)] + [via-path + (format "cd '~a' && cargo ~a" nrs-dir cargo-args)] + [ok? (or (and (file-directory? rustup-active) (try-cargo-build via-rustup)) + (try-cargo-build via-path))]) + (unless (and ok? (file-exists? native-lib-path)) + (error 'build-jcode-musl + (string-append + "failed to build jerboa-native-rs for x86_64-unknown-linux-musl. " + "Required: `rustup target add x86_64-unknown-linux-musl`, musl-gcc, " + "and musl headers at /usr/include/x86_64-linux-musl. Do NOT fall back " + "to the glibc artifact at target/release/libjerboa_native.a — it " + "references __memcpy_chk and libstdc++ symbols musl-gcc cannot link.") + native-lib-path)) + ;; Record the feature set this .a was built with. + (call-with-output-file native-features-sentinel + (lambda (out) + (display jcode-cargo-features out) + (newline out)) + 'truncate))) + +(cond + [(not (file-exists? native-lib-path)) + (printf "[0.2/7] Building jerboa-native-rs (musl, features=~a)...~n" jcode-cargo-features) + (rebuild-native-lib!)] + [(not (file-exists? native-features-sentinel)) + (printf "[0.2/7] Rebuilding jerboa-native-rs — sentinel missing (features=~a)...~n" jcode-cargo-features) + (rebuild-native-lib!)] + [(rs-source-newer-than? native-lib-path) + (printf "[0.2/7] Rebuilding jerboa-native-rs — .rs source newer than .a...~n") + (rebuild-native-lib!)] + [else + (printf "[0.2/7] jerboa-native-rs up to date (features=~a)~n" jcode-cargo-features)]) +(define has-native-lib? #t) ;; Generate jcode_main_musl.c (define program-c (format "~a/jcode_main_musl.c" build-dir)) @@ -373,11 +603,26 @@ (lambda (name) (fprintf out "extern void ~a();\n" name)) ffi-symbols) (newline out) - ;; libc symbols — proper includes so prototypes match + ;; libc symbols — proper includes so prototypes match. + ;; Adding a symbol to libc-symbols above usually requires bumping the + ;; include set here too; otherwise the C compile fails with + ;; "implicit declaration" or "undeclared". (display "/* libc symbols for Sforeign_symbol registration */\n" out) (display "#include <sys/socket.h>\n" out) (display "#include <netinet/in.h>\n" out) (display "#include <arpa/inet.h>\n" out) + (display "#include <netdb.h>\n" out) ;; getaddrinfo, freeaddrinfo + (display "#include <sys/wait.h>\n" out) ;; waitpid + (display "#include <sys/resource.h>\n" out) ;; getrlimit + (display "#include <termios.h>\n" out) ;; tcgetattr/tcsetattr/tcgetpgrp/tcsetpgrp + (display "#include <signal.h>\n" out) ;; kill, sigemptyset/sigprocmask family + (display "#include <time.h>\n" out) ;; localtime, strftime + (display "#include <fcntl.h>\n" out) ;; fcntl + (display "#include <unistd.h>\n" out) ;; fork, dup, pipe, sysconf, ids, isatty + (display "#include <stdlib.h>\n" out) ;; setenv, unsetenv + (display "#include <string.h>\n" out) ;; strerror + ;; __errno_location has no public header — declare it ourselves. + (display "extern int *__errno_location(void);\n" out) (newline out) ;; Register FFI symbols callback (display "static void register_ffi(void) {\n" out) @@ -405,8 +650,12 @@ (display " perror(\"write\"); close(fd); unlink(prog_path); return 1;\n" out) (display " }\n" out) (display " close(fd);\n\n" out) - (display " /* Prevent load-shared-object in std/net/tcp etc. */\n" out) - (display " setenv(\"JEMACS_STATIC\", \"1\", 1);\n" out) + (display " /* Tell jerboa stdlib libraries (std/net/*, std/os/*, std/db/*)\n" out) + (display " * we are statically linked. Without JERBOA_STATIC=1 their\n" out) + (display " * library visit-time code calls (load-shared-object #f) which\n" out) + (display " * raises in a static binary. Variable must be set BEFORE\n" out) + (display " * Sscheme_init since libraries are visited during heap build. */\n" out) + (display " setenv(\"JERBOA_STATIC\", \"1\", 1);\n" out) (display "\n" out) (display " Sscheme_init(NULL);\n" out) (display " static_boot_init();\n" out) --- a/linux-check.ss +++ b/linux-check.ss @@ -92,7 +92,16 @@ (guard (exn [#t (printf "~n FAIL: compile-program raised an exception:~n") - (printf " ~a~n" (condition-message exn)) + (let ([msg (guard (e [#t #f]) (condition-message exn))] + [irr (guard (e [#t '()]) (condition-irritants exn))]) + (cond + [(and msg (pair? irr)) + (printf " ") (apply printf msg irr) (printf "~n")] + [msg (printf " ~a~n" msg)] + [else + (printf " ") + (display-condition exn) + (printf "~n")])) (printf "~n=== linux-check FAILED ===~n") (exit 1)]) (parameterize ([compile-imported-libraries #t] --- a/src/jcode/core/secrets.ss +++ b/src/jcode/core/secrets.ss @@ -37,6 +37,7 @@ (import :std/text/json :std/misc/string :std/os/path + :std/crypto/native-rust :jcode/core/log :jerboa/core :jerboa/runtime) @@ -111,130 +112,47 @@ (def (cached-secrets) (let ((c (unbox *secrets-cache*))) (and c (caddr c)))) ;;; ---- KDF + AEAD wrappers ---- +;;; +;;; Crypto primitives come from libjerboa_native (Rust ring) via +;;; (std crypto native-rust). The on-disk format below is preserved +;;; byte-for-byte from the prior libcrypto implementation: +;;; +;;; IV(12) || ciphertext || tag(16) +;;; +;;; ring's aead::seal returns ciphertext||tag concatenated, so we just +;;; prepend the IV. AES-256-GCM is AES-256-GCM regardless of backend — +;;; keys.enc files written with the previous OpenSSL version still +;;; decrypt unchanged. -;; libcrypto must be loaded before resolving foreign-procedure symbols. -;; (std crypto aead) also loads it, but at compile time symbol resolution -;; happens here, so we explicitly load up front. In static builds the -;; symbols are pre-registered via Sforeign_symbol. -(def _libcrypto-loaded - ;; Try in order: dlopen(NULL) (works when libcrypto symbols are - ;; statically linked into the binary), then absolute paths used by - ;; macOS/Homebrew and Linux. Bare "libcrypto.so"/".dylib" fails on - ;; macOS with SIP because dyld refuses untrusted library names. - (or (guard (e (#t #f)) (load-shared-object "") #t) - (guard (e (#t #f)) (load-shared-object "/opt/homebrew/opt/openssl@3/lib/libcrypto.dylib") #t) - (guard (e (#t #f)) (load-shared-object "/opt/homebrew/opt/openssl/lib/libcrypto.dylib") #t) - (guard (e (#t #f)) (load-shared-object "/usr/local/opt/openssl@3/lib/libcrypto.dylib") #t) - (guard (e (#t #f)) (load-shared-object "/usr/lib/libcrypto.dylib") #t) - (guard (e (#t #f)) (load-shared-object "/usr/lib/x86_64-linux-gnu/libcrypto.so.3") #t) - (guard (e (#t #f)) (load-shared-object "/usr/lib/aarch64-linux-gnu/libcrypto.so.3") #t) - (guard (e (#t #f)) (load-shared-object "libcrypto.so.3") #t) - (guard (e (#t #f)) (load-shared-object "libcrypto.so") #t))) - -(def c-PKCS5_PBKDF2_HMAC - (foreign-procedure "PKCS5_PBKDF2_HMAC" - (u8* int u8* int int uptr int u8*) int)) - -(def c-EVP_sha256 - (foreign-procedure "EVP_sha256" () uptr)) - -(def (derive-key passphrase salt) - (let* ((pass-bv (string->utf8 passphrase)) - (out (make-bytevector *key-bytes* 0)) - (rc (c-PKCS5_PBKDF2_HMAC - pass-bv (bytevector-length pass-bv) - salt (bytevector-length salt) - *pbkdf2-iters* - (c-EVP_sha256) - *key-bytes* - out))) - (unless (= rc 1) - (error 'derive-key "PBKDF2 failed")) - out)) - -;;; ---- AES-256-GCM via direct libcrypto FFI ---- -;;; Ciphertext layout: IV(12) || ct || tag(16). - -(def c-EVP_CIPHER_CTX_new - (foreign-procedure "EVP_CIPHER_CTX_new" () uptr)) -(def c-EVP_CIPHER_CTX_free - (foreign-procedure "EVP_CIPHER_CTX_free" (uptr) void)) -(def c-EVP_aes_256_gcm - (foreign-procedure "EVP_aes_256_gcm" () uptr)) -(def c-EVP_EncryptInit_ex - (foreign-procedure "EVP_EncryptInit_ex" (uptr uptr uptr u8* u8*) int)) -(def c-EVP_EncryptUpdate - (foreign-procedure "EVP_EncryptUpdate" (uptr u8* u8* u8* int) int)) -(def c-EVP_EncryptFinal_ex - (foreign-procedure "EVP_EncryptFinal_ex" (uptr u8* u8*) int)) -(def c-EVP_CIPHER_CTX_ctrl - (foreign-procedure "EVP_CIPHER_CTX_ctrl" (uptr int int u8*) int)) -(def c-EVP_DecryptInit_ex - (foreign-procedure "EVP_DecryptInit_ex" (uptr uptr uptr u8* u8*) int)) -(def c-EVP_DecryptUpdate - (foreign-procedure "EVP_DecryptUpdate" (uptr u8* u8* u8* int) int)) -(def c-EVP_DecryptFinal_ex - (foreign-procedure "EVP_DecryptFinal_ex" (uptr u8* u8*) int)) - -(def EVP_CTRL_GCM_GET_TAG #x10) -(def EVP_CTRL_GCM_SET_TAG #x11) (def GCM_IV_LEN 12) (def GCM_TAG_LEN 16) +(def *empty-aad* (make-bytevector 0)) + +(def (derive-key passphrase salt) + (rust-pbkdf2-derive (string->utf8 passphrase) + salt + *pbkdf2-iters* + *key-bytes*)) (def (encrypt-bytes plain-bv key) - (let* ((pt-len (bytevector-length plain-bv)) - (iv (random-bytes GCM_IV_LEN)) - (ct (make-bytevector pt-len)) - (tag (make-bytevector GCM_TAG_LEN)) - (outlen (make-bytevector 4 0)) - (ctx (c-EVP_CIPHER_CTX_new))) - (when (= ctx 0) (error 'encrypt-bytes "EVP_CIPHER_CTX_new failed")) - (dynamic-wind - (lambda () (void)) - (lambda () - (when (= 0 (c-EVP_EncryptInit_ex ctx (c-EVP_aes_256_gcm) 0 key iv)) - (error 'encrypt-bytes "EVP_EncryptInit_ex failed")) - (when (= 0 (c-EVP_EncryptUpdate ctx ct outlen plain-bv pt-len)) - (error 'encrypt-bytes "EVP_EncryptUpdate failed")) - (when (= 0 (c-EVP_EncryptFinal_ex ctx (make-bytevector 16) outlen)) - (error 'encrypt-bytes "EVP_EncryptFinal_ex failed")) - (when (= 0 (c-EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_GCM_GET_TAG GCM_TAG_LEN tag)) - (error 'encrypt-bytes "get tag failed")) - (let ((result (make-bytevector (+ GCM_IV_LEN pt-len GCM_TAG_LEN)))) - (bytevector-copy! iv 0 result 0 GCM_IV_LEN) - (bytevector-copy! ct 0 result GCM_IV_LEN pt-len) - (bytevector-copy! tag 0 result (+ GCM_IV_LEN pt-len) GCM_TAG_LEN) - result)) - (lambda () (c-EVP_CIPHER_CTX_free ctx))))) + (let* ((iv (random-bytes GCM_IV_LEN)) + (sealed (rust-aead-seal key iv plain-bv *empty-aad*)) + (sealed-len (bytevector-length sealed)) + (result (make-bytevector (+ GCM_IV_LEN sealed-len)))) + (bytevector-copy! iv 0 result 0 GCM_IV_LEN) + (bytevector-copy! sealed 0 result GCM_IV_LEN sealed-len) + result)) (def (decrypt-bytes cipher-bv key) - (let* ((total (bytevector-length cipher-bv)) - (ct-len (- total GCM_IV_LEN GCM_TAG_LEN))) - (when (< ct-len 0) + (let* ((total (bytevector-length cipher-bv)) + (body-len (- total GCM_IV_LEN))) + (when (< body-len GCM_TAG_LEN) (error 'decrypt-bytes "ciphertext too short")) - (let* ((iv (make-bytevector GCM_IV_LEN)) - (ct (make-bytevector ct-len)) - (tag (make-bytevector GCM_TAG_LEN)) - (pt (make-bytevector ct-len)) - (outlen (make-bytevector 4 0)) - (ctx (c-EVP_CIPHER_CTX_new))) - (bytevector-copy! cipher-bv 0 iv 0 GCM_IV_LEN) - (bytevector-copy! cipher-bv GCM_IV_LEN ct 0 ct-len) - (bytevector-copy! cipher-bv (+ GCM_IV_LEN ct-len) tag 0 GCM_TAG_LEN) - (when (= ctx 0) (error 'decrypt-bytes "EVP_CIPHER_CTX_new failed")) - (dynamic-wind - (lambda () (void)) - (lambda () - (when (= 0 (c-EVP_DecryptInit_ex ctx (c-EVP_aes_256_gcm) 0 key iv)) - (error 'decrypt-bytes "EVP_DecryptInit_ex failed")) - (when (= 0 (c-EVP_DecryptUpdate ctx pt outlen ct ct-len)) - (error 'decrypt-bytes "EVP_DecryptUpdate failed")) - (when (= 0 (c-EVP_CIPHER_CTX_ctrl ctx EVP_CTRL_GCM_SET_TAG GCM_TAG_LEN tag)) - (error 'decrypt-bytes "set tag failed")) - (when (= 0 (c-EVP_DecryptFinal_ex ctx (make-bytevector 16) outlen)) - (error 'decrypt-bytes "authentication failed — wrong key or corrupted store")) - pt) - (lambda () (c-EVP_CIPHER_CTX_free ctx)))))) + (let ((iv (make-bytevector GCM_IV_LEN)) + (body (make-bytevector body-len))) + (bytevector-copy! cipher-bv 0 iv 0 GCM_IV_LEN) + (bytevector-copy! cipher-bv GCM_IV_LEN body 0 body-len) + (rust-aead-open key iv body *empty-aad*)))) ;;; ---- passphrase prompt ----