release: publish exact jpkg artifacts to TUF registry

ober

30f03f3ed3acbebf5507b7adf0d25029fb80aa4e

diff --git a/support/registry-publish-exact.ss b/support/registry-publish-exact.ss
new file mode 100644
index 0000000..ff0a60c
--- /dev/null
+++ b/support/registry-publish-exact.ss
@@ -0,0 +1,71 @@
+(import (jerboa prelude))
+(import (std pkg artifact))
+(import (std pkg manifest))
+(import (std pkg publish))
+(import (std pkg provenance))
+(import (std pkg registry))
+(import (std pkg transparency))
+(import (std pkg tuf))
+(import (only (std pkg util)
+              bytes->utf8-or-false read-file-bytevector
+              sha256-hex-of-bytevector write-file-bytevector))
+
+(def (publish-exact artifact registry-dir key-path builder-id source-url)
+  (let* ([seed (publish-load-key key-path)]
+         [info (artifact-validate artifact)]
+         [manifest (artifact-info-manifest info)]
+         [name (manifest-name manifest)]
+         [version (manifest-version manifest)]
+         [digest (artifact-info-digest info)]
+         [size (artifact-info-size info)]
+         [manifest-digest
+          (sha256-hex-of-bytevector
+           (string->utf8 (manifest->canonical-json manifest)))]
+         [keyid (pubhex->keyid (publish-key-public-hex seed))]
+         [subject (signed-subject name version digest size manifest-digest)]
+         [signature-json (make-package-signature subject keyid seed)]
+         [provenance-json
+          (make-provenance
+           name digest builder-id source-url
+           "https://slsa.dev/jpkg-build/v1" keyid seed)]
+         [transparency-path (path-join registry-dir "transparency.json")]
+         [transparency-text
+          (or (bytes->utf8-or-false
+               (read-file-bytevector transparency-path))
+              (error 'registry-publish-exact
+                     "transparency metadata is not UTF-8"))]
+         [transparency (transparency-parse transparency-text)]
+         [next-transparency
+          (transparency-append transparency name version digest keyid)]
+         [role-key (tuf-keygen seed)]
+         [role-keys (list role-key)]
+         [roles
+          (list
+           (list 'root role-keys 1)
+           (list 'targets role-keys 1)
+           (list 'snapshot role-keys 1)
+           (list 'timestamp role-keys 1))]
+         [expires
+          (iso8601-of-epoch
+           (+ (time-second (current-time)) (* 366 24 60 60)))])
+    (registry-add-signed-package!
+     registry-dir artifact signature-json provenance-json)
+    (write-file-bytevector
+     transparency-path
+     (string->utf8 (transparency->json next-transparency)))
+    (tuf-registry-sign! registry-dir roles expires)
+    (displayln "published " name "@" version " sha256:" digest)))
+
+(def args (command-line))
+(cond
+  [(<= (length args) 2) (void)]
+  [(= (length args) 7)
+   (publish-exact
+    (list-ref args 2)
+    (list-ref args 3)
+    (list-ref args 4)
+    (list-ref args 5)
+    (list-ref args 6))]
+  [else
+   (error 'registry-publish-exact
+          "usage: jerboa run SCRIPT ARTIFACT REGISTRY KEY BUILDER SOURCE")])