Add Linux x86_64 musl + FreeBSD 14 amd64 cross-compile from macOS
ober
ba975e4e66bc002bb58ed715ba7ed4b85b7789e7
--- a/.gitignore +++ b/.gitignore @@ -17,11 +17,15 @@ jpg-musl.sha256 jpg-macos.sha256 jpg jpgp +/jpg-linux-amd64 +/jpg-freebsd-amd64 # Binary build intermediates *-main.c *.wp.so *_boot.h +/jpg_program.h +.claude/ # Editor / OS .DS_Store --- a/Makefile +++ b/Makefile @@ -12,7 +12,9 @@ else NATIVE_LIB := $(NATIVE_RELEASE)/libjpgp_native.so endif -.PHONY: help run test test-interop build-native binary install install-script clean +XC_LIBDIRS := $(CURDIR):$(JERBOA_HOME)/lib:$(JERBOA_HOME)/.chez-cross-ta6le/lib:$(JERBOA_HOME)/.chez-cross-ta6fb/lib + +.PHONY: help run test test-interop build-native binary install install-script clean linux-amd64 freebsd-amd64 linux freebsd jpg-linux-amd64 jpg-freebsd-amd64 .DEFAULT_GOAL := help help: @@ -98,9 +100,38 @@ install: binary @echo " bash: completions/jpg.bash -> ~/.local/share/bash-completion/completions/jpg" @echo " zsh : completions/_jpg -> any directory in \$$fpath" +# ── Cross-compile: Linux x86_64 musl (static) ──────────────────────────────── +linux: linux-amd64 +linux-amd64: jpg-linux-amd64 + +jpg-linux-amd64: + @test -d $(JERBOA_HOME)/.chez-cross-ta6le/lib || { \ + echo "ERROR: cross-prefix $(JERBOA_HOME)/.chez-cross-ta6le missing."; \ + echo " Run 'make binary' in $(JERBOA_HOME) first."; exit 1; } + @command -v x86_64-linux-musl-gcc >/dev/null 2>&1 || { \ + echo "ERROR: x86_64-linux-musl-gcc not in PATH (install musl-cross)."; exit 1; } + JERBOA_HOME=$(JERBOA_HOME) JPGP_REPO=$(CURDIR) \ + $(SCHEME) -q --libdirs '$(XC_LIBDIRS)' --script build-jpg-cross.ss + +# ── Cross-compile: FreeBSD 14 amd64 (dynamic) ───────────────────────────────── +freebsd: freebsd-amd64 +freebsd-amd64: jpg-freebsd-amd64 + +jpg-freebsd-amd64: + @test -d $(JERBOA_HOME)/.chez-cross-ta6fb/lib || { \ + echo "ERROR: cross-prefix $(JERBOA_HOME)/.chez-cross-ta6fb missing."; \ + echo " Run 'make binary' in $(JERBOA_HOME) first."; exit 1; } + @command -v x86_64-unknown-freebsd14-clang >/dev/null 2>&1 || { \ + echo "ERROR: x86_64-unknown-freebsd14-clang not in PATH (install FreeBSD sysroot + clang wrapper)."; exit 1; } + JERBOA_HOME=$(JERBOA_HOME) JPGP_REPO=$(CURDIR) \ + $(SCHEME) -q --libdirs '$(XC_LIBDIRS)' --script build-jpg-freebsd-cross.ss + clean: cd $(NATIVE_DIR) && cargo clean find . -name '*.so' -not -path './pgp-native/*' -delete find . -name '*.dylib' -not -path './pgp-native/*' -delete find . -name '*.wpo' -delete rm -f jpg-bin jpgp-bin + rm -f jpg-linux-amd64 jpg-linux-amd64-main.c jpg-linux-amd64.wp.so + rm -f jpg-freebsd-amd64 jpg-freebsd-amd64-main.c jpg-freebsd-amd64.wp.so + rm -f petite_boot.h scheme_boot.h jpg_program.h new file mode 100644 --- /dev/null +++ b/build-jpg-cross.ss @@ -0,0 +1,404 @@ +#!chezscheme +;;; build-jpg-cross.ss — Cross-compile jpg from macOS to Linux x86_64 musl +;;; +;;; Produces: jpg-linux-amd64 (static ELF, no shared library deps) +;;; +;;; Differs from sibling cross-builds in that we also build a target-arch +;;; libjpgp_native.a (pure-Rust crypto) and statically link it. + +(import (chezscheme)) + +(define jerboa-home + (or (getenv "JERBOA_HOME") "/Users/user/mine/jerboa")) + +(define jpgp-repo + (or (getenv "JPGP_REPO") (current-directory))) + +(define cross-prefix (format "~a/.chez-cross-ta6le" jerboa-home)) +(define xpatch (format "~a/build/chez/xc-ta6le/s/xpatch" jerboa-home)) +(define cross-cc (or (getenv "CROSS_CC") "x86_64-linux-musl-gcc")) + +(define output "jpg-linux-amd64") +(define entry-script "support/binary-entry.ss") + +(define cargo-features "tls,sqlite,crypto") + +(define jerboa-native-a + (or (getenv "JERBOA_NATIVE_A") + (format "~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/libjerboa_native.a" + jerboa-home))) + +(define jpgp-native-a + (format "~a/pgp-native/target/x86_64-unknown-linux-musl/release/libjpgp_native.a" + jpgp-repo)) + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-jpg-cross "cross prefix lib dir missing — run 'make binary' in jerboa first" lib)) + (let* ([entries (directory-list lib)] + [csvs (filter (lambda (e) + (and (>= (string-length e) 3) + (string=? (substring e 0 3) "csv"))) + entries)]) + (when (null? csvs) + (error 'build-jpg-cross "no csv* in cross lib" lib)) + (format "~a/~a/ta6le" lib (car csvs))))) + +(define (require-file p) + (unless (file-exists? p) + (error 'build-jpg-cross "missing file" p))) + +(require-file xpatch) +(require-file (format "~a/libkernel.a" cross-csv-dir)) +(require-file (format "~a/scheme.h" cross-csv-dir)) +(require-file (format "~a/petite.boot" cross-csv-dir)) +(require-file (format "~a/scheme.boot" cross-csv-dir)) +(require-file entry-script) + +(printf "==> build-jpg-cross~n") +(printf " JERBOA_HOME: ~a~n" jerboa-home) +(printf " JPGP_REPO: ~a~n" jpgp-repo) +(printf " cross csv-dir: ~a~n" cross-csv-dir) +(printf " cross-cc: ~a~n" cross-cc) +(printf " output: ~a~n~n" output) + +;; ── Step 0a: Build/rebuild jerboa-native-rs for x86_64-linux-musl ────────── +(define (path-dirname s) + (let loop ([i (- (string-length s) 1)]) + (cond [(< i 0) "."] + [(char=? (string-ref s i) #\/) (substring s 0 i)] + [else (loop (- i 1))]))) + +(define (capture-line cmd) + (call-with-values + (lambda () (open-process-ports cmd (buffer-mode block) (native-transcoder))) + (lambda (to-stdin from-stdout from-stderr pid) + (let ([line (get-line from-stdout)]) + (close-port to-stdin) + (close-port from-stdout) + (close-port from-stderr) + (if (or (eof-object? line) (zero? (string-length line))) #f line))))) + +(define rustup-rustc-path (capture-line "rustup which rustc 2>/dev/null")) +(define rustup-bin-dir (and rustup-rustc-path (path-dirname rustup-rustc-path))) + +(define (try-cargo-build cmd) + (printf " $ ~a~n" cmd) + (zero? (system cmd))) + +(define (rebuild-jerboa-native!) + (let* ([nrs-dir (format "~a/jerboa-native-rs" jerboa-home)] + [cargo-args (format "build --release --no-default-features --features ~a --target x86_64-unknown-linux-musl" + cargo-features)] + [via-rustup + (and rustup-bin-dir + (format "cd '~a' && env PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a" + nrs-dir rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))] + [via-path (format "cd '~a' && cargo ~a" nrs-dir cargo-args)] + [ok? (or (and via-rustup (try-cargo-build via-rustup)) + (try-cargo-build via-path))]) + (unless ok? + (error 'build-jpg-cross "failed to build jerboa-native-rs for x86_64-unknown-linux-musl")) + (unless (file-exists? jerboa-native-a) + (error 'build-jpg-cross "cargo succeeded but .a missing" jerboa-native-a)))) + +(cond + [(file-exists? jerboa-native-a) + (printf "==> jerboa-native-rs .a present~n")] + [else + (printf "==> jerboa-native-rs missing — building~n") + (rebuild-jerboa-native!)]) + +;; ── Step 0b: Build/rebuild pgp-native (libjpgp_native.a) ─────────────────── +(define (rebuild-jpgp-native!) + (let* ([nrs-dir (format "~a/pgp-native" jpgp-repo)] + [cargo-args "build --release --target x86_64-unknown-linux-musl"] + [via-rustup + (and rustup-bin-dir + (format "cd '~a' && env PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a" + nrs-dir rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))] + [via-path (format "cd '~a' && cargo ~a" nrs-dir cargo-args)] + [ok? (or (and via-rustup (try-cargo-build via-rustup)) + (try-cargo-build via-path))]) + (unless ok? + (error 'build-jpg-cross "failed to build pgp-native for x86_64-unknown-linux-musl")) + (unless (file-exists? jpgp-native-a) + (error 'build-jpg-cross "cargo succeeded but libjpgp_native.a missing" jpgp-native-a)))) + +(cond + [(file-exists? jpgp-native-a) + (printf "==> libjpgp_native.a present~n")] + [else + (printf "==> libjpgp_native.a missing — building~n") + (rebuild-jpgp-native!)]) + +(printf "~n") + +;; ── Step 0.5: Patch load-shared-object in libraries ──────────────────────── +(printf "==> [0.5/6] patching load-shared-object in libraries~n") +(define lso-patch-cmd + (string-append + "perl -i -0777 -pe 's/" + "\\(load-shared-object(?=\\s)" + "(?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|" + "(?<bal>\\((?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|(?&bal))*+\\))" + ")*+\\)/(void)/g'")) + +(define jerboa-lib-dir (format "~a/lib" jerboa-home)) +(system (format "find '~a' -name '*.sls' -exec ~a {} +" jerboa-lib-dir lso-patch-cmd)) +(system (format "find '~a' -name '*.ss' -exec ~a {} +" jpgp-repo lso-patch-cmd)) + +(system (format "find '~a' -name '*.so' -delete 2>/dev/null" jerboa-lib-dir)) +(system (format "find '~a/pgp' -name '*.so' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/pgp' -name '*.wpo' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/support' -name '*.so' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/support' -name '*.wpo' -delete 2>/dev/null" jpgp-repo)) + +(define (restore-patched-files!) + (printf "~n==> [cleanup] restoring patched .sls/.ss files via git~n") + (system (format "cd '~a' && git ls-files -z -- '*.sls' | xargs -0 git checkout -- 2>/dev/null" jerboa-home)) + (system (format "cd '~a' && git ls-files -z -- '*.ss' | xargs -0 git checkout -- 2>/dev/null" jpgp-repo))) + +;; ── Stage 1: load xpatch (target=ta6le emit mode) ────────────────────────── +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ta6le emit mode)~n") +(load xpatch) +(library-directories + (append + (list (cons jpgp-repo jpgp-repo) + (cons (format "~a/lib" jerboa-home) (format "~a/lib" jerboa-home))) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +;; ── Stage 2: compile-program entry-script ────────────────────────────────── +(printf "==> [2/6] compile-program ~a~n" entry-script) +(guard (e [#t (restore-patched-files!) (raise e)]) + (compile-program entry-script)) + +(define entry-wpo + (let ([n (string-length entry-script)]) + (string-append (substring entry-script 0 (- n 3)) ".wpo"))) + +;; ── Stage 3: compile-whole-program → wpo .so ─────────────────────────────── +(define wpo-output (string-append output ".wp.so")) +(printf "==> [3/6] compile-whole-program ~a -> ~a~n" entry-wpo wpo-output) +(guard (e [#t (restore-patched-files!) (raise e)]) + (compile-whole-program entry-wpo wpo-output #t)) + +;; ── Stage 4: embed boot files + program as C arrays ──────────────────────── +(define (embed-as-c-array in-path var-name out-path) + (let* ([bv (call-with-port (open-file-input-port in-path) get-bytevector-all)] + [n (bytevector-length bv)]) + (call-with-port (open-file-output-port out-path + (file-options no-fail) + (buffer-mode block) + (native-transcoder)) + (lambda (out) + (display (format "static const unsigned char ~a[] = {\n" var-name) out) + (let loop ([i 0]) + (when (< i n) + (display (format "0x~2,'0x," (bytevector-u8-ref bv i)) out) + (when (= (mod (+ i 1) 16) 0) (newline out)) + (loop (+ i 1)))) + (when (positive? n) (newline out)) + (display "};\n" out) + (display (format "static const unsigned int ~a_size = sizeof(~a);\n" + var-name var-name) + out))) + (printf " embed ~a (~a bytes) -> ~a~n" in-path n out-path))) + +(printf "==> [4/6] embed boot files + program as C arrays~n") +(embed-as-c-array (format "~a/petite.boot" cross-csv-dir) "petite_boot" "petite_boot.h") +(embed-as-c-array (format "~a/scheme.boot" cross-csv-dir) "scheme_boot" "scheme_boot.h") +(embed-as-c-array wpo-output "jpg_program" "jpg_program.h") + +;; ── Stage 5: generate main.c ─────────────────────────────────────────────── +(define jpgp-symbols + '("jpgp_abi_version" + "jpgp_age_keygen" "jpgp_age_encrypt" "jpgp_age_decrypt" + "jpgp_pass_encrypt" "jpgp_pass_decrypt" + "jpgp_ed25519_keygen" "jpgp_ed25519_sign" "jpgp_ed25519_verify" + "jpgp_pgp_encrypt" "jpgp_pgp_decrypt" "jpgp_pgp_sign" "jpgp_pgp_verify" + "jpgp_sha256")) + +(define jerboa-native-symbols + '("jerboa_tls_server_new" "jerboa_tls_server_new_mtls" + "jerboa_tls_server_free" "jerboa_tls_accept" + "jerboa_tls_connect" "jerboa_tls_connect_pinned" + "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_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_regex_compile" "jerboa_regex_is_match" + "jerboa_regex_find" "jerboa_regex_replace_all" "jerboa_regex_free" + "jerboa_aproc_spawn" "jerboa_aproc_spawn_pty" + "jerboa_aproc_set_nonblock" "jerboa_aproc_killpg" "jerboa_aproc_wait4" + "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_writev2")) + +(define posix-symbols + '("socket" "bind" "listen" "accept" "connect" "close" + "setsockopt" "getsockopt" "getsockname" + "htons" "ntohs" "inet_pton" "inet_addr" + "read" "write" "recvfrom" "sendto" + "getaddrinfo" "freeaddrinfo" "inet_ntop" + "fork" "waitpid" "kill" "getpid" "getppid" + "getpgid" "setpgid" "setsid" + "getuid" "geteuid" "getgid" "getegid" + "sigemptyset" "sigfillset" "sigaddset" "sigdelset" + "sigismember" "sigprocmask" + "isatty" "tcgetattr" "tcsetattr" "tcgetpgrp" "tcsetpgrp" + "pipe" "dup" "dup2" "lseek" + "setenv" "unsetenv" "strerror" "localtime" "strftime" + "sysconf" "getpagesize" "getrlimit" + "system" "getenv" "putenv" "_exit" "execvp" "execve" + "__errno_location" "fcntl")) + +(define main-c-path (string-append output "-main.c")) + +(define (emit-c out) + (display "/* Generated by build-jpg-cross.ss — do not edit by hand. */\n" out) + (display "#define _GNU_SOURCE\n" out) + (display "#include <stdlib.h>\n" out) + (display "#include <string.h>\n" out) + (display "#include <stdio.h>\n" out) + (display "#include <unistd.h>\n" out) + (display "#include <sys/mman.h>\n" out) + (display "#include <sys/types.h>\n" out) + (display "#include <sys/stat.h>\n" out) + (display "#include <sys/wait.h>\n" out) + (display "#include <sys/resource.h>\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) + (display "#include <termios.h>\n" out) + (display "#include <fcntl.h>\n" out) + (display "#include <signal.h>\n" out) + (display "#include <time.h>\n" out) + (display "#include <errno.h>\n" out) + (display "#include \"scheme.h\"\n" out) + (display "#include \"petite_boot.h\"\n" out) + (display "#include \"scheme_boot.h\"\n" out) + (display "#include \"jpg_program.h\"\n\n" out) + (display "/* dlopen stubs for static linking. */\n" out) + (display "void *dlopen(const char *f, int flags) { (void)flags; return f ? NULL : (void*)1; }\n" out) + (display "void *dlsym(void *h, const char *s) { (void)h; (void)s; return NULL; }\n" out) + (display "int dlclose(void *h) { (void)h; return 0; }\n" out) + (display "static char dlerror_msg[] = \"static binary: dlopen of named libraries is stubbed\";\n" out) + (display "char *dlerror(void) { return dlerror_msg; }\n\n" out) + (display "/* libjpgp_native.a — pure-Rust PGP/age/crypto backend */\n" out) + (for-each (lambda (n) (fprintf out "extern void ~a();\n" n)) jpgp-symbols) + (display "\n/* libjerboa_native.a — features=tls,sqlite,crypto */\n" out) + (for-each (lambda (n) (fprintf out "extern void ~a();\n" n)) jerboa-native-symbols) + (display "\nextern int *__errno_location(void);\n" out) + (newline out) + (display "static void register_ffi_symbols(void) {\n" out) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + jpgp-symbols) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + jerboa-native-symbols) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + posix-symbols) + (display "}\n\n" out) + (display "int main(int argc, char *argv[]) {\n" out) + (display " setenv(\"JERBOA_STATIC\", \"1\", 1);\n\n" out) + (display " int fd = memfd_create(\"jpg-program\", MFD_CLOEXEC);\n" out) + (display " char prog_path[64];\n" out) + (display " if (fd >= 0) {\n" out) + (display " if (write(fd, jpg_program, jpg_program_size) != (ssize_t)jpg_program_size) {\n" out) + (display " perror(\"write memfd\"); close(fd); return 1;\n" out) + (display " }\n" out) + (display " snprintf(prog_path, sizeof(prog_path), \"/proc/self/fd/%d\", fd);\n" out) + (display " } else {\n" out) + (display " const char *tmp = getenv(\"TMPDIR\"); if (!tmp) tmp = \"/tmp\";\n" out) + (display " snprintf(prog_path, sizeof(prog_path), \"%s/.jpg-prog-%d.so\", tmp, getpid());\n" out) + (display " FILE *fp = fopen(prog_path, \"wb\");\n" out) + (display " if (!fp) { perror(\"fopen tmpfile\"); return 1; }\n" out) + (display " if (fwrite(jpg_program, 1, jpg_program_size, fp) != jpg_program_size) {\n" out) + (display " perror(\"fwrite\"); fclose(fp); unlink(prog_path); return 1;\n" out) + (display " }\n" out) + (display " fclose(fp);\n" out) + (display " }\n\n" out) + (display " Sscheme_init(NULL);\n" out) + (display " Sregister_boot_file_bytes(\"petite\", (void *)petite_boot, petite_boot_size);\n" out) + (display " Sregister_boot_file_bytes(\"scheme\", (void *)scheme_boot, scheme_boot_size);\n" out) + (display " Sbuild_heap(NULL, NULL);\n" out) + (display " register_ffi_symbols();\n\n" out) + (display " int status = Sscheme_program(prog_path, argc, (const char **)argv);\n\n" out) + (display " if (fd >= 0) close(fd); else unlink(prog_path);\n" out) + (display " Sscheme_deinit();\n" out) + (display " return status;\n" out) + (display "}\n" out)) + +(call-with-port (open-file-output-port main-c-path + (file-options no-fail) (buffer-mode block) (native-transcoder)) + emit-c) +(printf "==> [5/6] generated ~a (~a jpgp + ~a native + ~a posix)~n" + main-c-path + (length jpgp-symbols) + (length jerboa-native-symbols) + (length posix-symbols)) + +;; ── Stage 6: compile + link with cross-cc ────────────────────────────────── +(printf "==> [6/6] compile + link with ~a~n" cross-cc) +(require-file jerboa-native-a) +(require-file jpgp-native-a) + +(define link-cmd + (format + (string-append + "~a -O2 -static -Wl,--export-dynamic " + "-I~a " ;; scheme.h + "-o ~a " ;; output + "~a " ;; main.c + "~a/libkernel.a ~a/libz.a ~a/liblz4.a " ;; chez kernel + "~a " ;; libjpgp_native.a + "~a " ;; libjerboa_native.a + "-Wl,--allow-multiple-definition " + "-Wl,--defsym=_dl_find_object=0 " + "-lm -ldl -lpthread") + cross-cc cross-csv-dir output + main-c-path + cross-csv-dir cross-csv-dir cross-csv-dir + jpgp-native-a + jerboa-native-a)) +(printf " ~a~n" link-cmd) +(let ([rc (system link-cmd)]) + (unless (zero? rc) + (restore-patched-files!) + (error 'build-jpg-cross "cross-link failed" rc))) + +(restore-patched-files!) + +(for-each (lambda (f) + (when (file-exists? f) (delete-file f))) + (list (string-append (substring entry-script 0 (- (string-length entry-script) 3)) ".so") + entry-wpo)) + +(printf "~n=== Build complete: ~a ===~n" output) +(system (format "ls -lh ~a" output)) +(system (format "file ~a" output)) new file mode 100644 --- /dev/null +++ b/build-jpg-freebsd-cross.ss @@ -0,0 +1,396 @@ +#!chezscheme +;;; build-jpg-freebsd-cross.ss — Cross-compile jpg from macOS to FreeBSD 14 amd64 +;;; +;;; Produces: jpg-freebsd-amd64 (dynamic ELF — libc symbol versioning +;;; blocks -static, so we link dynamic against the sysroot libc). + +(import (chezscheme)) + +(define jerboa-home + (or (getenv "JERBOA_HOME") "/Users/user/mine/jerboa")) + +(define jpgp-repo + (or (getenv "JPGP_REPO") (current-directory))) + +(define cross-prefix (format "~a/.chez-cross-ta6fb" jerboa-home)) +(define xpatch (format "~a/build/chez/xc-ta6fb/s/xpatch" jerboa-home)) +(define cross-cc (or (getenv "CROSS_CC") "x86_64-unknown-freebsd14-clang")) + +(define output "jpg-freebsd-amd64") +(define entry-script "support/binary-entry.ss") + +(define cargo-features "tls,sqlite,crypto") + +(define jerboa-native-a + (or (getenv "JERBOA_NATIVE_A") + (format "~a/jerboa-native-rs/target/x86_64-unknown-freebsd/release/libjerboa_native.a" + jerboa-home))) + +(define jpgp-native-a + (format "~a/pgp-native/target/x86_64-unknown-freebsd/release/libjpgp_native.a" + jpgp-repo)) + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-jpg-freebsd-cross "cross prefix lib dir missing — run 'make binary' in jerboa first" lib)) + (let* ([entries (directory-list lib)] + [csvs (filter (lambda (e) + (and (>= (string-length e) 3) + (string=? (substring e 0 3) "csv"))) + entries)]) + (when (null? csvs) + (error 'build-jpg-freebsd-cross "no csv* in cross lib" lib)) + (format "~a/~a/ta6fb" lib (car csvs))))) + +(define (require-file p) + (unless (file-exists? p) + (error 'build-jpg-freebsd-cross "missing file" p))) + +(require-file xpatch) +(require-file (format "~a/libkernel.a" cross-csv-dir)) +(require-file (format "~a/scheme.h" cross-csv-dir)) +(require-file (format "~a/petite.boot" cross-csv-dir)) +(require-file (format "~a/scheme.boot" cross-csv-dir)) +(require-file entry-script) + +(printf "==> build-jpg-freebsd-cross~n") +(printf " JERBOA_HOME: ~a~n" jerboa-home) +(printf " JPGP_REPO: ~a~n" jpgp-repo) +(printf " cross csv-dir: ~a~n" cross-csv-dir) +(printf " cross-cc: ~a~n" cross-cc) +(printf " output: ~a~n~n" output) + +(define (path-dirname s) + (let loop ([i (- (string-length s) 1)]) + (cond [(< i 0) "."] + [(char=? (string-ref s i) #\/) (substring s 0 i)] + [else (loop (- i 1))]))) + +(define (capture-line cmd) + (call-with-values + (lambda () (open-process-ports cmd (buffer-mode block) (native-transcoder))) + (lambda (to-stdin from-stdout from-stderr pid) + (let ([line (get-line from-stdout)]) + (close-port to-stdin) + (close-port from-stdout) + (close-port from-stderr) + (if (or (eof-object? line) (zero? (string-length line))) #f line))))) + +(define rustup-rustc-path (capture-line "rustup which rustc 2>/dev/null")) +(define rustup-bin-dir (and rustup-rustc-path (path-dirname rustup-rustc-path))) + +(define (try-cargo-build cmd) + (printf " $ ~a~n" cmd) + (zero? (system cmd))) + +(define (rebuild-jerboa-native!) + (let* ([nrs-dir (format "~a/jerboa-native-rs" jerboa-home)] + [cargo-args (format "build --release --no-default-features --features ~a --target x86_64-unknown-freebsd" + cargo-features)] + [env-prefix "env AR_x86_64_unknown_freebsd=/opt/homebrew/opt/llvm/bin/llvm-ar "] + [via-rustup + (and rustup-bin-dir + (format "cd '~a' && ~a PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a" + nrs-dir env-prefix rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))] + [via-path (format "cd '~a' && ~a cargo ~a" nrs-dir env-prefix cargo-args)] + [ok? (or (and via-rustup (try-cargo-build via-rustup)) + (try-cargo-build via-path))]) + (unless ok? + (error 'build-jpg-freebsd-cross "failed to build jerboa-native-rs for x86_64-unknown-freebsd")) + (unless (file-exists? jerboa-native-a) + (error 'build-jpg-freebsd-cross "cargo succeeded but .a missing" jerboa-native-a)))) + +(cond + [(file-exists? jerboa-native-a) + (printf "==> jerboa-native-rs .a present~n")] + [else + (printf "==> jerboa-native-rs missing — building~n") + (rebuild-jerboa-native!)]) + +(define (rebuild-jpgp-native!) + (let* ([nrs-dir (format "~a/pgp-native" jpgp-repo)] + [cargo-args "build --release --target x86_64-unknown-freebsd"] + [env-prefix "env AR_x86_64_unknown_freebsd=/opt/homebrew/opt/llvm/bin/llvm-ar "] + [via-rustup + (and rustup-bin-dir + (format "cd '~a' && ~a PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a" + nrs-dir env-prefix rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))] + [via-path (format "cd '~a' && ~a cargo ~a" nrs-dir env-prefix cargo-args)] + [ok? (or (and via-rustup (try-cargo-build via-rustup)) + (try-cargo-build via-path))]) + (unless ok? + (error 'build-jpg-freebsd-cross "failed to build pgp-native for x86_64-unknown-freebsd")) + (unless (file-exists? jpgp-native-a) + (error 'build-jpg-freebsd-cross "cargo succeeded but libjpgp_native.a missing" jpgp-native-a)))) + +(cond + [(file-exists? jpgp-native-a) + (printf "==> libjpgp_native.a present~n")] + [else + (printf "==> libjpgp_native.a missing — building~n") + (rebuild-jpgp-native!)]) + +(printf "~n") + +;; ── Step 0.5: Patch load-shared-object in libraries ──────────────────────── +(printf "==> [0.5/6] patching load-shared-object in libraries~n") +(define lso-patch-cmd + (string-append + "perl -i -0777 -pe 's/" + "\\(load-shared-object(?=\\s)" + "(?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|" + "(?<bal>\\((?:[^()\"]++|\"(?:\\\\.|[^\"\\\\])*+\"|(?&bal))*+\\))" + ")*+\\)/(void)/g'")) + +(define jerboa-lib-dir (format "~a/lib" jerboa-home)) +(system (format "find '~a' -name '*.sls' -exec ~a {} +" jerboa-lib-dir lso-patch-cmd)) +(system (format "find '~a' -name '*.ss' -exec ~a {} +" jpgp-repo lso-patch-cmd)) + +(system (format "find '~a' -name '*.so' -delete 2>/dev/null" jerboa-lib-dir)) +(system (format "find '~a/pgp' -name '*.so' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/pgp' -name '*.wpo' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/support' -name '*.so' -delete 2>/dev/null" jpgp-repo)) +(system (format "find '~a/support' -name '*.wpo' -delete 2>/dev/null" jpgp-repo)) + +(define (restore-patched-files!) + (printf "~n==> [cleanup] restoring patched .sls/.ss files via git~n") + (system (format "cd '~a' && git ls-files -z -- '*.sls' | xargs -0 git checkout -- 2>/dev/null" jerboa-home)) + (system (format "cd '~a' && git ls-files -z -- '*.ss' | xargs -0 git checkout -- 2>/dev/null" jpgp-repo))) + +;; ── Stage 1: load xpatch ─────────────────────────────────────────────────── +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ta6fb emit mode)~n") +(load xpatch) +(library-directories + (append + (list (cons jpgp-repo jpgp-repo) + (cons (format "~a/lib" jerboa-home) (format "~a/lib" jerboa-home))) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +;; ── Stage 2: compile-program ─────────────────────────────────────────────── +(printf "==> [2/6] compile-program ~a~n" entry-script) +(guard (e [#t (restore-patched-files!) (raise e)]) + (compile-program entry-script)) + +(define entry-wpo + (let ([n (string-length entry-script)]) + (string-append (substring entry-script 0 (- n 3)) ".wpo"))) + +;; ── Stage 3: compile-whole-program ───────────────────────────────────────── +(define wpo-output (string-append output ".wp.so")) +(printf "==> [3/6] compile-whole-program ~a -> ~a~n" entry-wpo wpo-output) +(guard (e [#t (restore-patched-files!) (raise e)]) + (compile-whole-program entry-wpo wpo-output #t)) + +;; ── Stage 4: embed ──────────────────────────────────────────────────────── +(define (embed-as-c-array in-path var-name out-path) + (let* ([bv (call-with-port (open-file-input-port in-path) get-bytevector-all)] + [n (bytevector-length bv)]) + (call-with-port (open-file-output-port out-path + (file-options no-fail) + (buffer-mode block) + (native-transcoder)) + (lambda (out) + (display (format "static const unsigned char ~a[] = {\n" var-name) out) + (let loop ([i 0]) + (when (< i n) + (display (format "0x~2,'0x," (bytevector-u8-ref bv i)) out) + (when (= (mod (+ i 1) 16) 0) (newline out)) + (loop (+ i 1)))) + (when (positive? n) (newline out)) + (display "};\n" out) + (display (format "static const unsigned int ~a_size = sizeof(~a);\n" + var-name var-name) + out))) + (printf " embed ~a (~a bytes) -> ~a~n" in-path n out-path))) + +(printf "==> [4/6] embed boot files + program as C arrays~n") +(embed-as-c-array (format "~a/petite.boot" cross-csv-dir) "petite_boot" "petite_boot.h") +(embed-as-c-array (format "~a/scheme.boot" cross-csv-dir) "scheme_boot" "scheme_boot.h") +(embed-as-c-array wpo-output "jpg_program" "jpg_program.h") + +;; ── Stage 5: generate main.c (FreeBSD variant) ───────────────────────────── +(define jpgp-symbols + '("jpgp_abi_version" + "jpgp_age_keygen" "jpgp_age_encrypt" "jpgp_age_decrypt" + "jpgp_pass_encrypt" "jpgp_pass_decrypt" + "jpgp_ed25519_keygen" "jpgp_ed25519_sign" "jpgp_ed25519_verify" + "jpgp_pgp_encrypt" "jpgp_pgp_decrypt" "jpgp_pgp_sign" "jpgp_pgp_verify" + "jpgp_sha256")) + +(define jerboa-native-symbols + '("jerboa_tls_server_new" "jerboa_tls_server_new_mtls" + "jerboa_tls_server_free" "jerboa_tls_accept" + "jerboa_tls_connect" "jerboa_tls_connect_pinned" + "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_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_regex_compile" "jerboa_regex_is_match" + "jerboa_regex_find" "jerboa_regex_replace_all" "jerboa_regex_free" + "jerboa_aproc_spawn" "jerboa_aproc_spawn_pty" + "jerboa_aproc_set_nonblock" "jerboa_aproc_killpg" "jerboa_aproc_wait4" + "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")) + +(define linux-only-stub-symbols + ;; Linux-only kernel facilities. Return -1 (errno EOPNOTSUPP) so any + ;; .a object that references them links cleanly on FreeBSD. + '("jerboa_writev2")) + +(define posix-symbols + '("socket" "bind" "listen" "accept" "connect" "close" + "setsockopt" "getsockopt" "getsockname" + "htons" "ntohs" "inet_pton" "inet_addr" + "read" "write" "recvfrom" "sendto" + "getaddrinfo" "freeaddrinfo" "inet_ntop" + "fork" "waitpid" "kill" "getpid" "getppid" + "getpgid" "setpgid" "setsid" + "getuid" "geteuid" "getgid" "getegid" + "sigemptyset" "sigfillset" "sigaddset" "sigdelset" + "sigismember" "sigprocmask" + "isatty" "tcgetattr" "tcsetattr" "tcgetpgrp" "tcsetpgrp" + "pipe" "dup" "dup2" "lseek" + "setenv" "unsetenv" "strerror" "localtime" "strftime" + "sysconf" "getpagesize" "getrlimit" + "system" "getenv" "putenv" "_exit" "execvp" "execve" + "fcntl")) + +(define main-c-path (string-append output "-main.c")) + +(define (emit-c out) + (display "/* Generated by build-jpg-freebsd-cross.ss — do not edit by hand. */\n" out) + (display "#include <stdlib.h>\n" out) + (display "#include <string.h>\n" out) + (display "#include <stdio.h>\n" out) + (display "#include <unistd.h>\n" out) + (display "#include <sys/types.h>\n" out) + (display "#include <sys/stat.h>\n" out) + (display "#include <sys/wait.h>\n" out) + (display "#include <sys/resource.h>\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) + (display "#include <termios.h>\n" out) + (display "#include <fcntl.h>\n" out) + (display "#include <signal.h>\n" out) + (display "#include <time.h>\n" out) + (display "#include <errno.h>\n" out) + (display "#include \"scheme.h\"\n" out) + (display "#include \"petite_boot.h\"\n" out) + (display "#include \"scheme_boot.h\"\n" out) + (display "#include \"jpg_program.h\"\n\n" out) + ;; errno wrapper — FreeBSD calls it __error; glibc/musl __errno_location. + (display "static int *freebsd_errno_location(void) { return &errno; }\n\n" out) + (display "/* Linux-only stubs (always return -1 / set EOPNOTSUPP). */\n" out) + (for-each (lambda (n) + (fprintf out "long ~a() { errno = EOPNOTSUPP; return -1; }\n" n)) + linux-only-stub-symbols) + (display "\n/* libjpgp_native.a */\n" out) + (for-each (lambda (n) (fprintf out "extern void ~a();\n" n)) jpgp-symbols) + (display "\n/* libjerboa_native.a — features=tls,sqlite,crypto */\n" out) + (for-each (lambda (n) (fprintf out "extern void ~a();\n" n)) jerboa-native-symbols) + (newline out) + (display "static void register_ffi_symbols(void) {\n" out) + (display " Sforeign_symbol(\"__errno_location\", (void*)freebsd_errno_location);\n" out) + (display " Sforeign_symbol(\"__error\", (void*)freebsd_errno_location);\n" out) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + jpgp-symbols) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + jerboa-native-symbols) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + linux-only-stub-symbols) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + posix-symbols) + (display "}\n\n" out) + (display "int main(int argc, char *argv[]) {\n" out) + (display " setenv(\"JERBOA_STATIC\", \"1\", 1);\n\n" out) + (display " char prog_path[64];\n" out) + (display " const char *tmp = getenv(\"TMPDIR\"); if (!tmp) tmp = \"/tmp\";\n" out) + (display " snprintf(prog_path, sizeof(prog_path), \"%s/.jpg-prog-%d.so\", tmp, getpid());\n" out) + (display " {\n" out) + (display " FILE *fp = fopen(prog_path, \"wb\");\n" out) + (display " if (!fp) { perror(\"fopen tmpfile\"); return 1; }\n" out) + (display " if (fwrite(jpg_program, 1, jpg_program_size, fp) != jpg_program_size) {\n" out) + (display " perror(\"fwrite\"); fclose(fp); unlink(prog_path); return 1;\n" out) + (display " }\n" out) + (display " fclose(fp);\n" out) + (display " }\n\n" out) + (display " Sscheme_init(NULL);\n" out) + (display " Sregister_boot_file_bytes(\"petite\", (void *)petite_boot, petite_boot_size);\n" out) + (display " Sregister_boot_file_bytes(\"scheme\", (void *)scheme_boot, scheme_boot_size);\n" out) + (display " Sbuild_heap(NULL, NULL);\n" out) + (display " register_ffi_symbols();\n\n" out) + (display " int status = Sscheme_program(prog_path, argc, (const char **)argv);\n\n" out) + (display " unlink(prog_path);\n" out) + (display " Sscheme_deinit();\n" out) + (display " return status;\n" out) + (display "}\n" out)) + +(call-with-port (open-file-output-port main-c-path + (file-options no-fail) (buffer-mode block) (native-transcoder)) + emit-c) +(printf "==> [5/6] generated ~a~n" main-c-path) + +;; ── Stage 6: compile + link ─────────────────────────────────────────────── +(printf "==> [6/6] compile + link with ~a~n" cross-cc) +(require-file jerboa-native-a) +(require-file jpgp-native-a) + +(define link-cmd + (format + (string-append + "~a -O2 -Wl,--export-dynamic " + "-I~a " ;; scheme.h + "-o ~a " ;; output + "~a " ;; main.c + "~a/libkernel.a ~a/libz.a ~a/liblz4.a " ;; chez kernel + "~a " ;; libjpgp_native.a + "~a " ;; libjerboa_native.a + "-lm -lpthread -lutil") + cross-cc cross-csv-dir output + main-c-path + cross-csv-dir cross-csv-dir cross-csv-dir + jpgp-native-a + jerboa-native-a)) +(printf " ~a~n" link-cmd) +(let ([rc (system link-cmd)]) + (unless (zero? rc) + (restore-patched-files!) + (error 'build-jpg-freebsd-cross "cross-link failed" rc))) + +(restore-patched-files!) + +(for-each (lambda (f) + (when (file-exists? f) (delete-file f))) + (list (string-append (substring entry-script 0 (- (string-length entry-script) 3)) ".so") + entry-wpo)) + +(printf "~n=== Build complete: ~a ===~n" output) +(system (format "ls -lh ~a" output)) +(system (format "file ~a" output))