Add cross compilation targets
ober
6a8bc545d7d3dc38457c86675116a04a58aa612c
--- a/.gitignore +++ b/.gitignore @@ -1,8 +1,17 @@ gitsafe-bin +gitsafe-linux-amd64 +gitsafe-linux-arm64 +gitsafe-freebsd-amd64 +gitsafe-*.wp.so +gitsafe-*-main.c gitsafe-musl gitsafe-musl.sha256 gitsafe-macos gitsafe-macos.sha256 +petite_boot.h +scheme_boot.h +gitsafe_program.h +.build/ *.so *.wpo .jerboa/ --- a/Makefile +++ b/Makefile @@ -4,9 +4,11 @@ # release toolchain for this os/arch into .jerboa/bin (support/ensure-jerboa.sh). JERBOA_VERSION ?= v0.2.0 JERBOA_TOOL_DIR ?= $(CURDIR)/.jerboa/bin -JERBUILD ?= $(shell if [ -x "$(JERBOA_TOOL_DIR)/jerbuild" ]; then echo "$(JERBOA_TOOL_DIR)/jerbuild"; \ +JERBUILD ?= $(shell if [ -x ./jerbuild ] && [ -x ./jerboa ]; then echo ./jerbuild; \ + elif [ -x "$(JERBOA_TOOL_DIR)/jerbuild" ] && [ -x "$(JERBOA_TOOL_DIR)/jerboa" ]; then echo "$(JERBOA_TOOL_DIR)/jerbuild"; \ elif [ -x ../jerboa/dist/jerbuild ] && [ -x ../jerboa/dist/jerboa ]; then echo ../jerboa/dist/jerbuild; \ - elif command -v jerbuild >/dev/null 2>&1; then command -v jerbuild; \ + elif [ -x ../jerboa/jerbuild ]; then echo ../jerboa/jerbuild; \ + elif command -v jerbuild >/dev/null 2>&1 && command -v jerboa >/dev/null 2>&1; then command -v jerbuild; \ else echo "$(JERBOA_TOOL_DIR)/jerbuild"; fi) JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) @@ -16,8 +18,12 @@ BIN := gitsafe-bin BIN_DIR := $(HOME)/.local/bin TEMPLATE_DIR := $(HOME)/.git-templates HOOK_DIR := $(TEMPLATE_DIR)/hooks +JERBOA_HOME ?= $(HOME)/mine/jerboa +SCHEME ?= $(JERBOA_HOME)/.chez/bin/scheme +FREEBSD_AMD64_CC ?= $(JERBOA_HOME)/support/cross-cc-freebsd-amd64 +XC_LIBDIRS = $(CURDIR):$(JERBOA_HOME)/lib:$(JH)/lib -.PHONY: all build binary run test install clean help ensure-jerboa-tools +.PHONY: all build binary run test install clean help ensure-jerboa-tools linux linux-amd64 linux-arm64 freebsd freebsd-amd64 .DEFAULT_GOAL := help all: binary @@ -25,7 +31,15 @@ all: binary # Make sure a working jerbuild exists; download the release toolchain for # this os/arch into $(JERBOA_TOOL_DIR) when none is found. ensure-jerboa-tools: - @if "$(JERBUILD)" --jerboa-home >/dev/null 2>&1; then \ + @if [ -x ./jerbuild ] && [ -x ./jerboa ]; then \ + echo "=== Using project-local ./jerbuild ==="; \ + elif [ -x "$(JERBOA_TOOL_DIR)/jerbuild" ] && [ -x "$(JERBOA_TOOL_DIR)/jerboa" ]; then \ + echo "=== Using downloaded Jerboa toolchain: $(JERBOA_TOOL_DIR) ==="; \ + elif [ -x ../jerboa/dist/jerbuild ] && [ -x ../jerboa/dist/jerboa ]; then \ + echo "=== Using sibling Jerboa build: ../jerboa/dist/jerbuild ==="; \ + elif [ -x ../jerboa/jerbuild ]; then \ + echo "=== Using sibling Jerboa build: ../jerboa/jerbuild ==="; \ + elif command -v jerbuild >/dev/null 2>&1 && command -v jerboa >/dev/null 2>&1; then \ echo "=== Using Jerboa toolchain: $(JERBUILD) ==="; \ else \ echo "=== Fetching Jerboa $(JERBOA_VERSION) release tools into $(JERBOA_TOOL_DIR) ==="; \ @@ -59,14 +73,67 @@ install: binary git config --global init.templateDir $(TEMPLATE_DIR) @echo "Installed gitsafe to $(BIN_DIR)/gitsafe + global git hooks." +linux: linux-amd64 + +linux-amd64: ensure-jerboa-tools + @command -v x86_64-linux-musl-gcc >/dev/null 2>&1 || { \ + echo "ERROR: x86_64-linux-musl-gcc not found on PATH."; \ + echo "Install with: brew install FiloSottile/musl-cross/musl-cross"; \ + exit 1; } + @if test ! -d "$(JERBOA_HOME)/.chez-cross-ta6le" || test ! -f "$(JERBOA_HOME)/build/chez/xc-ta6le/s/xpatch"; then \ + echo "=== cross Chez (ta6le) missing - building it in $(JERBOA_HOME) (one-time) ==="; \ + $(MAKE) -C "$(JERBOA_HOME)" chez-cross CHEZ_TARGET_MACHINE=ta6le CROSS_CC=x86_64-linux-musl-gcc; \ + fi + JERBOA_HOME="$(JERBOA_HOME)" TARGET_ARCH=amd64 CROSS_CC=x86_64-linux-musl-gcc \ + "$(SCHEME)" -q --libdirs "$(XC_LIBDIRS)" --script build-gitsafe-cross.ss + @ls -lh gitsafe-linux-amd64 + @file gitsafe-linux-amd64 + +linux-arm64: ensure-jerboa-tools + @command -v aarch64-linux-musl-gcc >/dev/null 2>&1 || { \ + echo "ERROR: aarch64-linux-musl-gcc not found on PATH."; \ + echo "Install with: brew install FiloSottile/musl-cross/musl-cross"; \ + exit 1; } + @if test ! -d "$(JERBOA_HOME)/.chez-cross-tarm64le" || test ! -f "$(JERBOA_HOME)/build/chez/xc-tarm64le/s/xpatch"; then \ + echo "=== cross Chez (tarm64le) missing - building it in $(JERBOA_HOME) (one-time) ==="; \ + $(MAKE) -C "$(JERBOA_HOME)" chez-cross CHEZ_TARGET_MACHINE=tarm64le CROSS_CC=aarch64-linux-musl-gcc; \ + fi + JERBOA_HOME="$(JERBOA_HOME)" TARGET_ARCH=arm64 CROSS_CC=aarch64-linux-musl-gcc \ + "$(SCHEME)" -q --libdirs "$(XC_LIBDIRS)" --script build-gitsafe-cross.ss + @ls -lh gitsafe-linux-arm64 + @file gitsafe-linux-arm64 + +freebsd: freebsd-amd64 + +freebsd-amd64: ensure-jerboa-tools + @test -x "$(FREEBSD_AMD64_CC)" || { \ + echo "ERROR: $(FREEBSD_AMD64_CC) not found or not executable" >&2; \ + echo "Set FREEBSD_AMD64_CC=/path/to/cross-cc-freebsd-amd64." >&2; \ + exit 1; } + @if test ! -d "$(JERBOA_HOME)/.chez-cross-ta6fb" || test ! -f "$(JERBOA_HOME)/build/chez/xc-ta6fb/s/xpatch"; then \ + echo "=== cross Chez (ta6fb) missing - building it in $(JERBOA_HOME) (one-time) ==="; \ + $(MAKE) -C "$(JERBOA_HOME)" chez-cross CHEZ_TARGET_MACHINE=ta6fb CROSS_CC="$(FREEBSD_AMD64_CC)"; \ + fi + JERBOA_HOME="$(JERBOA_HOME)" CROSS_CC="$(FREEBSD_AMD64_CC)" \ + "$(SCHEME)" -q --libdirs "$(XC_LIBDIRS)" --script build-gitsafe-freebsd-cross.ss + @ls -lh gitsafe-freebsd-amd64 + @file gitsafe-freebsd-amd64 + clean: find . \( -name '*.so' -o -name '*.wpo' \) -delete 2>/dev/null || true - rm -f gitsafe-bin gitsafe-jerbuild + rm -rf .build + rm -f gitsafe-bin gitsafe-jerbuild gitsafe-linux-amd64 gitsafe-linux-arm64 gitsafe-freebsd-amd64 + rm -f gitsafe-linux-amd64.wp.so gitsafe-linux-arm64.wp.so gitsafe-freebsd-amd64.wp.so + rm -f gitsafe-linux-amd64-main.c gitsafe-linux-arm64-main.c gitsafe-freebsd-amd64-main.c + rm -f petite_boot.h scheme_boot.h gitsafe_program.h help: @echo "gitsafe — secret-scanning git hooks (jerbuild + cc only)" @echo "" @echo " make binary Build the standalone ./gitsafe-bin (auto-downloads jerbuild)" + @echo " make linux-amd64 Cross-build ./gitsafe-linux-amd64 (musl static)" + @echo " make linux-arm64 Cross-build ./gitsafe-linux-arm64 (musl static)" + @echo " make freebsd-amd64 Cross-build ./gitsafe-freebsd-amd64 (FreeBSD dynamic)" @echo " make run ARGS='...' Build + run ./gitsafe-bin" @echo " make test Run the test suite" @echo " make install Build + install to ~/.local/bin + global git hooks" --- a/README.md +++ b/README.md @@ -34,9 +34,13 @@ export PATH="$HOME/.local/bin:$PATH" ```bash make binary # Native build → ./gitsafe-bin +make linux-amd64 # Linux x86_64 musl static → ./gitsafe-linux-amd64 +make linux-arm64 # Linux arm64 musl static → ./gitsafe-linux-arm64 +make freebsd-amd64 # FreeBSD amd64 dynamic → ./gitsafe-freebsd-amd64 ``` To pin a toolchain explicitly: `make binary JERBUILD=/path/to/jerbuild` or `JERBOA_VERSION=<tag>`. +Cross targets use `JERBOA_HOME` for Chez cross prefixes and still run `ensure-jerboa-tools`, so a missing `jerbuild` is bootstrapped the same way as native builds. ## Setting Up Existing Repos @@ -294,6 +298,9 @@ Options: ``` make binary Native build → ./gitsafe-bin (auto-downloads jerbuild) +make linux-amd64 Cross-build Linux x86_64 musl static binary +make linux-arm64 Cross-build Linux arm64 musl static binary +make freebsd-amd64 Cross-build FreeBSD amd64 dynamic binary make install Build + install to ~/.local/bin + global hooks make run ARGS='...' Build + run ./gitsafe-bin make test Run test suite new file mode 100644 --- /dev/null +++ b/build-gitsafe-cross.ss @@ -0,0 +1,249 @@ +#!chezscheme +;;; Cross-compile gitsafe from this host to Linux musl. +;;; +;;; TARGET_ARCH: +;;; amd64 (default) -> ta6le + x86_64-linux-musl-gcc -> gitsafe-linux-amd64 +;;; arm64 -> tarm64le + aarch64-linux-musl-gcc -> gitsafe-linux-arm64 + +(import (chezscheme)) + +(define (require-env name) + (or (getenv name) + (error 'build-gitsafe-cross "required environment variable is not set" name))) + +(define jerboa-home (require-env "JERBOA_HOME")) +(define target-arch (or (getenv "TARGET_ARCH") "amd64")) + +(define arch-table + '(("amd64" "ta6le" "x86_64-linux-musl-gcc" "gitsafe-linux-amd64") + ("arm64" "tarm64le" "aarch64-linux-musl-gcc" "gitsafe-linux-arm64"))) + +(define arch-row + (or (assoc target-arch arch-table) + (error 'build-gitsafe-cross + (format "unknown TARGET_ARCH (expected amd64|arm64): ~a" target-arch)))) + +(define chez-machine (list-ref arch-row 1)) +(define cross-prefix (format "~a/.chez-cross-~a" jerboa-home chez-machine)) +(define xpatch (format "~a/build/chez/xc-~a/s/xpatch" jerboa-home chez-machine)) +(define cross-cc (or (getenv "CROSS_CC") (list-ref arch-row 2))) +(define output (list-ref arch-row 3)) +(define entry-script "gitsafe/main-binary.ss") + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-gitsafe-cross "cross prefix lib dir missing" 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-gitsafe-cross "no csv* in cross lib" lib)) + (format "~a/~a/~a" lib (car csvs) chez-machine)))) + +(define (require-file p) + (unless (file-exists? p) + (error 'build-gitsafe-cross "missing file" p))) + +(require-file xpatch) +(require-file (format "~a/libkernel.a" cross-csv-dir)) +(require-file (format "~a/libz.a" cross-csv-dir)) +(require-file (format "~a/liblz4.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-gitsafe-cross~n") +(printf " JERBOA_HOME: ~a~n" jerboa-home) +(printf " machine: ~a~n" chez-machine) +(printf " cross csv-dir: ~a~n" cross-csv-dir) +(printf " xpatch: ~a~n" xpatch) +(printf " cross-cc: ~a~n" cross-cc) +(printf " output: ~a~n~n" output) + +(define obj-dir (format ".build/~a-obj" output)) +(define entry-so (format "~a/program.so" obj-dir)) +(define entry-wpo (format "~a/program.wpo" obj-dir)) + +(define (prepare-obj-dir!) + (system (format "rm -rf '~a'" obj-dir)) + (system (format "mkdir -p '~a'" obj-dir))) + +(define (cleanup!) + (system (format "rm -rf '~a'" obj-dir))) + +(prepare-obj-dir!) + +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ~a emit mode)~n" chez-machine) +(load xpatch) +(library-directories + (map (lambda (pair) + (cons (if (pair? pair) (car pair) pair) obj-dir)) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +(printf "==> [2/6] compile-program ~a -> ~a~n" entry-script entry-so) +(guard (e [#t (cleanup!) (raise e)]) + (compile-program entry-script entry-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 (cleanup!) (raise e)]) + (compile-whole-program entry-wpo wpo-output #t)) + +(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 "gitsafe_program" "gitsafe_program.h") + +(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" + "open" "ftruncate" "mmap" "munmap" "flock" "usleep" + "setenv" "unsetenv" "strerror" "localtime" "strftime" + "sysconf" "getpagesize" "getrlimit" + "system" "getenv" "putenv" "_exit" "exit" "execvp" "execve" + "mkstemp" "mkdtemp" "unlink" "rmdir" + "__errno_location" "fcntl" "prctl" "syscall")) + +(define main-c-path (string-append output "-main.c")) + +(define (emit-c out) + (display "/* Generated by build-gitsafe-cross.ss. */\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/prctl.h>\n" out) + (display "#include <sys/file.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 \"gitsafe_program.h\"\n\n" out) + (display "void *dlopen(const char *f, int flags) { (void)flags; return (!f || f[0] == '\\0') ? (void*)1 : NULL; }\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 "extern int *__errno_location(void);\n\n" out) + (display "static void register_ffi_symbols(void) {\n" out) + (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(\"gitsafe-program\", MFD_CLOEXEC);\n" out) + (display " char prog_path[4096];\n" out) + (display " if (fd >= 0) {\n" out) + (display " if (write(fd, gitsafe_program, gitsafe_program_size) != (ssize_t)gitsafe_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/.gitsafe-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(gitsafe_program, 1, gitsafe_program_size, fp) != gitsafe_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 posix symbols)~n" + main-c-path (length posix-symbols)) + +(printf "==> [6/6] compile + link with ~a~n" cross-cc) +(define link-cmd + (format + (string-append + "~a -O2 -static -Wl,--export-dynamic " + "-I~a " + "-o ~a " + "~a " + "~a/libkernel.a ~a/libz.a ~a/liblz4.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)) +(printf " ~a~n" link-cmd) +(let ([rc (system link-cmd)]) + (unless (zero? rc) + (cleanup!) + (error 'build-gitsafe-cross "cross-link failed" rc))) + +(cleanup!) + +(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-gitsafe-freebsd-cross.ss @@ -0,0 +1,218 @@ +#!chezscheme +;;; Cross-compile gitsafe from this host to FreeBSD amd64. + +(import (chezscheme)) + +(define (require-env name) + (or (getenv name) + (error 'build-gitsafe-freebsd-cross + "required environment variable is not set" name))) + +(define jerboa-home (require-env "JERBOA_HOME")) +(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") + (format "~a/support/cross-cc-freebsd-amd64" jerboa-home))) +(define output "gitsafe-freebsd-amd64") +(define entry-script "gitsafe/main-binary.ss") + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-gitsafe-freebsd-cross "cross prefix lib dir missing" 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-gitsafe-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-gitsafe-freebsd-cross "missing file" p))) + +(require-file xpatch) +(require-file (format "~a/libkernel.a" cross-csv-dir)) +(require-file (format "~a/libz.a" cross-csv-dir)) +(require-file (format "~a/liblz4.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-gitsafe-freebsd-cross~n") +(printf " JERBOA_HOME: ~a~n" jerboa-home) +(printf " cross csv-dir: ~a~n" cross-csv-dir) +(printf " xpatch: ~a~n" xpatch) +(printf " cross-cc: ~a~n" cross-cc) +(printf " output: ~a~n~n" output) + +(define obj-dir (format ".build/~a-obj" output)) +(define entry-so (format "~a/program.so" obj-dir)) +(define entry-wpo (format "~a/program.wpo" obj-dir)) + +(define (prepare-obj-dir!) + (system (format "rm -rf '~a'" obj-dir)) + (system (format "mkdir -p '~a'" obj-dir))) + +(define (cleanup!) + (system (format "rm -rf '~a'" obj-dir))) + +(prepare-obj-dir!) + +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ta6fb emit mode)~n") +(load xpatch) +(library-directories + (map (lambda (pair) + (cons (if (pair? pair) (car pair) pair) obj-dir)) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +(printf "==> [2/6] compile-program ~a -> ~a~n" entry-script entry-so) +(guard (e [#t (cleanup!) (raise e)]) + (compile-program entry-script entry-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 (cleanup!) (raise e)]) + (compile-whole-program entry-wpo wpo-output #t)) + +(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 "gitsafe_program" "gitsafe_program.h") + +(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" + "open" "ftruncate" "mmap" "munmap" "flock" "usleep" + "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-gitsafe-freebsd-cross.ss. */\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/mman.h>\n" out) + (display "#include <sys/file.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 \"gitsafe_program.h\"\n\n" out) + (display "static int *freebsd_errno_location(void) { return &errno; }\n\n" out) + (display "static void register_ffi_symbols(void) {\n" out) + (for-each (lambda (n) + (fprintf out " Sforeign_symbol(\"~a\", (void*)~a);\n" n n)) + posix-symbols) + (display " Sforeign_symbol(\"__errno_location\", (void*)freebsd_errno_location);\n" out) + (display " Sforeign_symbol(\"__error\", (void*)freebsd_errno_location);\n" out) + (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[4096];\n" out) + (display " const char *tmp = getenv(\"TMPDIR\"); if (!tmp) tmp = \"/tmp\";\n" out) + (display " snprintf(prog_path, sizeof(prog_path), \"%s/.gitsafe-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(gitsafe_program, 1, gitsafe_program_size, fp) != gitsafe_program_size) {\n" out) + (display " perror(\"fwrite\"); fclose(fp); unlink(prog_path); return 1;\n" out) + (display " }\n" out) + (display " fclose(fp);\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 (~a posix symbols)~n" + main-c-path (length posix-symbols)) + +(printf "==> [6/6] compile + link with ~a~n" cross-cc) +(define link-cmd + (format + (string-append + "~a -O2 -Wl,--export-dynamic " + "-I~a " + "-o ~a " + "~a " + "~a/libkernel.a ~a/libz.a ~a/liblz4.a " + "-lm -lpthread -lutil") + cross-cc cross-csv-dir output + main-c-path + cross-csv-dir cross-csv-dir cross-csv-dir)) +(printf " ~a~n" link-cmd) +(let ([rc (system link-cmd)]) + (unless (zero? rc) + (cleanup!) + (error 'build-gitsafe-freebsd-cross "cross-link failed" rc))) + +(cleanup!) + +(printf "~n=== Build complete: ~a ===~n" output) +(system (format "ls -lh ~a" output)) +(system (format "file ~a" output))