Initial jgl: Jerboa GitLab CLI (issues + CI/CD)
ober
e9093c65d48c1d68f5235bb9208cff72ea7ebf74
new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,22 @@ +# Build artifacts +/jgl +/jgl-*amd64 +/jgl-*arm64 +*.wp.so +*.so +*.wpo +*.boot + +# Generated by the build (see support/gen-ffi-symbols.sh and cross scripts) +support/ffi-symbols.gen +jgl-main.c +jgl-*-main.c +*_boot.h +*_program.h + +# Default export output +/issues/ + +# Editor/OS +*~ +.DS_Store new file mode 100644 --- /dev/null +++ b/.jerbuild @@ -0,0 +1,17 @@ +;; Build jerboa-gitlab's `jgl` binary with a standalone jerbuild: `jerbuild build`. +;; +;; jerbuild bundles Chez Scheme + the jerboa stdlib + the jerboa-native Rust +;; crate, so this needs only jerbuild + a C compiler + cargo — no jerboa source +;; checkout. jerboa-native provides Rustls HTTPS (tls + crypto), which the +;; GitLab REST client in (std net request) uses. + +(entry "jgl.ss") +(output "jgl") +(libdirs "lib") +;; Register the linked-in jerboa-native symbols (regenerated per-platform by +;; the Makefile between the two build passes). +(ffi-symbols "support/ffi-symbols.gen") +(rust-crates + ("@bundle/jerboa-native-rs/Cargo.toml" + features: "tls,crypto" + no-default-features: #t)) new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,72 @@ +# jerbuild bundles Chez Scheme + the jerboa stdlib + the jerboa-native Rust +# crate, so building jerboa-gitlab needs only jerbuild + a C compiler + cargo — +# no jerboa source checkout. jerboa-native provides Rustls HTTPS (tls,crypto). +JERBUILD ?= jerbuild +JH := $(shell $(JERBUILD) --jerboa-home 2>/dev/null) +ifeq ($(JH),) +$(error jerbuild not found on PATH (or '$(JERBUILD) --jerboa-home' failed). Install jerbuild, or set JERBUILD=/path/to/jerbuild) +endif + +NATIVE_DIR := $(JH)/jerboa-native-rs/target/release +LIBDIRS := --libdirs lib:$(JH)/lib +JEXEC := $(JERBUILD) exec $(LIBDIRS) +BIN := jgl +BIN_DIR := $(HOME)/.local/bin +# The std net modules dlopen libjerboa_native in interpreter mode; point the +# loader at jerbuild's cache for `make run`/`make test`. +DYLD := DYLD_FALLBACK_LIBRARY_PATH="$(NATIVE_DIR)" LD_LIBRARY_PATH="$(NATIVE_DIR):$$LD_LIBRARY_PATH" + +# Cross-compilation prerequisites (shared across the jerboa-* family). +JERBOA_HOME ?= $(HOME)/mine/jerboa +SCHEME ?= scheme +CROSS_LIBDIRS ?= lib:$(JERBOA_HOME)/lib:$(HOME)/mine/jerboa-https/src:$(HOME)/mine/jerboa-ssl/src + +.PHONY: all build binary run test install clean help cross-linux cross-freebsd +.DEFAULT_GOAL := help + +all: binary + +# Standalone native binary via .jerbuild (entry jgl.ss -> jgl). +# Two passes: pass 1 cargo-builds jerboa-native into jerbuild's cache; we then +# regenerate the FFI symbol list (platform-correct) and relink. +binary: + @touch support/ffi-symbols.gen + $(JERBUILD) build + sh support/gen-ffi-symbols.sh + $(JERBUILD) build + +build: binary + +run: binary + $(DYLD) ./$(BIN) $(ARGS) + +test: + $(DYLD) $(JEXEC) test/test-jgl.ss + +install: binary + mkdir -p $(BIN_DIR) + install -m 0755 $(BIN) $(BIN_DIR)/$(BIN) + @echo "Installed $(BIN) to $(BIN_DIR)/$(BIN)" + +# Cross-compile from macOS to Linux x86_64 musl (static) / FreeBSD 14 amd64. +# See build-jgl-*-cross.ss headers for the required cross toolchain. +cross-linux: + JERBOA_HOME=$(JERBOA_HOME) $(SCHEME) -q --libdirs $(CROSS_LIBDIRS) --script build-jgl-cross.ss + +cross-freebsd: + JERBOA_HOME=$(JERBOA_HOME) $(SCHEME) -q --libdirs $(CROSS_LIBDIRS) --script build-jgl-freebsd-cross.ss + +clean: + rm -f $(BIN) jgl-linux-amd64 jgl-freebsd-amd64 jgl-*main.c *.h *.boot *.wp.so + find . \( -name '*.so' -o -name '*.wpo' \) -delete 2>/dev/null || true + +help: + @echo "jerboa-gitlab -- the jgl GitLab CLI (jerbuild + cargo + cc)" + @echo "" + @echo " make binary Build the standalone ./jgl" + @echo " make run ARGS='...' Build + run ./jgl" + @echo " make test Run the test suite" + @echo " make install Build + install to ~/.local/bin/jgl" + @echo " make cross-linux Cross-build jgl-linux-amd64 (musl static)" + @echo " make cross-freebsd Cross-build jgl-freebsd-amd64" + @echo " make clean Remove build artifacts" new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,144 @@ +# jerboa-gitlab — `jgl` + +A small GitLab CLI written in [Jerboa](https://git.sr.ht/~lisp/jerboa): fetch +issues, query CI/CD, and archive issues to markdown. It talks to the GitLab +REST API v4 over HTTPS (Rustls, via the bundled `jerboa-native` crate). + +Inspired by [`gitlab-issue-exporter`](https://github.com/ober/gitlab-issue-exporter) +(a Go issue-archiver); `jgl` keeps the markdown-export idea and adds CI/CD +queries and a JSON output mode. + +## What it does + +- **Issues** — list (with state/label/search filters), show one issue with its + comments, and export every issue to one markdown file per issue. +- **CI/CD** — list recent pipelines, show a pipeline and its jobs, list recent + jobs, and report the latest pipeline status for a ref. +- **Project** — show project metadata (a quick auth/connectivity check). +- **Output** — human-readable text (default) or raw JSON (`--format json`). + +## Build + +`jgl` builds with just [`jerbuild`](https://git.sr.ht/~lisp/jerboa) — it bundles +Chez Scheme, the Jerboa stdlib, and the `jerboa-native` Rust crate (Rustls +HTTPS). You need `jerbuild`, a C compiler, and `cargo`. + +```sh +make binary # -> ./jgl +make install # -> ~/.local/bin/jgl +make test # run the unit tests +``` + +The same `make binary` works natively on macOS, Linux, and FreeBSD. To +cross-compile from macOS to other targets, see [Cross-compilation](#cross-compilation). + +## Usage + +``` +jgl <command> [options] +``` + +| Command | Description | +|--------------------|-----------------------------------------------------| +| `project` | Show project info (verifies url/token/project) | +| `issues` | List issues | +| `issue <iid>` | Show one issue with comments | +| `export` | Export all issues to markdown (`--output DIR`) | +| `pipelines` | List recent CI/CD pipelines | +| `pipeline <id>` | Show a pipeline and its jobs | +| `jobs` | List recent jobs (`--pipeline ID` to scope) | +| `ci-status` | Latest pipeline status (`--ref` to scope) | + +| Option | Description | +|-------------------|----------------------------------------------------------| +| `--url URL` | GitLab base URL (env `GITLAB_URL`, default `https://gitlab.com`) | +| `--token TOKEN` | Access token (env `GITLAB_TOKEN`); optional for public projects | +| `-p, --project P` | Project ID or path, e.g. `123` or `group/proj` (env `GITLAB_PROJECT`) | +| `-f, --format FMT`| `text` (default) or `json` | +| `--state STATE` | issues: `opened` \| `closed` \| `all` (default `all`) | +| `--labels A,B` | issues: filter by labels | +| `--search TEXT` | issues: search term | +| `--ref REF` | pipelines/ci-status: branch or tag | +| `--status STATUS` | pipelines: filter by status | +| `--pipeline ID` | jobs: restrict to a pipeline | +| `-o, --output DIR`| export: output directory (default `./issues`) | +| `-h, --help` | Show help | +| `--version` | Show version | + +A token with `read_api` scope is needed for private projects; public projects +read without one. Set credentials once via the environment: + +```sh +export GITLAB_URL="https://gitlab.com" +export GITLAB_TOKEN="glpat-xxxxxxxxxxxx" +export GITLAB_PROJECT="group/project" +``` + +### Examples + +```sh +# Issues (filters, JSON) +jgl issues -p group/proj --state opened --labels bug +jgl issue 42 -p group/proj +jgl issues -p group/proj -f json + +# CI/CD +jgl pipelines -p group/proj --ref main +jgl pipeline 123456 -p group/proj +jgl ci-status -p group/proj --ref main + +# Archive every issue to markdown +jgl export -p group/proj -o ./archive +``` + +## Markdown export + +`jgl export` writes one directory per issue: + +``` +issues/ +├── issue-1/ +│ ├── README.md +│ └── attachments/ (referenced /uploads/ files, best-effort) +└── issue-2/ + └── README.md +``` + +Each `README.md` has the title, metadata (state, author, assignees, labels, +dates, URL), the description, and non-system comments. When the project is given +as a path (`group/proj`), referenced `/uploads/` attachments are downloaded into +`attachments/` and the links are rewritten to point at the local copies; if a +download fails the original link is left intact. + +## Cross-compilation + +The `make binary` path is portable (it runs natively on each OS). To build +Linux/FreeBSD binaries *from macOS*, two scripts adapt the proven +`jerboa-aws` cross pattern (which uses the `jerboa-ssl`/OpenSSL static path): + +```sh +make cross-linux # -> jgl-linux-amd64 (x86_64 musl, static) +make cross-freebsd # -> jgl-freebsd-amd64 (x86_64, dynamic) +``` + +These require the shared cross toolchain used across the `jerboa-*` family — +a cross-built Chez install, the `jerboa-ssl` shim object, and musl-OpenSSL / +a FreeBSD sysroot. See the headers of `build-jgl-cross.ss` and +`build-jgl-freebsd-cross.ss` for the exact prerequisites and env overrides. + +## Layout + +``` +jgl.ss entry point (argv via env or command line) +lib/jgl/client.ss HTTPS + JSON + pagination + percent-encoding +lib/jgl/config.ss resolve url/token/project from flags + env +lib/jgl/format.ss field access, JSON re-serialization, formatters +lib/jgl/issues.ss issue list/get/notes + markdown export +lib/jgl/ci.ss pipelines / jobs / latest status +lib/jgl/cli.ss argument parsing, dispatch, rendering +test/test-jgl.ss unit tests (pure logic) +``` + +## License + +MIT. new file mode 100644 --- /dev/null +++ b/build-all.ss @@ -0,0 +1,11 @@ +#!chezscheme +;; Build driver: importing every module triggers Chez compilation of the whole +;; library graph (used by the cross-build scripts and as a quick "does it all +;; compile" smoke check). +(import + (jgl client) + (jgl config) + (jgl format) + (jgl issues) + (jgl ci) + (jgl cli)) new file mode 100644 --- /dev/null +++ b/build-jgl-cross.ss @@ -0,0 +1,261 @@ +#!chezscheme +;;; build-jgl-cross.ss — Cross-compile jgl from macOS arm64 to Linux x86_64 musl. +;;; +;;; Usage (from the repo root): +;;; JERBOA_HOME=$HOME/mine/jerboa scheme -q \ +;;; --libdirs lib:$HOME/mine/jerboa/lib:$HOME/mine/jerboa-https/src:$HOME/mine/jerboa-ssl/src \ +;;; --script build-jgl-cross.ss +;;; (or: make cross-linux) +;;; +;;; Adapted from jerboa-aws/build-jaws-cross.ss — jgl uses the identical +;;; (std net request) networking stack, so the same SSL-shim static-link path +;;; applies. Prerequisites (built once, shared across the jerboa-* family): +;;; - $JERBOA_HOME/.chez-cross-ta6le/ — cross-built Chez install (ta6le) +;;; - $JERBOA_HOME/build/chez/xc-ta6le/s/xpatch — host -> ta6le emit-mode loader +;;; - x86_64-linux-musl-gcc — C compile + final static link +;;; - ~/mine/jerboa-ssl/jerboa_ssl_shim-linux-musl.o (built by jerboa-ssl Makefile) +;;; - ~/musl-openssl/usr/{lib,include} — Alpine static libssl.a + libcrypto.a +;;; +;;; Produces: jgl-linux-amd64 (static Linux x86_64 ELF). + +(import (chezscheme)) + +;; ── Params ────────────────────────────────────────────────────────────────── +(define jerboa-home + (or (getenv "JERBOA_HOME") "/Users/user/mine/jerboa")) + +(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 "jgl-linux-amd64") +(define entry-script "jgl.ss") + +(define jgl-repo (current-directory)) +(define jerboa-ssl-repo + (or (getenv "JERBOASSL_REPO") (format "~a/mine/jerboa-ssl" (getenv "HOME")))) +(define jerboa-https-repo + (or (getenv "JERBOAHTTPS_REPO") (format "~a/mine/jerboa-https" (getenv "HOME")))) +(define jerboa-ssl-shim-o + (or (getenv "JERBOA_SSL_SHIM_LINUX_O") + (format "~a/jerboa_ssl_shim-linux-musl.o" jerboa-ssl-repo))) +(define musl-openssl-dir + (or (getenv "MUSL_OPENSSL_DIR") (format "~a/musl-openssl" (getenv "HOME")))) + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-jgl-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-jgl-cross "no csv* in cross lib" lib)) + (format "~a/~a/ta6le" lib (car csvs))))) + +(define (require-file p) + (unless (file-exists? p) + (error 'build-jgl-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) +(require-file jerboa-ssl-shim-o) +(require-file (format "~a/usr/lib/libssl.a" musl-openssl-dir)) +(require-file (format "~a/usr/lib/libcrypto.a" musl-openssl-dir)) + +(printf "==> build-jgl-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 " jerboa-ssl shim: ~a~n" jerboa-ssl-shim-o) +(printf " musl openssl: ~a~n" musl-openssl-dir) +(printf " output: ~a~n" output) +(printf "~n") + +;; ── Stage 1: load xpatch (target=ta6le emit mode) ────────────────────────── +;; xpatch resets library-directories; restore + extend with our source libdirs. +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ta6le emit mode)~n") +(load xpatch) +(library-directories + (append + (list (cons (format "~a/lib" jgl-repo) (format "~a/lib" jgl-repo)) + (cons (format "~a/lib" jerboa-home) (format "~a/lib" jerboa-home)) + (cons (format "~a/src" jerboa-https-repo) (format "~a/src" jerboa-https-repo)) + (cons (format "~a/src" jerboa-ssl-repo) (format "~a/src" jerboa-ssl-repo))) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +;; ── Stage 2: compile-program jgl.ss ───────────────────────────────────────── +(printf "==> [2/6] compile-program ~a~n" entry-script) +(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) +(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 "jgl_program" "jgl_program.h") + +;; ── Stage 5: generate main.c ─────────────────────────────────────────────── +(define main-c-path (string-append output "-main.c")) + +;; jerboa-ssl/jerboa_ssl_shim.c symbol surface — must match the foreign-procedure +;; declarations in jerboa-ssl.sls. +(define jerboa-ssl-symbols + '("jerboa_ssl_init" "jerboa_ssl_cleanup" + "jerboa_ssl_connect" "jerboa_ssl_write" "jerboa_ssl_read" + "jerboa_ssl_read_all" "jerboa_ssl_free_buf" "jerboa_ssl_close" + "jerboa_ssl_memcpy" + "jerboa_ssl_server_ctx" "jerboa_ssl_server_accept" "jerboa_ssl_server_ctx_free" + "jerboa_tcp_listen" "jerboa_tcp_accept" + "jerboa_tcp_connect" "jerboa_tcp_close" + "jerboa_tcp_read" "jerboa_tcp_write" "jerboa_tcp_read_all" + "jerboa_tcp_set_timeout" + "jerboa_tcp_conn_wrap" + "jerboa_conn_write" "jerboa_conn_read")) + +(printf "==> [5/6] generate ~a (~a jerboa-ssl symbols)~n" + main-c-path (length jerboa-ssl-symbols)) + +(define (write-main-c) + (call-with-port + (open-file-output-port main-c-path + (file-options no-fail) (buffer-mode block) (native-transcoder)) + (lambda (out) + (display "/* Auto-generated by build-jgl-cross.ss. Do not edit. */\n" out) + (display "#define _GNU_SOURCE\n" out) + (display "#include <stdio.h>\n" out) + (display "#include <stdlib.h>\n" out) + (display "#include <string.h>\n" out) + (display "#include <unistd.h>\n" out) + (display "#include <sys/mman.h>\n" out) + (display "#include <fcntl.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 \"jgl_program.h\"\n\n" out) + + ;; dlopen stubs (musl-static has no dlopen) + (display "/* dlopen stubs for static linking. Returning non-NULL for any\n" out) + (display " * named load makes (load-shared-object \"...\") succeed silently;\n" out) + (display " * foreign-procedure lookup uses Sforeign_symbol-registered entries. */\n" out) + (display "void *dlopen(const char *f, int flags) { (void)f; (void)flags; return (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 stubbed\";\n" out) + (display "char *dlerror(void) { return dlerror_msg; }\n\n" out) + + ;; extern decls for jerboa-ssl symbols + (display "/* jerboa_ssl_shim.o exports — registered with Sforeign_symbol below. */\n" out) + (for-each + (lambda (sym) (display (format "extern void ~a(void);\n" sym) out)) + jerboa-ssl-symbols) + (newline out) + + (display "int main(int argc, char *argv[]) {\n" out) + (display " /* Argv passthrough via env vars (matches the native jgl main). */\n" out) + (display " char countbuf[32];\n" out) + (display " snprintf(countbuf, sizeof(countbuf), \"%d\", argc - 1);\n" out) + (display " setenv(\"JGL_ARGC\", countbuf, 1);\n" out) + (display " for (int i = 1; i < argc; i++) {\n" out) + (display " char name[32];\n" out) + (display " snprintf(name, sizeof(name), \"JGL_ARG%d\", i - 1);\n" out) + (display " setenv(name, argv[i], 1);\n" out) + (display " }\n\n" out) + + ;; Memfd-backed program path + (display " int fd = memfd_create(\"jgl-program\", MFD_CLOEXEC);\n" out) + (display " if (fd < 0) { perror(\"memfd_create\"); return 1; }\n" out) + (display " if (write(fd, jgl_program, jgl_program_size) != (ssize_t)jgl_program_size) {\n" out) + (display " perror(\"write memfd\"); close(fd); return 1;\n" out) + (display " }\n" out) + (display " char prog_path[64];\n" out) + (display " snprintf(prog_path, sizeof(prog_path), \"/proc/self/fd/%d\", fd);\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\n" out) + + (display " /* Register jerboa_ssl_shim symbols so a -static binary resolves\n" out) + (display " * (foreign-procedure \"jerboa_ssl_*\" ...) without dlsym. */\n" out) + (for-each + (lambda (sym) + (display (format " Sforeign_symbol(\"~a\", (void*)~a);\n" sym sym) out)) + jerboa-ssl-symbols) + (newline out) + + (display " Sbuild_heap(NULL, NULL);\n" out) + (display " const char *script_args[] = { argv[0] };\n" out) + (display " int status = Sscheme_program(prog_path, 1, script_args);\n\n" out) + (display " close(fd);\n" out) + (display " Sscheme_deinit();\n" out) + (display " return status;\n" out) + (display "}\n" out)))) +(write-main-c) + +;; ── Stage 6: compile + link with cross-cc ────────────────────────────────── +(printf "==> [6/6] compile + link with ~a~n" cross-cc) + +(define link-cmd + (format + (string-append + "~a -static -O2 " + "-I~a -I~a/usr/include " + "~a ~a " + "-Wl,--start-group " + "~a/libkernel.a ~a/libz.a ~a/liblz4.a " + "~a/usr/lib/libssl.a ~a/usr/lib/libcrypto.a " + "-lpthread -lm -ldl " + "-Wl,--end-group " + "-o ~a") + cross-cc + cross-csv-dir musl-openssl-dir + main-c-path jerboa-ssl-shim-o + cross-csv-dir cross-csv-dir cross-csv-dir + musl-openssl-dir musl-openssl-dir + output)) + +(printf " ~a~n" link-cmd) +(unless (zero? (system link-cmd)) + (error 'build-jgl-cross "link failed")) + +(printf "~n==> done: ~a~n" output) new file mode 100644 --- /dev/null +++ b/build-jgl-freebsd-cross.ss @@ -0,0 +1,252 @@ +#!chezscheme +;;; build-jgl-freebsd-cross.ss — Cross-compile jgl from macOS to FreeBSD 14 amd64. +;;; +;;; Usage (from the repo root): +;;; JERBOA_HOME=$HOME/mine/jerboa scheme -q \ +;;; --libdirs lib:$HOME/mine/jerboa/lib:$HOME/mine/jerboa-https/src:$HOME/mine/jerboa-ssl/src \ +;;; --script build-jgl-freebsd-cross.ss +;;; (or: make cross-freebsd) +;;; +;;; Adapted from jerboa-aws/build-jaws-freebsd-cross.ss. Prerequisites: +;;; - $JERBOA_HOME/.chez-cross-ta6fb/ — cross-built Chez install (ta6fb) +;;; - $JERBOA_HOME/build/chez/xc-ta6fb/s/xpatch — host -> ta6fb emit-mode loader +;;; - x86_64-unknown-freebsd14-clang — wrapper with sysroot + lld + libpath +;;; - ~/mine/jerboa-ssl/jerboa_ssl_shim-freebsd-amd64.o +;;; - ~/freebsd-sysroot/usr/lib/{libssl,libcrypto,...}.so (dynamic link) +;;; +;;; Produces: jgl-freebsd-amd64 (dynamic FreeBSD x86_64 ELF). Dynamic because +;;; FreeBSD libc.so uses symbol versioning that libc.a can't satisfy; libssl/ +;;; libcrypto are resolved from FreeBSD base at run time. + +(import (chezscheme)) + +;; ── Params ────────────────────────────────────────────────────────────────── +(define jerboa-home + (or (getenv "JERBOA_HOME") "/Users/user/mine/jerboa")) + +(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 "jgl-freebsd-amd64") +(define entry-script "jgl.ss") + +(define jgl-repo (current-directory)) +(define jerboa-ssl-repo + (or (getenv "JERBOASSL_REPO") (format "~a/mine/jerboa-ssl" (getenv "HOME")))) +(define jerboa-https-repo + (or (getenv "JERBOAHTTPS_REPO") (format "~a/mine/jerboa-https" (getenv "HOME")))) +(define jerboa-ssl-shim-o + (or (getenv "JERBOA_SSL_SHIM_FREEBSD_O") + (format "~a/jerboa_ssl_shim-freebsd-amd64.o" jerboa-ssl-repo))) +(define freebsd-sysroot + (or (getenv "FREEBSD_SYSROOT") (format "~a/freebsd-sysroot" (getenv "HOME")))) + +(define cross-csv-dir + (let ([lib (format "~a/lib" cross-prefix)]) + (unless (file-directory? lib) + (error 'build-jgl-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-jgl-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-jgl-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) +(require-file jerboa-ssl-shim-o) +(require-file (format "~a/usr/lib/libssl.so" freebsd-sysroot)) + +(printf "==> build-jgl-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 " jerboa-ssl shim: ~a~n" jerboa-ssl-shim-o) +(printf " freebsd sysroot: ~a~n" freebsd-sysroot) +(printf " output: ~a~n" output) +(printf "~n") + +;; ── Stage 1: load xpatch (target=ta6fb emit mode) ────────────────────────── +(define orig-libdirs (library-directories)) +(printf "==> [1/6] loading xpatch (compiler -> ta6fb emit mode)~n") +(load xpatch) +(library-directories + (append + (list (cons (format "~a/lib" jgl-repo) (format "~a/lib" jgl-repo)) + (cons (format "~a/lib" jerboa-home) (format "~a/lib" jerboa-home)) + (cons (format "~a/src" jerboa-https-repo) (format "~a/src" jerboa-https-repo)) + (cons (format "~a/src" jerboa-ssl-repo) (format "~a/src" jerboa-ssl-repo))) + orig-libdirs)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +;; ── Stage 2: compile-program jgl.ss ───────────────────────────────────────── +(printf "==> [2/6] compile-program ~a~n" entry-script) +(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) +(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 "jgl_program" "jgl_program.h") + +;; ── Stage 5: generate main.c ─────────────────────────────────────────────── +(define main-c-path (string-append output "-main.c")) + +(define jerboa-ssl-symbols + '("jerboa_ssl_init" "jerboa_ssl_cleanup" + "jerboa_ssl_connect" "jerboa_ssl_write" "jerboa_ssl_read" + "jerboa_ssl_read_all" "jerboa_ssl_free_buf" "jerboa_ssl_close" + "jerboa_ssl_memcpy" + "jerboa_ssl_server_ctx" "jerboa_ssl_server_accept" "jerboa_ssl_server_ctx_free" + "jerboa_tcp_listen" "jerboa_tcp_accept" + "jerboa_tcp_connect" "jerboa_tcp_close" + "jerboa_tcp_read" "jerboa_tcp_write" "jerboa_tcp_read_all" + "jerboa_tcp_set_timeout" + "jerboa_tcp_conn_wrap" + "jerboa_conn_write" "jerboa_conn_read")) + +(printf "==> [5/6] generate ~a (~a jerboa-ssl symbols)~n" + main-c-path (length jerboa-ssl-symbols)) + +(define (write-main-c) + (call-with-port + (open-file-output-port main-c-path + (file-options no-fail) (buffer-mode block) (native-transcoder)) + (lambda (out) + (display "/* Auto-generated by build-jgl-freebsd-cross.ss. Do not edit. */\n" out) + (display "#include <stdio.h>\n" out) + (display "#include <stdlib.h>\n" out) + (display "#include <string.h>\n" out) + (display "#include <unistd.h>\n" out) + (display "#include <fcntl.h>\n" out) + (display "#include <sys/types.h>\n" out) + (display "#include <sys/sysctl.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 \"jgl_program.h\"\n\n" out) + + ;; FreeBSD: __errno_location alias (glibc/musl name) -> __error (FreeBSD). + (display "/* glibc/musl name for errno location -> FreeBSD __error. */\n" out) + (display "extern int *__error(void);\n" out) + (display "int *__errno_location(void) { return __error(); }\n\n" out) + + ;; extern decls for jerboa-ssl symbols + (display "/* jerboa_ssl_shim.o exports — registered with Sforeign_symbol below. */\n" out) + (for-each + (lambda (sym) (display (format "extern void ~a(void);\n" sym) out)) + jerboa-ssl-symbols) + (newline out) + + (display "int main(int argc, char *argv[]) {\n" out) + (display " /* Argv passthrough via env vars (matches the native jgl main). */\n" out) + (display " char countbuf[32];\n" out) + (display " snprintf(countbuf, sizeof(countbuf), \"%d\", argc - 1);\n" out) + (display " setenv(\"JGL_ARGC\", countbuf, 1);\n" out) + (display " for (int i = 1; i < argc; i++) {\n" out) + (display " char name[32];\n" out) + (display " snprintf(name, sizeof(name), \"JGL_ARG%d\", i - 1);\n" out) + (display " setenv(name, argv[i], 1);\n" out) + (display " }\n\n" out) + + ;; FreeBSD: no /proc/self/fd/N (without fdescfs), write to a tmpfile. + (display " /* FreeBSD has no /proc/self/fd/N (without fdescfs mounted), so write the\n" out) + (display " * embedded program to a tmpfile that we unlink after Sscheme_program loads it. */\n" out) + (display " char tmpl[] = \"/tmp/jgl-XXXXXX\";\n" out) + (display " int fd = mkstemp(tmpl);\n" out) + (display " if (fd < 0) { perror(\"mkstemp\"); return 1; }\n" out) + (display " if (write(fd, jgl_program, jgl_program_size) != (ssize_t)jgl_program_size) {\n" out) + (display " perror(\"write tmpfile\"); close(fd); unlink(tmpl); return 1;\n" out) + (display " }\n" out) + (display " fsync(fd);\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\n" out) + + (display " /* Register jerboa_ssl_shim symbols so the WPO resolves them at runtime. */\n" out) + (for-each + (lambda (sym) + (display (format " Sforeign_symbol(\"~a\", (void*)~a);\n" sym sym) out)) + jerboa-ssl-symbols) + (newline out) + + (display " Sbuild_heap(NULL, NULL);\n" out) + (display " const char *script_args[] = { argv[0] };\n" out) + (display " int status = Sscheme_program(tmpl, 1, script_args);\n\n" out) + (display " close(fd);\n" out) + (display " unlink(tmpl);\n" out) + (display " Sscheme_deinit();\n" out) + (display " return status;\n" out) + (display "}\n" out)))) +(write-main-c) + +;; ── Stage 6: compile + link with cross-cc ────────────────────────────────── +;; FreeBSD dynamic link: libssl/libcrypto from base, no -static (libc symbol +;; versioning), libutil for openpty. +(printf "==> [6/6] compile + link with ~a~n" cross-cc) + +(define link-cmd + (format + (string-append + "~a -O2 -Wl,--export-dynamic " + "-I~a " + "~a ~a " + "~a/libkernel.a ~a/libz.a ~a/liblz4.a " + "-lssl -lcrypto -lpthread -lm -lutil " + "-o ~a") + cross-cc + cross-csv-dir + main-c-path jerboa-ssl-shim-o + cross-csv-dir cross-csv-dir cross-csv-dir + output)) + +(printf " ~a~n" link-cmd) +(unless (zero? (system link-cmd)) + (error 'build-jgl-freebsd-cross "link failed")) + +(printf "~n==> done: ~a~n" output) new file mode 100644 --- /dev/null +++ b/jgl.ss @@ -0,0 +1,29 @@ +#!chezscheme +;;; jgl.ss -- Entry point for the `jgl` binary. +;;; +;;; A threaded program (the Rustls TLS stack spawns threads) cannot live in a +;;; boot file, so jerbuild's generated main loads it via memfd and forwards +;;; argv through <PREFIX>_ARGC / <PREFIX>_ARGn environment variables. We try the +;;; expected prefixes and fall back to (command-line) for interpreted mode. + +(import (chezscheme) + (jgl cli)) + +(define (env-args) + (let try ([prefixes '("JGL" "GITLAB" "JERBOA_GITLAB")]) + (cond + [(null? prefixes) + (let ([cl (command-line)]) (if (pair? cl) (cdr cl) '()))] + [(getenv (string-append (car prefixes) "_ARGC")) + => (lambda (argc-str) + (let ([argc (or (string->number argc-str) 0)] + [pfx (car prefixes)]) + (let loop ([i 0] [acc '()]) + (if (>= i argc) + (reverse acc) + (loop (+ i 1) + (cons (or (getenv (string-append pfx "_ARG" (number->string i))) "") + acc))))))] + [else (try (cdr prefixes))]))) + +(main (env-args)) new file mode 100644 --- /dev/null +++ b/lib/jgl/ci.ss @@ -0,0 +1,50 @@ +#!chezscheme +;;; (jgl ci) -- CI/CD queries: pipelines, jobs, and latest status for a ref. + +(library (jgl ci) + (export list-pipelines get-pipeline pipeline-jobs list-jobs latest-pipeline) + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (jgl client)) + + (def (proj-base project) + (string-append "projects/" (pct-encode project))) + + ;; Recent pipelines (newest first), optionally filtered by ref/status. + (def (list-pipelines c project ref status (limit 20)) + (gl-get c + (string-append (proj-base project) "/pipelines" + (build-query (list (cons "per_page" limit) + (cons "ref" ref) + (cons "status" status)))))) + + (def (get-pipeline c project id) + (gl-try-get c (string-append (proj-base project) "/pipelines/" id))) + + ;; All jobs for a pipeline (paginated). + (def (pipeline-jobs c project id) + (gl-get-all c (string-append (proj-base project) "/pipelines/" id "/jobs"))) + + ;; Recent project-wide jobs (newest first). + (def (list-jobs c project (limit 20)) + (gl-get c + (string-append (proj-base project) "/jobs" + (build-query (list (cons "per_page" limit)))))) + + ;; The most recent pipeline (optionally for a ref), or #f if none. + (def (latest-pipeline c project ref) + (let ([ps (gl-get c + (string-append (proj-base project) "/pipelines" + (build-query (list (cons "per_page" 1) + (cons "ref" ref)))))]) + (if (and (list? ps) (pair? ps)) (car ps) #f))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/lib/jgl/cli.ss @@ -0,0 +1,305 @@ +#!chezscheme +;;; (jgl cli) -- Argument parsing, command dispatch, and rendering. + +(library (jgl cli) + (export main *jgl-version*) + (import (except (chezscheme) + make-hash-table hash-table? + sort sort! + printf fprintf + path-extension path-absolute? + with-input-from-string with-output-to-string + iota 1+ 1- + partition + make-date make-time) + (except (jerboa prelude) meta atom?) + (std misc string) + (jgl client) + (jgl config) + (jgl format) + (jgl issues) + (jgl ci)) + + (def *jgl-version* "0.1.0") + + ;; --- Argument parsing --- + ;; Returns (list command positionals opts-alist). + + (def (value-flag-key name) + (cond + [(member name '("--url")) "url"] + [(member name '("--token")) "token"] + [(member name '("--project" "-p")) "project"] + [(member name '("--format" "-f")) "format"] + [(member name '("--state")) "state"] + [(member name '("--labels")) "labels"] + [(member name '("--search")) "search"] + [(member name '("--ref")) "ref"] + [(member name '("--status")) "status"] + [(member name '("--output" "-o")) "output"] + [(member name '("--pipeline")) "pipeline"] + [else #f])) + + (def (parse-args argv) + (let loop ([a argv] [pos '()] [opts '()]) + (cond + [(null? a) + (let ([positionals (reverse pos)]) + (list (if (pair? positionals) (car positionals) #f) + (if (pair? positionals) (cdr positionals) '()) + (reverse opts)))] + [(member (car a) '("--help" "-h")) + (loop (cdr a) pos (cons (cons "help" "1") opts))] + [(member (car a) '("--version")) + (loop (cdr a) pos (cons (cons "version" "1") opts))] + [(value-flag-key (car a)) + => (lambda (key) + (if (pair? (cdr a)) + (loop (cddr a) pos (cons (cons key (cadr a)) opts)) + (loop (cdr a) pos opts)))] + [(string-prefix? (car a) "-") + ;; Unknown flag: ignore (keeps parsing forgiving). + (loop (cdr a) pos opts)] + [else + (loop (cdr a) (cons (car a) pos) opts)]))) + + (def (opt opts key (default #f)) + (let ([p (assoc key opts)]) (if p (cdr p) default))) + + ;; --- Guards --- + + (def (need o field label) + (when (not (field o)) + (error 'jgl (string-append label " is required (flag or environment variable)")))) + + ;; A project is always required. A token is optional: public projects read + ;; fine without one, and private projects return a 401 we report clearly. + (def (require-conn o) + (need o opts-project "a project (--project / GITLAB_PROJECT)")) + + ;; --- Rendering --- + + (def (json-out v) (displayln (json->string v))) + + (def (render-issues issues fmt) + (if (string=? fmt "json") + (json-out issues) + (begin + (for-each + (lambda (i) + (displayln "#" (pad-right (jstr i "iid") 5) " " + (pad-right (string-append "[" (jstr i "state") "]") 10) " " + (jstr i "title") + (let ([l (labels->string (jref i "labels"))]) + (if (string=? l "") "" (string-append " {" l "}"))))) + issues) + (displayln (number->string (length issues)) " issue(s)")))) + + (def (render-issue issue notes fmt) + (if (string=? fmt "json") + (json-out issue) + (display (issue->markdown issue notes)))) + + (def (render-pipelines pipelines fmt) + (if (string=? fmt "json") + (json-out pipelines) + (if (and (list? pipelines) (pair? pipelines)) + (for-each + (lambda (p) + (displayln "#" (pad-right (jint p "id") 8) " " + (pad-right (jstr p "status") 10) " " + (pad-right (jstr p "ref") 20) " " + (truncate-str (jstr p "sha") 8) " " + (short-date (jstr p "created_at")))) + pipelines) + (displayln "No pipelines found.")))) + + (def (render-jobs jobs fmt) + (if (string=? fmt "json") + (json-out jobs) + (if (and (list? jobs) (pair? jobs)) + (for-each