jpkg phase 0: multicall dispatch, command surface, help text
ober
b9be9d0f52617d2caf3e5e2b55b06d635ffa575a
--- a/Makefile +++ b/Makefile @@ -360,7 +360,8 @@ install: @ln -sf jerboa "$(BINDIR)/jmcp" @ln -sf jerboa "$(BINDIR)/jlsp" @ln -sf jerboa "$(BINDIR)/jerbuild" - @echo "Installed: $(BINDIR)/{jerboa,jmcp,jlsp,jerbuild}" + @ln -sf jerboa "$(BINDIR)/jpkg" + @echo "Installed: $(BINDIR)/{jerboa,jmcp,jlsp,jerbuild,jpkg}" @case ":$$PATH:" in *":$(BINDIR):"*) ;; *) echo "NOTE: $(BINDIR) is not on PATH — add it to use these commands" >&2 ;; esac # ── Cross-compiled multicall binary ────────────────────────────────────────── @@ -793,7 +794,16 @@ jlsp-freebsd-amd64: chez build lsp-gen # Host + the two cross targets. jlsp-portable: jlsp jlsp-linux-amd64 jlsp-freebsd-amd64 -test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-regex-all test-contract test-ergo test-limits-primitives test-typed-parser test-typed-checker test-pure-audit test-nrepl-auth +test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-regex-all test-contract test-ergo test-limits-primitives test-typed-parser test-typed-checker test-pure-audit test-nrepl-auth test-jpkg + +# jpkg package manager: run every tests/test-jpkg*.ss +.PHONY: test-jpkg +test-jpkg: + @for t in tests/test-jpkg*.ss; do \ + [ -f "$$t" ] || continue; \ + echo "== $$t"; \ + $(SCHEME) --libdirs $(LIBDIRS) --script "$$t" || exit 1; \ + done test-nrepl-auth: @if [ -f tests/test-nrepl-auth.ss ]; then \ --- a/bin/jerboa +++ b/bin/jerboa @@ -46,6 +46,7 @@ Commands: uninstall <name> Uninstall a package by name update [name] Update one or all installed packages list List installed packages + pkg <cmd> [args] jpkg package manager (see: jerboa pkg --help) version Print version info help Print this help message @@ -377,6 +378,10 @@ case "${1:-}" in list) cmd_list ;; + pkg|jpkg) + shift + exec "$SCHEME" --libdirs "$LIBDIRS" --script "$JERBOA_HOME/tools/jpkg-main.ss" "$@" + ;; version|--version|-v) cmd_version ;; --- a/docs/jpkg-plan.md +++ b/docs/jpkg-plan.md @@ -529,6 +529,28 @@ Recommended defaults for the first implementation: - What is the minimum supported sandbox behavior on platforms without a strong kernel sandbox? +## Implementation Status + +Tracked per phase as implementation lands. Tests live in `tests/test-jpkg*.ss` +(`make test-jpkg`); implementation modules live under `lib/std/pkg/`. + +- Phase 0 (CLI dispatch): DONE. `jpkg` multicall mode in the `jerboa` binary + (basename dispatch + `jerboa pkg`/`jerboa jpkg` spellings), `jpkg` symlink + installed by `make install` and emitted by the multicall build, full command + surface with stable help text in `lib/std/pkg/cli.ss`, dev wrapper + `bin/jerboa pkg ...` via `tools/jpkg-main.ss`. + Decision: the manifest syntax is `jpkg.sexp` exactly as specified in + "Project Files" above — a non-executable Jerboa-readable data file with + strict unknown/duplicate-field rejection and canonical JSON as the signing + representation. +- Phase 1 (local package primitives): not started. +- Phase 2 (lockfile and resolver): not started. +- Phase 3 (static registry with TUF): not started. +- Phase 4 (signing and provenance): not started. +- Phase 5 (sandbox builds): not started. +- Phase 6 (audit, advisories, search): not started. +- Phase 7 (federation and hardening): not started. + ## References - The Update Framework: https://theupdateframework.io/ new file mode 100644 --- /dev/null +++ b/lib/std/pkg/cli.ss @@ -0,0 +1,180 @@ +#!chezscheme +;;; (std pkg cli) — jpkg, the Jerboa package manager: command surface. +;;; +;;; jpkg is installed as a symlink/hardlink to the multicall `jerboa` binary +;;; and selected by basename(argv[0]); `jerboa pkg ...` is the equivalent +;;; spelling. See docs/jpkg-plan.md for the design authority. +;;; +;;; This module owns the command table, help text, and dispatch. Command +;;; implementations land phase by phase in sibling (std pkg ...) modules; +;;; unimplemented commands return exit code 3 with a clear message. +;;; +;;; Exit codes: +;;; 0 success +;;; 1 command failed +;;; 2 usage error (unknown command, bad arguments) +;;; 3 command not implemented yet + +(library (std pkg cli) + (export jpkg-main + jpkg-version + jpkg-command-names + jpkg-help-text) + + (import (chezscheme) + (only (jerboa core) def try catch)) + + (def jpkg-version "0.1.0") + + ;; ── command table ────────────────────────────────────────────────────── + ;; Each entry: (name synopsis one-line-description handler) + ;; handler: (lambda (args) exit-code) + + (def (stub phase) + (lambda (args) + (let ([p (current-error-port)]) + (put-string p (string-append + "jpkg: this command is not implemented yet (planned: " + phase ")\n")) + (flush-output-port p)) + 3)) + + (def *commands* + (list + (list "init" "jpkg init" + "create jpkg.sexp for the current project" (stub "phase 1")) + (list "new" "jpkg new NAME" + "create a new package template" (stub "phase 1")) + (list "add" "jpkg add PKG[@VERSION]" + "add dependency and update lockfile" (stub "phase 2")) + (list "remove" "jpkg remove PKG" + "remove dependency and update lockfile" (stub "phase 2")) + (list "install" "jpkg install" + "install exactly what jpkg.lock describes" (stub "phase 2")) + (list "update" "jpkg update [PKG ...]" + "resolve newer allowed versions" (stub "phase 2")) + (list "uninstall" "jpkg uninstall PKG" + "remove from the project environment" (stub "phase 2")) + (list "link" "jpkg link PKG PATH" + "link a local development checkout" (stub "phase 2")) + (list "unlink" "jpkg unlink PKG" + "remove local development link" (stub "phase 2")) + (list "build" "jpkg build [PKG ...]" + "build under policy-controlled sandbox" (stub "phase 5")) + (list "clean" "jpkg clean [PKG ...]" + "remove build outputs" (stub "phase 5")) + (list "pack" "jpkg pack" + "create deterministic local .jpkg artifact" (stub "phase 1")) + (list "verify" "jpkg verify" + "verify manifest, lock, artifacts, signatures" (stub "phase 1")) + (list "audit" "jpkg audit" + "check advisories, yanks, policy drift" (stub "phase 6")) + (list "publish" "jpkg publish" + "sign, attest, and publish an artifact" (stub "phase 4")) + (list "search" "jpkg search QUERY ..." + "search configured package directories" (stub "phase 6")) + (list "dir" "jpkg dir add|remove|list" + "manage registry/package-directory list" (stub "phase 6")) + (list "list" "jpkg list" + "list installed packages" (stub "phase 2")) + (list "env" "jpkg env -- COMMAND ..." + "run command with package environment" (stub "phase 2")) + (list "policy" "jpkg policy" + "inspect or explain active policy" (stub "phase 5")))) + + (def (commands) *commands*) + + (def (find-command name) + (assoc name (commands))) + + (def (jpkg-command-names) + (map car (commands))) + + ;; ── help ─────────────────────────────────────────────────────────────── + + (def (pad s width) + (let ([n (string-length s)]) + (if (>= n width) (string-append s " ") + (string-append s (make-string (- width n) #\space))))) + + (def (jpkg-help-text) + (apply string-append + "jpkg — the Jerboa package manager (secure-by-default)\n" + "\n" + "Usage: jpkg COMMAND [ARGS ...]\n" + " jerboa pkg COMMAND [ARGS ...]\n" + "\n" + "Commands:\n" + (append + (map (lambda (entry) + (string-append " " (pad (cadr entry) 34) + (caddr entry) "\n")) + (commands)) + (list + "\n" + "Global options:\n" + " --help, -h show this help\n" + " --version, -v show version\n" + "\n" + "Run `jpkg help COMMAND` for command-specific help.\n" + "See docs/jpkg-plan.md for the full design.\n")))) + + (def (print-help port) + (put-string port (jpkg-help-text)) + (flush-output-port port)) + + (def (print-command-help entry port) + (put-string port (string-append "Usage: " (cadr entry) "\n\n" + " " (caddr entry) "\n")) + (flush-output-port port)) + + (def (print-version) + (let ([p (current-output-port)]) + (put-string p (string-append "jpkg " jpkg-version + " (jerboa package manager)\n")) + (flush-output-port p))) + + (def (usage-error msg) + (let ([p (current-error-port)]) + (put-string p (string-append "jpkg: " msg "\n")) + (put-string p "Run `jpkg --help` for usage.\n") + (flush-output-port p)) + 2) + + ;; ── entry point ──────────────────────────────────────────────────────── + ;; args: list of strings (no argv[0]). Returns exit code. + + (def (jpkg-main args) + (cond + [(null? args) + (print-help (current-output-port)) + 2] + [(or (string=? (car args) "--help") (string=? (car args) "-h")) + (print-help (current-output-port)) + 0] + [(or (string=? (car args) "--version") (string=? (car args) "-v")) + (print-version) + 0] + [(string=? (car args) "help") + (cond + [(null? (cdr args)) (print-help (current-output-port)) 0] + [(find-command (cadr args)) + => (lambda (entry) + (print-command-help entry (current-output-port)) + 0)] + [else (usage-error (string-append "unknown command: " (cadr args)))])] + [(find-command (car args)) + => (lambda (entry) + (let ([handler (cadddr entry)]) + (try + (handler (cdr args)) + (catch (e) + (let ([p (current-error-port)]) + (put-string p "jpkg: error: ") + (display-condition e p) + (put-string p "\n") + (flush-output-port p)) + 1))))] + [else (usage-error (string-append "unknown command: " (car args)))])) + + ) ;; end library --- a/support/build-jerboa-multicall.ss +++ b/support/build-jerboa-multicall.ss @@ -6,6 +6,7 @@ ;;; jmcp MCP server (mcp/server.ss) ;;; jlsp LSP server (lsp/main-binary.ss) ;;; jerbuild transpiler/builder (jerbuild.ss) + bundled stdlib +;;; jpkg package manager (lib/std/pkg/cli.ss; also `jerboa pkg`) ;;; ;;; Additive: the three entry sources are NOT edited. We read their top-level ;;; forms and rewrap each as a (jerboa entry mcp|lsp|jerbuild) library exporting @@ -13,7 +14,7 @@ ;;; WPO-compile one shared image and link support/multicall-main.c around it. ;;; ;;; Usage: scheme --script support/build-jerboa-multicall.ss -;;; Output: dist/jerboa + relative symlinks dist/{jmcp,jlsp,jerbuild} +;;; Output: dist/jerboa + relative symlinks dist/{jmcp,jlsp,jerbuild,jpkg} (import (chezscheme)) @@ -205,7 +206,8 @@ (jerboa prelude) (jerboa entry mcp) (jerboa entry lsp) - (jerboa entry jerbuild)) + (jerboa entry jerbuild) + (only (std pkg cli) jpkg-main)) out) (newline out) (write '(let ([mode (or (getenv "JERBOA_MULTICALL_NAME") "jerboa")] @@ -214,6 +216,7 @@ [(string=? mode "jmcp") (mcp-main)] [(string=? mode "jlsp") (lsp-main args)] [(string=? mode "jerbuild") (jerbuild-main args)] + [(string=? mode "jpkg") (exit (jpkg-main args))] [(null? args) (displayln "Jerboa Scheme — type (exit) to quit") (let loop () @@ -228,7 +231,7 @@ (unless (eq? result (void)) (write result) (newline)))) (loop)])))] [(or (string=? (car args) "--version") (string=? (car args) "-v")) - (displayln "jerboa 0.1.0 (multicall: jerboa/jmcp/jlsp/jerbuild)") + (displayln "jerboa 0.1.0 (multicall: jerboa/jmcp/jlsp/jerbuild/jpkg)") (displayln (string-append "Bundled " (scheme-version) " (Apache 2.0, (c) Cisco Systems, Inc.)")) (displayln "See LICENSE-CHEZ for Chez Scheme's NOTICE and license.")] @@ -240,8 +243,9 @@ " jmcp|mcp ... run the MCP server" " jlsp|lsp ... run the LSP server" " jerbuild ... transpile/build a Jerboa project" + " jpkg|pkg ... run the package manager" "" - "Symlink to jmcp/jlsp/jerbuild to pick a mode by name."))] + "Symlink to jmcp/jlsp/jerbuild/jpkg to pick a mode by name."))] [else (load (car args))])) out) (newline out)) @@ -419,8 +423,8 @@ (printf "==> [6/6] symlinks~n") (for-each (lambda (nm) (run (format "ln -sf jerboa ~a/~a" (shell-quote out-dir) nm))) - '("jmcp" "jlsp" "jerbuild")) + '("jmcp" "jlsp" "jerbuild" "jpkg")) (printf "~n=== done ===~n") -(run (format "ls -lh ~a ~a/jmcp ~a/jlsp ~a/jerbuild" (shell-quote output) out-dir out-dir out-dir)) +(run (format "ls -lh ~a ~a/jmcp ~a/jlsp ~a/jerbuild ~a/jpkg" (shell-quote output) out-dir out-dir out-dir out-dir)) (run (format "file ~a" (shell-quote output))) --- a/support/build.ss +++ b/support/build.ss @@ -31,7 +31,9 @@ ;; re-exports, so putting it on the build list produces .so + .wpo ;; for the entire transitively-referenced tree. User scripts that ;; (import (jerboa prelude)) skip a large one-time compile at startup. - (jerboa prelude))) + (jerboa prelude) + ;; jpkg package manager (multicall mode; not in the prelude) + (std pkg cli))) (define compiled 0) (define skipped 0) --- a/support/multicall-main.c +++ b/support/multicall-main.c @@ -198,10 +198,12 @@ int main(int argc, const char *argv[]) { if (!strcmp(s, "jmcp") || !strcmp(s, "mcp")) { mode = "jmcp"; shift = 1; } else if (!strcmp(s, "jlsp") || !strcmp(s, "lsp")) { mode = "jlsp"; shift = 1; } else if (!strcmp(s, "jerbuild")) { mode = "jerbuild"; shift = 1; } + else if (!strcmp(s, "jpkg") || !strcmp(s, "pkg")) { mode = "jpkg"; shift = 1; } } /* Normalize aliased symlink names. */ if (!strcmp(mode, "mcp")) mode = "jmcp"; if (!strcmp(mode, "lsp")) mode = "jlsp"; + if (!strcmp(mode, "pkg")) mode = "jpkg"; /* Bare-Chez mode: `jerboa scheme [script [args...]]` boots petite+scheme * WITHOUT the embedded program image, behaving as a stock `scheme`. Used by new file mode 100644 --- /dev/null +++ b/tests/test-jpkg-cli.ss @@ -0,0 +1,105 @@ +#!chezscheme +;;; tests/test-jpkg-cli.ss — Phase 0: jpkg command surface + dispatch. + +(import (chezscheme) (std pkg cli)) + +(define pass 0) +(define fail 0) + +(define-syntax check + (syntax-rules () + [(_ name expr) + (let ([got (guard (e [#t (list 'EXN (condition-message e))]) expr)]) + (if (and got (not (and (pair? got) (eq? (car got) 'EXN)))) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s~%" name got))))])) + +(define (call-capturing args) + ;; Run jpkg-main with stdout+stderr captured; return (code out err). + (let-values ([(out-port out-get) (open-string-output-port)] + [(err-port err-get) (open-string-output-port)]) + (let ([code (parameterize ([current-output-port out-port] + [current-error-port err-port]) + (jpkg-main args))]) + (list code (out-get) (err-get))))) + +(define (s-contains? s sub) + (let ([sl (string-length s)] [xl (string-length sub)]) + (let loop ([i 0]) + (cond [(> (+ i xl) sl) #f] + [(string=? (substring s i (+ i xl)) sub) #t] + [else (loop (+ i 1))])))) + +(printf "--- jpkg cli tests ---~%") + +;; --help exits 0 and lists every command +(let* ([r (call-capturing '("--help"))] + [code (car r)] [out (cadr r)]) + (check "help-exit-0" (= code 0)) + (check "help-usage-line" (s-contains? out "Usage: jpkg COMMAND")) + (check "help-jerboa-pkg-alias" (s-contains? out "jerboa pkg COMMAND")) + (for-each + (lambda (cmd) + (check (string-append "help-lists-" cmd) + (s-contains? out (string-append "jpkg " cmd)))) + (jpkg-command-names))) + +;; full expected command surface from docs/jpkg-plan.md +(check "command-surface-complete" + (equal? (jpkg-command-names) + '("init" "new" "add" "remove" "install" "update" "uninstall" + "link" "unlink" "build" "clean" "pack" "verify" "audit" + "publish" "search" "dir" "list" "env" "policy"))) + +;; -h same as --help +(let ([r (call-capturing '("-h"))]) + (check "dash-h-exit-0" (= (car r) 0))) + +;; help == --help +(let ([r (call-capturing '("help"))]) + (check "help-cmd-exit-0" (= (car r) 0))) + +;; help COMMAND shows synopsis +(let* ([r (call-capturing '("help" "pack"))] + [out (cadr r)]) + (check "help-pack-exit-0" (= (car r) 0)) + (check "help-pack-synopsis" (s-contains? out "Usage: jpkg pack"))) + +;; help UNKNOWN is a usage error +(let ([r (call-capturing '("help" "frobnicate"))]) + (check "help-unknown-exit-2" (= (car r) 2)) + (check "help-unknown-message" (s-contains? (caddr r) "unknown command"))) + +;; --version exits 0 and mentions jpkg +(let* ([r (call-capturing '("--version"))]) + (check "version-exit-0" (= (car r) 0)) + (check "version-text" (s-contains? (cadr r) "jpkg"))) + +;; no args: help + usage error +(let ([r (call-capturing '())]) + (check "noargs-exit-2" (= (car r) 2)) + (check "noargs-prints-help" (s-contains? (cadr r) "Usage: jpkg COMMAND"))) + +;; unknown command: exit 2 with message +(let ([r (call-capturing '("frobnicate"))]) + (check "unknown-exit-2" (= (car r) 2)) + (check "unknown-message" (s-contains? (caddr r) "unknown command: frobnicate"))) + +;; commands not yet implemented return 3 and say so on stderr. +;; Shrink this list as phases land. +(define *expected-stubs* + '("init" "new" "add" "remove" "install" "update" "uninstall" + "link" "unlink" "build" "clean" "pack" "verify" "audit" + "publish" "search" "dir" "list" "env" "policy")) + +(for-each + (lambda (cmd) + (let ([r (call-capturing (list cmd))]) + (check (string-append "stub-" cmd "-exit-3") (= (car r) 3)) + (check (string-append "stub-" cmd "-message") + (s-contains? (caddr r) "not implemented yet")))) + *expected-stubs*) + +(printf "~%--- jpkg cli: ~a passed, ~a failed ---~%" pass fail) +(when (> fail 0) (exit 1)) new file mode 100644 --- /dev/null +++ b/tools/jpkg-main.ss @@ -0,0 +1,10 @@ +#!chezscheme +;;; tools/jpkg-main.ss — dev entry for jpkg (used by `bin/jerboa pkg ...`). +;;; The shipped path is the multicall binary (dist/jerboa) with a jpkg +;;; symlink; this script exists so the bash dev wrapper can run the same +;;; CLI against the in-repo stdlib without a binary build. +;;; Usage: scheme --libdirs lib --script tools/jpkg-main.ss [ARGS ...] + +(import (chezscheme) (only (std pkg cli) jpkg-main)) + +(exit (jpkg-main (cdr (command-line))))