jpkg phase 4: signing and provenance
ober
aaf5b89147f53632061391dec85748ed236994a8
--- a/docs/jpkg-plan.md +++ b/docs/jpkg-plan.md @@ -579,7 +579,21 @@ Tracked per phase as implementation lands. Tests live in `tests/test-jpkg*.ss` payloads are canonical JSON; keyids are sha256 of canonical key objects. 35 new tests incl. tamper, threshold, unauthorized-key, rollback, freeze, and hostile root-rotation cases. -- Phase 4 (signing and provenance): not started. +- Phase 4 (signing and provenance): DONE. DSSE envelopes with PAE + + Ed25519 (`dsse.ss`); detached package signatures over the canonical + signed subject (name/version/artifact-sha256/size/manifest-sha256), + SLSA/in-toto provenance statements with builder-id policy, and a + publisher-trust model (`publishers.json`, a TUF target) keyed by + sha256(pubkey) (`provenance.ss`); `jpkg publish` signs + attests + + adds the blob/release/signature/provenance and re-signs TUF so the new + files become covered targets, bootstrapping a staging registry on + first use (`publish.ss`); registry-side authorship verification wired + into install with fail-closed policy via JPKG_REQUIRE_SIGNATURES / + JPKG_REQUIRE_PROVENANCE. Sigstore is supported in keyed mode (verify a + bundle's DSSE against a configured key); keyless Fulcio/Rekor chain + verification is deferred (needs X.509 + transparency-log/network). + 36 new tests incl. tampered-signature, wrong-subject, disallowed + builder, unauthorized key, and end-to-end publish→install under policy. - Phase 5 (sandbox builds): not started. - Phase 6 (audit, advisories, search): not started. - Phase 7 (federation and hardening): not started. --- a/lib/std/pkg/cli.ss +++ b/lib/std/pkg/cli.ss @@ -27,7 +27,7 @@ (only (std pkg commands) cmd-init cmd-new cmd-pack cmd-verify cmd-add cmd-remove cmd-install cmd-update cmd-uninstall - cmd-link cmd-unlink cmd-list cmd-env)) + cmd-link cmd-unlink cmd-list cmd-env cmd-publish)) (def jpkg-version "0.1.0") @@ -74,8 +74,8 @@ "verify manifest, lock, artifacts, signatures" cmd-verify) (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 "publish" "jpkg publish --registry DIR --key FILE" + "sign, attest, and publish an artifact" cmd-publish) (list "search" "jpkg search QUERY ..." "search configured package directories" (stub "phase 6")) (list "dir" "jpkg dir add|remove|list" --- a/lib/std/pkg/commands.ss +++ b/lib/std/pkg/commands.ss @@ -8,7 +8,7 @@ (library (std pkg commands) (export cmd-init cmd-new cmd-pack cmd-verify cmd-add cmd-remove cmd-install cmd-update cmd-uninstall - cmd-link cmd-unlink cmd-list cmd-env) + cmd-link cmd-unlink cmd-list cmd-env cmd-publish) (import (chezscheme) (only (jerboa core) def try catch) @@ -29,7 +29,12 @@ (only (std pkg project) project-add project-remove project-install project-update project-uninstall project-list project-env-paths - project-link project-unlink project-verify-lock)) + project-link project-unlink project-verify-lock) + (only (std pkg ed25519) hex->bytes) + (only (std pkg publish) + publish-keygen publish-load-key publish-key-public-hex + publish-to-registry) + (only (std crypto random) random-bytes)) (def (say fmt . args) (let ([p (current-output-port)]) @@ -254,6 +259,50 @@ (say-packages pkgs)) 0)) + ;; ── publish (phase 4) ────────────────────────────────────────────────── + + (def (parse-opts args known-flags) + ;; returns alist: --opt VAL -> (opt . VAL); bare --flag -> (flag . #t) + (let loop ([args args] [acc '()]) + (cond + [(null? args) (reverse acc)] + [(and (> (string-length (car args)) 2) + (string=? (substring (car args) 0 2) "--")) + (let ([key (string->symbol (substring (car args) 2 (string-length (car args))))]) + (if (memq key known-flags) + (loop (cdr args) (cons (cons key #t) acc)) + (if (null? (cdr args)) + (jpkg-error "option --~a needs a value" key) + (loop (cddr args) (cons (cons key (cadr args)) acc)))))] + [else (jpkg-error "unexpected argument ~s" (car args))]))) + + (def (cmd-publish args) + (let* ([opts (parse-opts args '(no-provenance keygen))] + [opt (lambda (k) (let ([p (assq k opts)]) (and p (cdr p))))] + [reg (opt 'registry)] + [keyfile (opt 'key)]) + (unless reg (jpkg-error "usage: jpkg publish --registry DIR --key FILE [--builder ID] [--source URL] [--no-provenance]")) + (unless keyfile (jpkg-error "jpkg publish requires --key FILE")) + ;; --keygen creates a fresh key file then exits + (when (opt 'keygen) + (publish-keygen keyfile (random-bytes 32)) + (say "generated signing key ~a" keyfile) + (say " public key: ~a" (publish-key-public-hex (publish-load-key keyfile))) + (exit 0)) + (let* ([seed (publish-load-key keyfile)] + [popts (append + (if (opt 'builder) (list (cons 'builder (opt 'builder))) '()) + (if (opt 'source) (list (cons 'source (opt 'source))) '()) + (list (cons 'provenance? (not (opt 'no-provenance)))))]) + (let-values ([(name version digest) + (publish-to-registry "." reg seed popts)]) + (say "published ~a ~a" name version) + (say " registry: ~a" reg) + (say " artifact: ~a" digest) + (say " publisher: ~a" (publish-key-public-hex seed)) + (say " provenance: ~a" (if (opt 'no-provenance) "omitted" "attached")) + 0)))) + (def (cmd-env args) ;; jpkg env -> print the env paths ;; jpkg env -- CMD ... -> run CMD with JERBOA_PKG_PATH set new file mode 100644 --- /dev/null +++ b/lib/std/pkg/dsse.ss @@ -0,0 +1,146 @@ +#!chezscheme +;;; (std pkg dsse) — Dead Simple Signing Envelope (DSSE) with Ed25519. +;;; +;;; DSSE is what in-toto/SLSA attestations are wrapped in. The signature +;;; covers the Pre-Authentication Encoding (PAE) of (payloadType, payload), +;;; NOT the raw payload, so a payload can't be reinterpreted under a +;;; different type: +;;; +;;; PAE(type, body) = +;;; "DSSEv1" SP len(type) SP type SP len(body) SP body (ASCII) +;;; +;;; Envelope JSON (canonical here): +;;; {"payload": base64(body), +;;; "payloadType": type, +;;; "signatures": [{"keyid": ..., "sig": base64(sig)} ...]} +;;; +;;; We use the standard base64 alphabet (RFC 4648) as the DSSE spec +;;; requires. Verification needs threshold-1 by default (one trusted +;;; key), but accepts an authorized-keyid set + threshold. + +(library (std pkg dsse) + (export dsse-pae + dsse-sign + dsse-verify + dsse-payload + dsse-envelope->json + dsse-json->envelope) + + (import (except (chezscheme) base64-encode base64-decode) + (only (jerboa core) def) + (only (std pkg util) jpkg-error) + (only (std pkg canonical) canonical-json) + (only (std pkg ed25519) + ed25519-sign* ed25519-verify* ed25519-public-key + bytes->hex hex->bytes) + (only (std text base64) base64-encode base64-decode)) + + ;; ── PAE ──────────────────────────────────────────────────────────────── + + (def (ascii-bytes s) (string->utf8 s)) + + (def (cat . bvs) + (let* ([total (fold-left + 0 (map bytevector-length bvs))] + [out (make-bytevector total)]) + (let loop ([off 0] [bvs bvs]) + (if (null? bvs) out + (begin (bytevector-copy! (car bvs) 0 out off + (bytevector-length (car bvs))) + (loop (+ off (bytevector-length (car bvs))) (cdr bvs))))))) + + (def (dsse-pae payload-type body-bytes) + ;; body-bytes is a bytevector; payload-type a string + (let ([tb (ascii-bytes payload-type)]) + (cat (ascii-bytes "DSSEv1 ") + (ascii-bytes (number->string (bytevector-length tb))) + (ascii-bytes " ") + tb + (ascii-bytes " ") + (ascii-bytes (number->string (bytevector-length body-bytes))) + (ascii-bytes " ") + body-bytes))) + + ;; ── sign / verify ────────────────────────────────────────────────────── + ;; envelope (canonical-data): (("payload" . body-bytevector) + ;; ("payloadType" . string) + ;; ("signatures" . ((keyid . sig-bv) ...))) + ;; In-memory we keep payload + sig as raw bytevectors; JSON ser/de does + ;; the base64. + + (def (dsse-sign payload-type body-bytes signers) + ;; signers: ((keyid . seed-bv) ...); returns in-memory envelope + (let ([pae (dsse-pae payload-type body-bytes)]) + (list (cons "payloadType" payload-type) + (cons "payload" body-bytes) + (cons "signatures" + (map (lambda (s) + (let ([pub (ed25519-public-key (cdr s))]) + (cons (car s) + (ed25519-sign* (cdr s) pub pae)))) + signers))))) + + (def (env-ref env key) + (let ([p (assoc key env)]) (and p (cdr p)))) + + (def (dsse-payload env) (env-ref env "payload")) + + ;; keydb: alist keyid -> pub-hex; returns #t if >= threshold distinct + ;; authorized keys produced valid signatures. + (def (dsse-verify env authorized-keyids threshold keydb) + (let* ([ptype (or (env-ref env "payloadType") + (jpkg-error "dsse: missing payloadType"))] + [body (or (env-ref env "payload") + (jpkg-error "dsse: missing payload"))] + [pae (dsse-pae ptype body)] + [sigs (or (env-ref env "signatures") '())]) + (let loop ([sigs sigs] [seen '()] [count 0]) + (cond + [(>= count threshold) #t] + [(null? sigs) + (jpkg-error "dsse: ~a valid signature~a, threshold ~a" + count (if (= count 1) "" "s") threshold)] + [else + (let* ([keyid (caar sigs)] [sig (cdar sigs)] + [pub (let ([p (assoc keyid keydb)]) (and p (cdr p)))]) + (if (and (member keyid authorized-keyids) + (not (member keyid seen)) + pub + (ed25519-verify* (hex->bytes pub) pae sig)) + (loop (cdr sigs) (cons keyid seen) (+ count 1)) + (loop (cdr sigs) seen count)))])))) + + ;; ── JSON ser/de (base64 of payload + sigs) ───────────────────────────── + + (def (dsse-envelope->json env) + (canonical-json + (list (cons "payload" (base64-encode (env-ref env "payload"))) + (cons "payloadType" (env-ref env "payloadType")) + (cons "signatures" + (list->vector + (map (lambda (s) + (list (cons "keyid" (car s)) + (cons "sig" (base64-encode (cdr s))))) + (env-ref env "signatures"))))))) + + (def (dsse-json->envelope canonical-data) + ;; canonical-data: alist with string payload/payloadType and vector + ;; of {keyid,sig} objects (as produced by (std pkg tuf) json->canonical) + (let ([oref (lambda (o k) (let ([p (and (list? o) (assoc k o))]) + (and p (cdr p))))]) + (let ([payload-b64 (oref canonical-data "payload")] + [ptype (oref canonical-data "payloadType")] + [sigs (oref canonical-data "signatures")]) + (unless (and (string? payload-b64) (string? ptype) (vector? sigs)) + (jpkg-error "dsse: malformed envelope")) + (list (cons "payloadType" ptype) + (cons "payload" (base64-decode payload-b64)) + (cons "signatures" + (map (lambda (s) + (let ([keyid (oref s "keyid")] + [sig (oref s "sig")]) + (unless (and (string? keyid) (string? sig)) + (jpkg-error "dsse: malformed signature")) + (cons keyid (base64-decode sig)))) + (vector->list sigs))))))) + + ) ;; end library --- a/lib/std/pkg/project.ss +++ b/lib/std/pkg/project.ss @@ -49,7 +49,7 @@ (only (std pkg registry) registry-config registry-lookup registry-versions-for registry-release-for - registry-fetch-blob + registry-fetch-blob registry-verify-authorship release-info-artifact-sha256 release-info-artifact-size release-info-manifest-sha256 release-info-dependencies release-info-yanked?) @@ -205,14 +205,26 @@ (jpkg-error "install: failed to link ~a" name)) lnk)) + (def (require-signatures?) (and (getenv "JPKG_REQUIRE_SIGNATURES") #t)) + (def (require-provenance?) (and (getenv "JPKG_REQUIRE_PROVENANCE") #t)) + (def (fetch-into-store! p) - (let ([digest (locked-package-artifact-sha256 p)]) - (unless (store-has? digest) - (let* ([reg-path (registry-lookup (locked-package-registry p))] - [tmp (format "/tmp/jpkg-fetch-~a.jpkg" (random-suffix))]) - (registry-fetch-blob reg-path digest tmp) - (store-put! tmp digest) ;; validates structure + digest - (delete-file tmp))) + (let ([digest (locked-package-artifact-sha256 p)] + [reg-name (locked-package-registry p)]) + (let ([reg-path (registry-lookup reg-name)]) + ;; authorship verification (signature / provenance) per policy, + ;; before the blob is trusted into the store. + (registry-verify-authorship + reg-name reg-path + (locked-package-name p) (locked-package-version p) + digest (locked-package-artifact-size p) + (locked-package-manifest-sha256 p) + (require-signatures?) (require-provenance?)) + (unless (store-has? digest) + (let ([tmp (format "/tmp/jpkg-fetch-~a.jpkg" (random-suffix))]) + (registry-fetch-blob reg-path digest tmp) + (store-put! tmp digest) ;; validates structure + digest + (delete-file tmp)))) (unless (store-verify digest) (jpkg-error "install: stored artifact ~a fails verification" digest)))) new file mode 100644 --- /dev/null +++ b/lib/std/pkg/provenance.ss @@ -0,0 +1,251 @@ +#!chezscheme +;;; (std pkg provenance) — package signatures, SLSA/in-toto provenance, +;;; and the publisher-trust model. +;;; +;;; Three independent authorship signals, all over the SAME signed +;;; subject (docs/jpkg-plan.md "Artifact Format"): +;;; +;;; signed subject = canonical JSON of +;;; {name, version, artifact-sha256, artifact-size, manifest-sha256} +;;; +;;; 1. Package signature: detached Ed25519 over the signed subject, by a +;;; publisher key authorized for the scope (self-hosted/offline path). +;;; 2. SLSA provenance: an in-toto Statement (subject digest == artifact +;;; digest, predicateType == SLSA provenance) wrapped in a DSSE +;;; envelope, signed by a provenance key; builder id checked against +;;; policy. +;;; 3. Sigstore bundle (keyed mode): a DSSE attestation verified against +;;; a configured verification key. Full keyless Fulcio/Rekor chain +;;; verification is future work (needs X.509 + transparency log). +;;; +;;; Publisher trust lives in a TUF-signed `publishers.json` target so a +;;; mirror cannot forge or strip it: +;;; {"scopes": {"@scope": {"keys": ["<pubhex>" ...], +;;; "builders": ["<builder-id>" ...]}}} + +(library (std pkg provenance) + (export signed-subject signed-subject-bytes + make-package-signature verify-package-signature + publishers-parse publishers-keys-for publishers-builders-for + pubhex->keyid authorized-keys-of + slsa-statement-bytes + make-provenance verify-provenance provenance-builder-id + sigstore-bundle-verify + INTOTO-PAYLOAD-TYPE SLSA-PREDICATE-TYPE INTOTO-STATEMENT-TYPE) + + (import (chezscheme) + (only (jerboa core) def try catch) + (only (std pkg util) + jpkg-error bytes->utf8-or-false sha256-hex-of-bytevector) + (only (std pkg canonical) canonical-json) + (only (std pkg store) valid-digest?) + (only (std pkg ed25519) + ed25519-public-key ed25519-sign* ed25519-verify* + bytes->hex hex->bytes) + (only (std pkg dsse) + dsse-sign dsse-verify dsse-payload dsse-pae + dsse-envelope->json dsse-json->envelope) + (only (std text json) string->json-object)) + + (def INTOTO-PAYLOAD-TYPE "application/vnd.in-toto+json") + (def INTOTO-STATEMENT-TYPE "https://in-toto.io/Statement/v1") + (def SLSA-PREDICATE-TYPE "https://slsa.dev/provenance/v1") + + ;; ── signed subject ───────────────────────────────────────────────────── + + (def (signed-subject name version artifact-sha256 artifact-size manifest-sha256) + (unless (valid-digest? artifact-sha256) + (jpkg-error "provenance: bad artifact-sha256")) + (unless (valid-digest? manifest-sha256) + (jpkg-error "provenance: bad manifest-sha256")) + (list (cons "artifact-sha256" artifact-sha256) + (cons "artifact-size" artifact-size) + (cons "manifest-sha256" manifest-sha256) + (cons "name" name) + (cons "version" version))) + + (def (signed-subject-bytes subject) + (string->utf8 (canonical-json subject))) + + ;; ── package signature (detached Ed25519) ─────────────────────────────── + ;; on-disk JSON: {"keyid","sig","subject":{...}} — sig is hex Ed25519 + ;; over canonical JSON of subject. + + (def (make-package-signature subject keyid seed) + (let* ([pub (ed25519-public-key seed)] + [sig (ed25519-sign* seed pub (signed-subject-bytes subject))]) + (canonical-json + (list (cons "keyid" keyid) + (cons "sig" (bytes->hex sig)) + (cons "subject" subject))))) + + (def (oref o k) (let ([p (and (list? o) (assoc k o))]) (and p (cdr p)))) + + ;; verify a signature file's content against an EXPECTED subject and a + ;; set of authorized publisher keys (alist keyid -> pubhex). + (def (verify-package-signature sig-canonical expected-subject authorized-keys) + (let ([keyid (oref sig-canonical "keyid")] + [sighex (oref sig-canonical "sig")] + [subj (oref sig-canonical "subject")]) + (unless (and (string? keyid) (string? sighex) (list? subj)) + (jpkg-error "provenance: malformed signature")) + ;; the embedded subject must equal the expected one (bytewise canonical) + (unless (string=? (canonical-json subj) (canonical-json expected-subject)) + (jpkg-error "provenance: signature subject does not match artifact")) + (let ([pub (oref authorized-keys keyid)]) + (unless pub + (jpkg-error "provenance: signer ~a is not an authorized publisher" keyid)) + (unless (ed25519-verify* (hex->bytes pub) + (signed-subject-bytes subj) + (hex->bytes sighex)) + (jpkg-error "provenance: package signature verification failed")) + keyid))) + + ;; ── publishers.json (TUF-signed target) ──────────────────────────────── + + (def (publishers-parse text) + (let* ([h (try (string->json-object text) + (catch (e) (jpkg-error "provenance: publishers.json unparseable")))] + [scopes (hashtable-ref h "scopes" #f)]) + (unless (hashtable? scopes) + (jpkg-error "provenance: publishers.json missing scopes")) + scopes)) ;; hashtable: "@scope" -> {keys:[...], builders:[...]} + + (def (scope-of name) + ;; "@scope/pkg" -> "@scope" + (let loop ([i 0]) + (cond [(= i (string-length name)) name] + [(char=? (string-ref name i) #\/) (substring name 0 i)] + [else (loop (+ i 1))]))) + + (def (publishers-keys-for scopes name) + ;; -> alist keyid? no — returns alist pubhex; key set authorized for scope. + ;; We key publisher trust by keyid = caller computes; here return pubhex list. + (let ([entry (hashtable-ref scopes (scope-of name) #f)]) + (if (hashtable? entry) + (let ([keys (hashtable-ref entry "keys" '())]) + (if (list? keys) (filter string? keys) '())) + '()))) + + (def (publishers-builders-for scopes name) + (let ([entry (hashtable-ref scopes (scope-of name) #f)]) + (if (hashtable? entry) + (let ([b (hashtable-ref entry "builders" '())]) + (if (list? b) (filter string? b) '())) + '()))) + + ;; A publisher key's id is sha256 of its 32-byte public key. + (def (pubhex->keyid pubhex) + (sha256-hex-of-bytevector (hex->bytes pubhex))) + + ;; pubhex list -> alist keyid -> pubhex (for verify-*'s keydb argument) + (def (authorized-keys-of pubhex-list) + (map (lambda (ph) (cons (pubhex->keyid ph) ph)) pubhex-list)) + + ;; ── SLSA provenance ──────────────────────────────────────────────────── + + (def (slsa-statement name artifact-sha256 builder-id source-uri build-type) + (list + (cons "_type" INTOTO-STATEMENT-TYPE) + (cons "predicate" + (list + (cons "buildDefinition" + (list (cons "buildType" build-type) + (cons "externalParameters" + (list (cons "source" source-uri))))) + (cons "runDetails" + (list (cons "builder" (list (cons "id" builder-id))))))) + (cons "predicateType" SLSA-PREDICATE-TYPE) + (cons "subject" + (vector + (list (cons "digest" (list (cons "sha256" artifact-sha256))) + (cons "name" name)))))) + + (def (slsa-statement-bytes name artifact-sha256 builder-id source-uri build-type) + (string->utf8 + (canonical-json + (slsa-statement name artifact-sha256 builder-id source-uri build-type)))) + + (def (make-provenance name artifact-sha256 builder-id source-uri build-type + keyid seed) + ;; -> DSSE envelope JSON string + (let* ([body (slsa-statement-bytes name artifact-sha256 builder-id + source-uri build-type)] + [env (dsse-sign INTOTO-PAYLOAD-TYPE body (list (cons keyid seed)))]) + (dsse-envelope->json env))) + + (def (statement-subject-digest stmt) + (let ([subj (oref stmt "subject")]) + (and (vector? subj) (> (vector-length subj) 0) + (let ([d (oref (vector-ref subj 0) "digest")]) + (and d (oref d "sha256")))))) + + (def (statement-subject-name stmt) + (let ([subj (oref stmt "subject")]) + (and (vector? subj) (> (vector-length subj) 0) + (oref (vector-ref subj 0) "name")))) + + (def (provenance-builder-id stmt) + (let ([pred (oref stmt "predicate")]) + (and pred + (let ([rd (oref pred "runDetails")]) + (and rd (let ([b (oref rd "builder")]) + (and b (oref b "id")))))))) + + ;; Verify a DSSE provenance envelope (canonical-data) against: + ;; - authorized provenance keys (alist keyid->pubhex), threshold + ;; - the expected artifact name + sha256 + ;; - allowed builder ids (when nonempty) + ;; Returns the parsed in-toto statement (canonical-data) on success. + (def (verify-provenance env-canonical authorized-keys threshold + name artifact-sha256 allowed-builders) + (let ([env (dsse-json->envelope env-canonical)]) + (dsse-verify env (map car authorized-keys) threshold authorized-keys) + (let* ([payload (dsse-payload env)] + [text (or (bytes->utf8-or-false payload) + (jpkg-error "provenance: payload not UTF-8"))] + [stmt-h (try (string->json-object text) + (catch (e) (jpkg-error "provenance: statement unparseable")))] + ;; reuse canonical conversion via re-encode/decode through json + [stmt (json->cdata stmt-h)]) + (unless (equal? (oref stmt "_type") INTOTO-STATEMENT-TYPE) + (jpkg-error "provenance: wrong statement _type")) + (unless (equal? (oref stmt "predicateType") SLSA-PREDICATE-TYPE) + (jpkg-error "provenance: wrong predicateType")) + (unless (equal? (statement-subject-name stmt) name) + (jpkg-error "provenance: subject name ~s != ~s" + (statement-subject-name stmt) name)) + (unless (equal? (statement-subject-digest stmt) artifact-sha256) + (jpkg-error "provenance: subject digest does not match artifact")) + (when (pair? allowed-builders) + (let ([bid (provenance-builder-id stmt)]) + (unless (and bid (member bid allowed-builders)) + (jpkg-error "provenance: builder ~s is not allowed by policy" bid)))) + stmt))) + + ;; minimal json-hashtable -> canonical-data (objects->sorted alists) + (def (json->cdata x) + (cond + [(hashtable? x) + (let-values ([(ks vs) (hashtable-entries x)]) + (list-sort (lambda (a b) (string<? (car a) (car b))) + (map (lambda (k v) (cons k (json->cdata v))) + (vector->list ks) (vector->list vs))))] + [(list? x) (list->vector (map json->cdata x))] + [(eq? x (void)) 'null] + [else x])) + + ;; ── Sigstore bundle (keyed verification mode) ────────────────────────── + ;; A Sigstore bundle carries a DSSE envelope; in keyed mode we verify + ;; that envelope against a configured public key (cosign verify-blob + ;; --key). Keyless Fulcio cert-chain + Rekor inclusion is future work. + + (def (sigstore-bundle-verify bundle-canonical verify-keys threshold + name artifact-sha256 allowed-builders) + (let* ([content (oref bundle-canonical "dsseEnvelope")]) + (unless content + (jpkg-error "provenance: sigstore bundle has no dsseEnvelope (keyless mode not supported)")) + (verify-provenance content verify-keys threshold + name artifact-sha256 allowed-builders))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/pkg/publish.ss @@ -0,0 +1,186 @@ +#!chezscheme +;;; (std pkg publish) — sign + attest + publish a package artifact. +;;; +;;; Key material is an Ed25519 seed stored as 64 hex chars in a file +;;; (mode 0600). The publish flow (docs/jpkg-plan.md "Publishing"): +;;; +;;; 1. pack the project deterministically +;;; 2. sign the canonical signed subject (package signature) +;;; 3. emit SLSA/in-toto provenance (DSSE), unless --no-provenance +;;; 4. add the blob + release.json + signature.json (+ provenance.json) +;;; 5. register the publisher key for the scope (publishers.json) +;;; 6. re-sign TUF targets/snapshot/timestamp so the new files are +;;; covered (mirrors stay untrusted) +;;; +;;; A self-hosted/staging registry is bootstrapped on first publish with +;;; the publish key as both the publisher and the TUF role authority. +;;; The official registry uses trusted CI publishing (out of scope here), +;;; but the client-side verification (phase 3 TUF + this module's +;;; signature/provenance checks) is identical. + +(library (std pkg publish) + (export publish-keygen publish-load-key publish-key-public-hex + publish-to-registry + publishers-json-of + staging-registry-init!) + + (import (chezscheme) + (only (jerboa core) def try catch) + (only (std pkg util) + jpkg-error mkdir-p path-concat random-suffix + read-file-bytevector write-file-bytevector + bytes->utf8-or-false sha256-hex-of-bytevector) + (only (std pkg canonical) canonical-json) + (only (std pkg ed25519) + ed25519-public-key bytes->hex hex->bytes) + (only (std pkg manifest) + parse-manifest-file manifest-name manifest-version + manifest->canonical-json) + (only (std pkg artifact) + pack-project artifact-validate artifact-info-manifest + artifact-info-digest artifact-info-size) + (only (std pkg provenance) + signed-subject make-package-signature make-provenance + pubhex->keyid) + (only (std pkg registry) + registry-generate-skeleton registry-add-signed-package!) + (only (std pkg tuf) + tuf-keygen tuf-registry? tuf-registry-init! tuf-registry-sign! + tuf-now)) + + ;; ── key files ────────────────────────────────────────────────────────── + + (def (publish-keygen path seed) + (unless (and (bytevector? seed) (= (bytevector-length seed) 32)) + (jpkg-error "publish: key seed must be 32 bytes")) + (when (file-exists? path) + (jpkg-error "publish: key file ~a already exists" path)) + (write-file-bytevector path (string->utf8 (bytes->hex seed))) + (chmod path #o600) + seed) + + (def (publish-load-key path) + (unless (file-exists? path) + (jpkg-error "publish: key file ~a not found" path)) + (let* ([text (or (bytes->utf8-or-false (read-file-bytevector path)) + (jpkg-error "publish: key file not UTF-8"))] + [trimmed (let trim ([s text]) + (let ([n (string-length s)]) + (cond [(= n 0) s] + [(char-whitespace? (string-ref s (- n 1))) + (trim (substring s 0 (- n 1)))] + [(char-whitespace? (string-ref s 0)) + (trim (substring s 1 n))] + [else s])))]) + (unless (= (string-length trimmed) 64) + (jpkg-error "publish: key file must hold 64 hex chars (32-byte seed)")) + (hex->bytes trimmed))) + + (def (publish-key-public-hex seed) + (bytes->hex (ed25519-public-key seed))) + + ;; ── publishers.json ──────────────────────────────────────────────────── + + (def (publishers-json-of scope-alist) + ;; scope-alist: (("@scope" (keys "hex" ...) (builders "id" ...)) ...) + (canonical-json + (list + (cons "scopes" + (map (lambda (e) + (cons (car e) + (list (cons "builders" + (list->vector + (let ([b (assq 'builders (cdr e))]) + (if b (cdr b) '())))) + (cons "keys" + (list->vector + (let ([k (assq 'keys (cdr e))]) + (if k (cdr k) '()))))))) + scope-alist))))) + + (def (scope-of name) + (let loop ([i 0]) + (cond [(= i (string-length name)) name] + [(char=? (string-ref name i) #\/) (substring name 0 i)] + [else (loop (+ i 1))]))) + + ;; ── staging registry bootstrap ───────────────────────────────────────── + ;; one key is TUF root/targets/snapshot/timestamp authority; the same + ;; key (as a publisher) is authorized for `scope`. + + (def (staging-registry-init! reg-path seed scope builders expires) + (registry-generate-skeleton reg-path) + (let* ([tk (tuf-keygen seed)] + [roles (list (list 'root (list tk) 1) + (list 'targets (list tk) 1) + (list 'snapshot (list tk) 1) + (list 'timestamp (list tk) 1))] + [pubhex (publish-key-public-hex seed)]) + (write-file-bytevector + (path-concat reg-path "publishers.json") + (string->utf8 + (publishers-json-of + (list (list scope (cons 'keys (list pubhex)) + (cons 'builders builders)))))) + (tuf-registry-init! reg-path roles expires) + (tuf-registry-sign! reg-path roles expires) + roles)) + + ;; ── publish ──────────────────────────────────────────────────────────── + + (def (default-expires) + ;; one year past "now" is unnecessary precision for staging; use a + ;; fixed far-future window keyed off the year in tuf-now. + (let ([now (tuf-now)]) + (string-append (number->string (+ 1 (string->number (substring now 0 4)))) + (substring now 4 (string-length now))))) + + ;; Publish the project in `project-dir` to `reg-path`, signing with the + ;; Ed25519 seed. Bootstraps a staging registry if reg-path has no TUF + ;; metadata. Returns (values name version digest). + (def (publish-to-registry project-dir reg-path seed opts) + ;; opts: alist with optional 'builder 'source 'provenance? 'expires + (let* ([m (parse-manifest-file (path-concat project-dir "jpkg.sexp"))] + [name (manifest-name m)] + [version (manifest-version m)] + [scope (scope-of name)] + [builder (or (and (assq 'builder opts) (cdr (assq 'builder opts))) + "jpkg-local-publish")] + [source (or (and (assq 'source opts) (cdr (assq 'source opts))) + "local")] + [provenance? (let ([p (assq 'provenance? opts)]) + (if p (cdr p) #t))] + [expires (or (and (assq 'expires opts) (cdr (assq 'expires opts))) + (default-expires))] + [roles + (if (tuf-registry? reg-path) + ;; existing registry: caller must have set up roles/publishers. + (let ([rs (assq 'roles opts)]) + (and rs (cdr rs))) + (staging-registry-init! reg-path seed scope (list builder) expires))] + [artifact (path-concat (path-concat project-dir ".jpkg") + (string-append "publish-" (random-suffix) ".jpkg"))]) + (mkdir-p (path-concat project-dir ".jpkg")) + (let-values ([(apath digest size) (pack-project project-dir artifact)]) + (let* ([info (artifact-validate apath)] + [manifest-sha256 + ;; same value the registry records: sha256 of the + ;; normalized manifest's canonical JSON + (sha256-hex-of-bytevector + (string->utf8 (manifest->canonical-json + (artifact-info-manifest info))))] + [subject (signed-subject name version digest size manifest-sha256)] + [keyid (pubhex->keyid (publish-key-public-hex seed))] + [sig-json (make-package-signature subject keyid seed)] + [prov-json (and provenance? + (make-provenance name digest builder source + "https://slsa.dev/jpkg-build/v1" + keyid seed))]) + (registry-add-signed-package! reg-path apath sig-json prov-json) + (delete-file apath) + ;; re-sign TUF so the new files become covered targets + (when roles + (tuf-registry-sign! reg-path roles expires)) + (values name version digest))))) + + ) ;; end library --- a/lib/std/pkg/registry.ss +++ b/lib/std/pkg/registry.ss @@ -31,6 +31,9 @@ release-info-capabilities release-info-yanked? registry-generate-skeleton registry-add-package! + registry-add-signed-package! + registry-publishers + registry-verify-authorship registry-yank!) (import (chezscheme) @@ -53,7 +56,12 @@ (only (std pkg tarball) tar-entry-name tar-entry-dir? tar-entry-content) (only (std pkg tuf) tuf-registry? tuf-context tuf-verified-target-bytes) + (only (std pkg provenance) + signed-subject verify-package-signature + publishers-parse publishers-keys-for publishers-builders-for + authorized-keys-of verify-provenance) (only (std text json) string->json-object)) + ;; canonical-json is already imported above for release-json rendering. ;; ── configuration ────────────────────────────────────────────────────── @@ -245,6 +253,96 @@ targets)))) (registry-package-versions reg-path pkg))) + ;; ── publisher trust + authorship verification (phase 4) ──────────────── + ;; publishers.json is a TUF target (when the registry is TUF) so a + ;; mirror can neither forge nor strip it. On a plain registry it is read + ;; directly (self-hosted dev convenience). + + (def (registry-target-bytes name reg-path rel-path) + ;; TUF-verified bytes when TUF present; plain read otherwise. + (if (tuf-registry? reg-path) + (let ([targets (tuf-targets-for name reg-path)]) + (tuf-verified-target-bytes targets reg-path rel-path)) + (let ([p (path-concat reg-path rel-path)]) + (and (file-exists? p) (read-file-bytevector p))))) + + (def (registry-publishers name reg-path) + ;; -> scopes hashtable, or #f when the registry declares no publishers + (let ([bytes (if (tuf-registry? reg-path) + (guard (e [#t #f]) + (let ([targets (tuf-targets-for name reg-path)]) + (tuf-verified-target-bytes targets reg-path + "publishers.json"))) + (let ([p (path-concat reg-path "publishers.json")]) + (and (file-exists? p) (read-file-bytevector p))))]) + (and bytes + (publishers-parse + (or (bytes->utf8-or-false bytes) + (jpkg-error "registry: publishers.json not UTF-8")))))) + + ;; Verify a release's authorship from its signed-subject fields: + ;; package signature (required when the scope has publisher keys) and, + ;; when require-provenance?, SLSA provenance with an allowed builder. + ;; Returns #t, or 'unsigned-ok when the registry declares no publishers + ;; (self-hosted/local mode). require-signature? forces a signature even + ;; for registries that declare no publishers (fail-closed policy). + (def (registry-verify-authorship name reg-path pkg version + artifact-sha256 artifact-size manifest-sha256 + require-signature? require-provenance?) + (let ([scopes (registry-publishers name reg-path)]) + (if (not scopes) + (if (or require-signature? require-provenance?) + (jpkg-error "registry: ~a has no publisher metadata but the policy requires signatures" + pkg) + 'unsigned-ok) + (let* ([pub-keys (publishers-keys-for scopes pkg)] + [builders (publishers-builders-for scopes pkg)] + [keydb (authorized-keys-of pub-keys)] + [subject (signed-subject pkg version + artifact-sha256 artifact-size + manifest-sha256)] + [sig-bytes (registry-target-bytes + name reg-path + (string-append "packages/" pkg "/" version + "/signature.json"))]) + (when (null? pub-keys) + (jpkg-error "registry: scope of ~a has no authorized publisher keys" pkg)) + (unless sig-bytes + (jpkg-error "registry: ~a@~a has no package signature" pkg version)) + (verify-package-signature + (json->cdata-canonical + (or (bytes->utf8-or-false sig-bytes) + (jpkg-error "registry: signature.json not UTF-8"))) + subject keydb) + (when require-provenance? + (let ([prov-bytes (registry-target-bytes + name reg-path + (string-append "packages/" pkg "/" version + "/provenance.json"))]) + (unless prov-bytes + (jpkg-error "registry: ~a@~a has no provenance" pkg version)) + (verify-provenance + (json->cdata-canonical + (or (bytes->utf8-or-false prov-bytes) + (jpkg-error "registry: provenance.json not UTF-8"))) + keydb 1 pkg artifact-sha256 builders))) + #t)))) + + ;; json text -> canonical-data (sorted alists / vectors), for verifying + ;; signature + provenance files. + (def (json->cdata-canonical text) + (let conv ([x (try (string->json-object text) + (catch (e) (jpkg-error "registry: bad JSON in metadata")))]) + (cond + [(hashtable? x) + (let-values ([(ks vs) (hashtable-entries x)]) + (list-sort (lambda (a b) (string<? (car a) (car b))) + (map (lambda (k v) (cons k (conv v))) + (vector->list ks) (vector->list vs))))] + [(list? x) (list->vector (map conv x))] + [(eq? x (void)) 'null] + [else x]))) + (def (registry-blob-path reg-path digest) (unless (valid-digest? digest) (jpkg-error "registry: invalid digest")) @@ -314,6 +412,20 @@ (string->utf8 (release-json rel))) rel))) + ;; Like registry-add-package! but also writes a package signature and, + ;; optionally, a provenance attestation produced by (std pkg publish). + ;; sig-json / prov-json are JSON strings (#f for prov to omit it). + (def (registry-add-signed-package! reg-path artifact-path sig-json prov-json) + (let ([rel (registry-add-package! reg-path artifact-path)]) + (let ([vdir (path-concat (package-dir reg-path (release-info-name rel)) + (release-info-version rel))]) + (write-file-bytevector (path-concat vdir "signature.json") + (string->utf8 sig-json)) + (when prov-json + (write-file-bytevector (path-concat vdir "provenance.json") + (string->utf8 prov-json)))) + rel)) + (def (registry-yank! reg-path name version) ;; mark a release yanked (does NOT remove the blob) (let* ([rel (registry-release reg-path name version)] --- a/lib/std/pkg/tuf.ss +++ b/lib/std/pkg/tuf.ss @@ -452,9 +452,12 @@ (string->utf8 (sign-envelope signed (cadr (get 'root))))) (void))) - ;; collect all release.json files under packages/ as targets + ;; collect every signed file: publishers.json + each version's + ;; release.json / signature.json / provenance.json (when present). (def (collect-targets reg-path) (let ([acc '()]) + (when (file-exists? (path-concat reg-path "publishers.json")) + (set! acc (cons "publishers.json" acc))) (let ([pkgs-dir (path-concat reg-path "packages")]) (when (file-directory? pkgs-dir) (for-each @@ -467,14 +470,17 @@ (when (file-directory? pkg-dir) (for-each (lambda (ver) - (let ([rj (path-concat - pkg-dir (path-concat ver "release.json"))]) - (when (file-exists? rj) - (set! acc - (cons - (string-append "packages/" scope "/" pkg - "/" ver "/release.json") - acc))))) + (for-each + (lambda (fname) + (let ([f (path-concat pkg-dir + (path-concat ver fname))]) + (when (file-exists? f) + (set! acc + (cons (string-append + "packages/" scope "/" pkg "/" + ver "/" fname) + acc))))) + '("release.json" "signature.json" "provenance.json"))) (directory-list pkg-dir))))) (directory-list scope-dir))))) (directory-list pkgs-dir)))) --- a/tests/test-jpkg-cli.ss +++ b/tests/test-jpkg-cli.ss @@ -89,7 +89,7 @@ ;; commands not yet implemented return 3 and say so on stderr. ;; Shrink this list as phases land. (define *expected-stubs* - '("build" "clean" "audit" "publish" "search" "dir" "policy")) + '("build" "clean" "audit" "search" "dir" "policy")) (for-each (lambda (cmd) new file mode 100644 --- /dev/null +++ b/tests/test-jpkg-publish.ss @@ -0,0 +1,280 @@ +#!chezscheme +;;; tests/test-jpkg-publish.ss — phase 4: DSSE, package signatures, SLSA +;;; provenance, registry publish + authorship verification, and policy +;;; enforcement (signatures/provenance required) end-to-end. + +(import (chezscheme) (std pkg dsse) (std pkg provenance) (std pkg publish) + (std pkg registry) (std pkg util) (std pkg ed25519) (std pkg cli) + (std pkg tuf) (std pkg lock) (std pkg artifact) + (only (std text json) string->json-object)) + +(define pass 0) +(define fail 0) + +(define-syntax check + (syntax-rules () + [(_ name expr) + (let ([got (guard (e [#t (list 'EXN (and (message-condition? e) + (condition-message e)))]) + expr)]) + (if (eq? got #t) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) (printf "FAIL ~a: got ~s~%" name got))))])) + +(define-syntax check-fails-with + (syntax-rules () + [(_ name substr expr) + (let ([got (guard (e [#t (if (and (message-condition? e) + (s-contains? (condition-message e) substr)) + 'EXPECTED + (list 'WRONG (and (message-condition? e) + (condition-message e))))]) + (begin expr 'NO-RAISE))]) + (if (eq? got 'EXPECTED) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) (printf "FAIL ~a: ~s~%" name got))))])) + +(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 publish tests ---~%") + +;; minimal json->canonical for the test (objects->sorted alists) +(define (canon-of json-text) + (let conv ([x (string->json-object json-text)]) + (cond + [(hashtable? x) + (let-values ([(ks vs) (hashtable-entries x)])