Keep optional packages callable in WPO builds
ober
af08391fba011741be93f8008bb45caf50b86b20
--- a/features.def +++ b/features.def @@ -247,7 +247,7 @@ ;; ═══════════════════════════════════════════════════════════════════ (ssh (description . "SSH client/agent (,ssh ,scp ,ssh-add)") - (modules) + (modules "optional-static" "ssh-static") (boot-so) (boot-so-jsh) (ffi-shim-symbols) @@ -273,7 +273,7 @@ ;; Retain jerboa-ssh-api-loaded? — an OWN binding of (jerboa-ssh api), ;; not a re-exported one — so WPO keeps the umbrella library itself in ;; the runtime-import registry (see the alias's own comment). - (bundle-libs ((jerboa-ssh api) jerboa-ssh-api-loaded?)) + (bundle-libs ((jsh ssh-static) ssh-static-registered?)) (commands "ssh" "scp" "ssh-list" "ssh-add" "ssh-agent")) ;; ═══════════════════════════════════════════════════════════════════ @@ -291,7 +291,7 @@ ;; libs); wire that into those build scripts when enabling it there. (yubikey (description . "YubiKey unlock + OATH codes/passwords (,yk ,yubi ,unlock --yk)") - (modules) + (modules "optional-static" "yubikey-static") (boot-so) (boot-so-jsh) (ffi-shim-symbols) @@ -302,7 +302,7 @@ ;; into the static closure). ;; Each entry is (<library> <one-export>): the export is referenced in a ;; retention binding so whole-program optimization keeps the library. - (bundle-libs ((yubikey auth) yubikey-present?)) + (bundle-libs ((jsh yubikey-static) yubikey-static-registered?)) (commands "yk" "yubi")) ;; ═══════════════════════════════════════════════════════════════════ @@ -310,7 +310,7 @@ ;; ═══════════════════════════════════════════════════════════════════ (aws (description . "AWS CLI (,aws ,pssm)") - (modules "aws") + (modules "optional-static" "aws" "aws-static") (boot-so) (boot-so-jsh "aws") (ffi-shim-symbols) @@ -319,7 +319,7 @@ ;; Loaded at runtime via (environment '(jerboa-aws cli main)) etc. ;; (see src/jsh/aws.sls); force into the static closure so jerbuild ;; bundles them. Each entry is (<library> <one-export>) for retention. - (bundle-libs ((jerboa-aws cli main) main) ((jerboa-aws pssm) pssm-main)) + (bundle-libs ((jsh aws-static) aws-static-registered?)) (commands "aws" "pssm")) ;; ═══════════════════════════════════════════════════════════════════ @@ -327,7 +327,7 @@ ;; ═══════════════════════════════════════════════════════════════════ (worm (description . "Magic-wormhole text/file transfer (,worm)") - (modules "worm") + (modules "optional-static" "worm" "worm-static") (boot-so) (boot-so-jsh "worm") (ffi-shim-symbols) @@ -343,7 +343,7 @@ (requires-native-lib . #t) ;; (wormhole cli) is loaded lazily by (jsh worm). Retain it when the ;; feature is enabled so static builds have the whole wormhole closure. - (bundle-libs ((wormhole cli) wormhole-main)) + (bundle-libs ((jsh worm-static) worm-static-registered?)) (commands "worm")) ;; ═══════════════════════════════════════════════════════════════════ new file mode 100644 --- /dev/null +++ b/jerboa-src/src/jsh/aws-static.ss @@ -0,0 +1,13 @@ +;;; (jsh aws-static) -- WPO-safe direct dispatch for jerboa-aws. +;;; jerbuild-library: (jsh aws-static) + +(export aws-static-registered?) + +(import (jsh optional-static) + (prefix (jerboa-aws cli main) %aws-cli-) + (prefix (jerboa-aws pssm) %aws-pssm-)) + +(define aws-static-registered? #t) + +(optional-static-register! 'aws 'main %aws-cli-main) +(optional-static-register! 'aws 'pssm-main %aws-pssm-pssm-main) --- a/jerboa-src/src/jsh/aws.ss +++ b/jerboa-src/src/jsh/aws.ss @@ -11,7 +11,8 @@ (export aws-meta-registered?) (import (chezscheme) - (jsh registry)) + (jsh registry) + (jsh optional-static)) ;; ---- Lazy resolvers for jerboa-aws entry points ---- ;; Wrapped in guard so missing libraries do not abort module init. @@ -27,13 +28,21 @@ [*aws-load-attempted?* #f] [else (set! *aws-load-attempted?* #t) - (guard (e [#t #f]) - (set! *aws-cli-main* - (eval 'main (environment '(jerboa-aws cli main)))) - (set! *pssm-main* - (eval 'pssm-main (environment '(jerboa-aws pssm)))) - (set! *aws-loaded?* #t) - #t)])) + (let ([static-main (optional-static-ref 'aws 'main)] + [static-pssm (optional-static-ref 'aws 'pssm-main)]) + (if (and static-main static-pssm) + (begin + (set! *aws-cli-main* static-main) + (set! *pssm-main* static-pssm) + (set! *aws-loaded?* #t) + #t) + (guard (e [#t #f]) + (set! *aws-cli-main* + (eval 'main (environment '(jerboa-aws cli main)))) + (set! *pssm-main* + (eval 'pssm-main (environment '(jerboa-aws pssm)))) + (set! *aws-loaded?* #t) + #t)))])) ;; ---- Shell-style argument tokenizer ---- ;; Splits "web-* uptime" into ("web-*" "uptime"). new file mode 100644 --- /dev/null +++ b/jerboa-src/src/jsh/optional-static.ss @@ -0,0 +1,30 @@ +;;; (jsh optional-static) -- direct procedure registry for optional WPO bundles. +;;; jerbuild-library: (jsh optional-static) + +(export optional-static-register! + optional-static-ref + optional-static-available?) + +(import (rnrs)) + +(define *optional-static-procedures* (make-hashtable equal-hash equal?)) + +(define (optional-static-key feature proc-name) + (cons feature proc-name)) + +(define (optional-static-register! feature proc-name proc) + (hashtable-set! *optional-static-procedures* + (optional-static-key feature proc-name) + proc)) + +(define (optional-static-ref feature proc-name) + (hashtable-ref *optional-static-procedures* + (optional-static-key feature proc-name) + #f)) + +(define (optional-static-available? feature) + (let-values ([(keys values) (hashtable-entries *optional-static-procedures*)]) + (let loop ([i 0]) + (and (< i (vector-length keys)) + (or (eq? feature (car (vector-ref keys i))) + (loop (+ i 1))))))) new file mode 100644 --- /dev/null +++ b/jerboa-src/src/jsh/ssh-static.ss @@ -0,0 +1,44 @@ +;;; (jsh ssh-static) -- WPO-safe direct dispatch for jerboa-ssh. +;;; jerbuild-library: (jsh ssh-static) + +(export ssh-static-registered?) + +(import (jsh optional-static) + (prefix (jerboa-ssh api) %ssh-api-) + (prefix (jerboa-ssh client) %ssh-client-) + (prefix (jerboa-ssh channel) %ssh-channel-) + (prefix (jerboa-ssh session) %ssh-session-) + (prefix (jerboa-ssh transport) %ssh-transport-)) + +(define (register! name proc) + (optional-static-register! 'ssh name proc)) + +(define ssh-static-registered? #t) + +(register! 'ssh-agent-forward-key %ssh-api-ssh-agent-forward-key) +(register! 'ssh-agent-key-count %ssh-api-ssh-agent-key-count) +(register! 'ssh-agent-key-info %ssh-api-ssh-agent-key-info) +(register! 'ssh-agent-list-keys %ssh-api-ssh-agent-list-keys) +(register! 'ssh-agent-load-key-data %ssh-api-ssh-agent-load-key-data) +(register! 'ssh-agent-load-key-file %ssh-api-ssh-agent-load-key-file) +(register! 'ssh-agent-load-openssh-key %ssh-api-ssh-agent-load-openssh-key) +(register! 'ssh-agent-running? %ssh-api-ssh-agent-running?) +(register! 'ssh-agent-socket-path %ssh-api-ssh-agent-socket-path) +(register! 'ssh-agent-start %ssh-api-ssh-agent-start) +(register! 'ssh-agent-stop %ssh-api-ssh-agent-stop) +(register! 'ssh-connect %ssh-api-ssh-connect) +(register! 'ssh-disconnect %ssh-api-ssh-disconnect) +(register! 'ssh-run %ssh-api-ssh-run) +(register! 'ssh-scp-get %ssh-api-ssh-scp-get) +(register! 'ssh-scp-put %ssh-api-ssh-scp-put) +(register! 'ssh-connection-channel-table + %ssh-client-ssh-connection-channel-table) +(register! 'ssh-connection-transport %ssh-client-ssh-connection-transport) +(register! 'ssh-channel-closed? %ssh-channel-ssh-channel-closed?) +(register! 'ssh-channel-dispatch %ssh-channel-ssh-channel-dispatch) +(register! 'ssh-channel-eof? %ssh-channel-ssh-channel-eof?) +(register! 'ssh-channel-exit-status %ssh-channel-ssh-channel-exit-status) +(register! 'ssh-channel-open-session %ssh-channel-ssh-channel-open-session) +(register! 'ssh-channel-send-data %ssh-channel-ssh-channel-send-data) +(register! 'ssh-session-request-pty %ssh-session-ssh-session-request-pty) +(register! 'transport-state-fd %ssh-transport-transport-state-fd) new file mode 100644 --- /dev/null +++ b/jerboa-src/src/jsh/worm-static.ss @@ -0,0 +1,11 @@ +;;; (jsh worm-static) -- WPO-safe direct dispatch for jerboa-wormhole. +;;; jerbuild-library: (jsh worm-static) + +(export worm-static-registered?) + +(import (jsh optional-static) + (prefix (wormhole cli) %worm-)) + +(define worm-static-registered? #t) + +(optional-static-register! 'worm 'wormhole-main %worm-wormhole-main) --- a/jerboa-src/src/jsh/worm.ss +++ b/jerboa-src/src/jsh/worm.ss @@ -9,7 +9,8 @@ worm-send-needs-auto-transit?) (import (chezscheme) - (jsh registry)) + (jsh registry) + (jsh optional-static)) (define *worm-feature-enabled?* (make-parameter #f)) (define *wormhole-main* #f) @@ -32,11 +33,17 @@ [*worm-load-attempted?* #f] [else (set! *worm-load-attempted?* #t) - (guard (e [(condition? e) #f]) - (set! *wormhole-main* - (eval 'wormhole-main (environment '(wormhole cli)))) - (set! *worm-loaded?* #t) - #t)])) + (let ([static-main (optional-static-ref 'worm 'wormhole-main)]) + (if static-main + (begin + (set! *wormhole-main* static-main) + (set! *worm-loaded?* #t) + #t) + (guard (e [(condition? e) #f]) + (set! *wormhole-main* + (eval 'wormhole-main (environment '(wormhole cli)))) + (set! *worm-loaded?* #t) + #t)))])) (define (worm-transit-load!) (cond new file mode 100644 --- /dev/null +++ b/jerboa-src/src/jsh/yubikey-static.ss @@ -0,0 +1,25 @@ +;;; (jsh yubikey-static) -- WPO-safe direct dispatch for jerboa-yubikey. +;;; jerbuild-library: (jsh yubikey-static) + +(export yubikey-static-registered?) + +(import (jsh optional-static) + (prefix (yubikey auth) %yk-auth-) + (prefix (yubikey oath) %yk-oath-)) + +(define (register! name proc) + (optional-static-register! 'yubikey name proc)) + +(define yubikey-static-registered? #t) + +(register! 'yubikey-piv-derive-password + %yk-auth-yubikey-piv-derive-password) +(register! 'yubikey-present? %yk-auth-yubikey-present?) +(register! 'oath-calculate %yk-oath-oath-calculate) +(register! 'oath-calculate-all %yk-oath-oath-calculate-all) +(register! 'oath-credential-name %yk-oath-oath-credential-name) +(register! 'oath-info-challenge %yk-oath-oath-info-challenge) +(register! 'oath-list %yk-oath-oath-list) +(register! 'oath-select %yk-oath-oath-select) +(register! 'oath-set-code %yk-oath-oath-set-code) +(register! 'oath-validate %yk-oath-oath-validate) --- a/jsh.ss +++ b/jsh.ss @@ -1,7 +1,7 @@ #!chezscheme ;; Entry point for jerboa-shell (import (chezscheme) (jsh main) (except (jsh builtins) list-head) - (jsh registry) (jsh script) (jsh sandbox) (jsh rl) + (jsh registry) (jsh optional-static) (jsh script) (jsh sandbox) (jsh rl) (jsh limits) (jsh coreutils) ;; Optional packages — imported for their meta-register! init side-effects. @@ -801,15 +801,18 @@ (define (ssh-available?) (unless *ssh-agent-available* (set! *ssh-agent-available* - (guard (e (#t 'unavailable)) - ;; (jerboa-ssh api) is the multi-element re-export of (jerboa-ssh). - (eval '(import (jerboa-ssh api)) (interaction-environment)) - 'ready))) + (if (optional-static-available? 'ssh) + 'ready + (guard (e (#t 'unavailable)) + ;; Interpreted/development fallback when no static adapter exists. + (eval '(import (jerboa-ssh api)) (interaction-environment)) + 'ready)))) (eq? *ssh-agent-available* 'ready)) (define (ssh-call proc-name . args) (and (ssh-available?) - (let ((proc (eval proc-name (interaction-environment)))) + (let ((proc (or (optional-static-ref 'ssh proc-name) + (eval proc-name (interaction-environment))))) (apply proc args)))) ;; ---- YubiKey integration ---- @@ -822,17 +825,20 @@ (define (yubikey-available?) (unless *yubikey-available* (set! *yubikey-available* - (guard (e (#t 'unavailable)) - (eval '(import (yubikey auth) - (yubikey oath) - (yubikey transport connection)) - (interaction-environment)) - 'ready))) + (if (optional-static-available? 'yubikey) + 'ready + (guard (e (#t 'unavailable)) + (eval '(import (yubikey auth) + (yubikey oath) + (yubikey transport connection)) + (interaction-environment)) + 'ready)))) (eq? *yubikey-available* 'ready)) (define (yubikey-call proc-name . args) (and (yubikey-available?) - (let ((proc (eval proc-name (interaction-environment)))) + (let ((proc (or (optional-static-ref 'yubikey proc-name) + (eval proc-name (interaction-environment))))) (apply proc args)))) (define (yk-command-usage cmd-name status) --- a/test/test-features-commands.sh +++ b/test/test-features-commands.sh @@ -4,8 +4,8 @@ # Given a built jsh binary, walks every feature in features.def, # checks whether the build embedded that feature, and for each # (commands ...) entry asserts: -# - every feature is enabled -# - ,<cmd> --help exits 0 +# - feature enabled → ,<cmd> --help exits 0 +# - feature disabled → ,<cmd> exits non-zero with "not available" # # Usage: bash test/test-features-commands.sh ./jsh-macos @@ -52,7 +52,7 @@ parse_features_def() { echo "=== Feature → Command Contract Test ===" echo "Binary: $JSH" echo "Enabled features:" -"$JSH" -c ',features' 2>/dev/null | grep '^ [a-z]' +"$JSH" -c ',features' 2>/dev/null | grep '^ [a-z]' || echo " (none)" echo "" HELP_OUTPUT=$("$JSH" -c ',help' 2>/dev/null || true) @@ -67,24 +67,37 @@ parse_features_def > "$TMPFILE" while read -r feature_name cmds; do for cmd in $cmds; do - if ! feature_enabled "$feature_name"; then - echo "FAIL: feature=$feature_name is missing; all features are mandatory" - FAILURES=$((FAILURES + 1)) - continue - fi - if timeout 10 "$JSH" -c ",${cmd} --help" >/dev/null 2>&1; then - echo "PASS: ,$cmd (feature=$feature_name enabled)" - PASSES=$((PASSES + 1)) - else - echo "FAIL: ,$cmd should work (feature=$feature_name enabled) but returned non-zero" - FAILURES=$((FAILURES + 1)) - fi - if help_has_cmd "$cmd"; then - echo "PASS: ,help lists ,$cmd (feature=$feature_name enabled)" - PASSES=$((PASSES + 1)) + if feature_enabled "$feature_name"; then + if timeout 10 "$JSH" -c ",${cmd} --help" >/dev/null 2>&1; then + echo "PASS: ,$cmd (feature=$feature_name enabled)" + PASSES=$((PASSES + 1)) + else + echo "FAIL: ,$cmd should work (feature=$feature_name enabled) but returned non-zero" + FAILURES=$((FAILURES + 1)) + fi + if help_has_cmd "$cmd"; then + echo "PASS: ,help lists ,$cmd (feature=$feature_name enabled)" + PASSES=$((PASSES + 1)) + else + echo "FAIL: ,help should list ,$cmd (feature=$feature_name enabled)" + FAILURES=$((FAILURES + 1)) + fi else - echo "FAIL: ,help should list ,$cmd (feature=$feature_name enabled)" - FAILURES=$((FAILURES + 1)) + if output=$("$JSH" -c ",${cmd}" 2>&1); then rc=0; else rc=$?; fi + if [ "$rc" -ne 0 ] && echo "$output" | grep -qi "not available"; then + echo "PASS: ,$cmd (feature=$feature_name disabled)" + PASSES=$((PASSES + 1)) + else + echo "FAIL: ,$cmd should report 'not available' (feature=$feature_name disabled) — exit=$rc output='$output'" + FAILURES=$((FAILURES + 1)) + fi + if help_has_cmd "$cmd"; then + echo "FAIL: ,help should not list ,$cmd (feature=$feature_name disabled)" + FAILURES=$((FAILURES + 1)) + else + echo "PASS: ,help hides ,$cmd (feature=$feature_name disabled)" + PASSES=$((PASSES + 1)) + fi fi done done < "$TMPFILE" @@ -108,8 +121,16 @@ if feature_enabled "aws"; then FAILURES=$((FAILURES + 1)) fi else - echo "FAIL: aws feature is missing; all features are mandatory" - FAILURES=$((FAILURES + 1)) + for cmd in aws pssm; do + if output=$("$JSH" -c ",${cmd}" 2>&1); then rc=0; else rc=$?; fi + if [ "$rc" -ne 0 ] && echo "$output" | grep -qi "not available"; then + echo "PASS: ,$cmd reports 'not available' (aws disabled)" + PASSES=$((PASSES + 1)) + else + echo "FAIL: ,$cmd should report 'not available' (aws disabled) — exit=$rc output='$output'" + FAILURES=$((FAILURES + 1)) + fi + done fi echo ""