Accept JERBOA_MCP_NO_SERVE guard in multicall build; add JERBOA_PKG_PATH support
ober
b91c5e1ec091317d376df9000606894aaf3b11ba
--- a/support/build-jerboa-multicall.ss +++ b/support/build-jerboa-multicall.ss @@ -287,8 +287,14 @@ (let-values ([(imps rest) (split-imports (read-source-forms (format "~a/mcp/server.ss" repo)))]) (let ([trailing (last-form rest)] [entries (embedded-data-entries repo)]) - (unless (equal? trailing '(serve)) - (error 'build-multicall "mcp/server.ss must end in (serve)" trailing)) + ;; The live mcp/server.ss ends in either `(serve)` or + ;; `(unless (getenv "JERBOA_MCP_NO_SERVE") (serve))` (the latter lets the + ;; security tests load definitions without entering the serve loop). + ;; Either is acceptable: the embedded multicall form defines `mcp-main` + ;; explicitly, so the trailing guard is dropped during packaging. + (unless (or (equal? trailing '(serve)) + (equal? trailing '(unless (getenv "JERBOA_MCP_NO_SERVE") (serve)))) + (error 'build-multicall "mcp/server.ss must end in (serve) or the JERBOA_MCP_NO_SERVE guard" trailing)) (lib-form 'mcp 'mcp-main (mcp-import-sets imps) (map (lambda (f) (if (embedded-data-placeholder? f) `(def *embedded-data* ',entries) f)) @@ -314,6 +320,36 @@ (newline out) (write `(import ,(entry-library-name 'jerbuild)) out) (newline out) + (write `(begin + ;; Honor JERBOA_PKG_PATH so that `jpkg add`-installed libraries + ;; are visible to load/eval without forcing the user to wrap + ;; every invocation in `jpkg env --`. The path is colon- + ;; separated, same convention Chez uses for library-directories. + ;; We import only (scheme) at this point, so use raw Chez primitives. + (let ([pkg-path (getenv "JERBOA_PKG_PATH")]) + (when (and pkg-path (> (string-length pkg-path) 0)) + (let ([char-index + (lambda (s ch) + (let ([n (string-length s)]) + (let loop ([i 0]) + (cond + [(= i n) #f] + [(char=? (string-ref s i) ch) i] + [else (loop (+ i 1))]))))]) + (let split ([rest pkg-path] [acc '()]) + (let ([idx (char-index rest #\:)]) + (if idx + (split (substring rest (+ idx 1) (string-length rest)) + (let ([seg (substring rest 0 idx)]) + (if (> (string-length seg) 0) (cons seg acc) acc))) + (let* ([final (if (> (string-length rest) 0) (cons rest acc) acc)] + [segs (reverse final)]) + (unless (null? segs) + (library-directories + (append (library-directories) + (map (lambda (d) (cons d d)) segs)))))))))))) + out) + (newline out) (write `(let ([mode (or (getenv "JERBOA_MULTICALL_NAME") "jerboa")] [args (command-line-arguments)]) (cond