Add a function to generate the string for a narinfo file

1 files changed, 60 insertions, 1 deletions

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 3d34712..fcdd9f7 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -6,9 +6,13 @@
   #:use-module (ice-9 threads)
   #:use-module (ice-9 binary-ports)
   #:use-module (rnrs bytevectors)
+  #:use-module (web uri)
+  #:use-module (gcrypt pk-crypto)
+  #:use-module (gcrypt hash)
   #:use-module (gcrypt random)
   #:use-module (fibers)
   #:use-module (fibers channels)
+  #:use-module (guix pki)
   #:use-module (guix store)
   #:use-module (guix status)
   #:use-module (guix base64)
@@ -19,7 +23,10 @@
 
             make-base64-output-port
 
-            substitute-derivation))
+            substitute-derivation
+
+            narinfo-string))
+
 
 (define %worker-thread-args
   (make-parameter #f))
@@ -179,3 +186,55 @@ If already in the worker thread, call PROC immediately."
         ;; This is a hack, to ignore errors relating to closing the store
         ;; connection.
         #f)))
+
+(define* (narinfo-string store-path hash size references
+                         compressed-files
+                         #:key (nar-path "nar")
+                         system derivation
+                         public-key private-key)
+  (define (signed-string s)
+    (let* ((hash (bytevector->hash-data (sha256 (string->utf8 s))
+                                        #:key-type (key-type public-key))))
+      (signature-sexp hash private-key public-key)))
+
+  (define base64-encode-string
+    (compose base64-encode string->utf8))
+
+  (define* (store-item->recutils compression file-size)
+    (let ((url (encode-and-join-uri-path
+                `(,@(split-and-decode-uri-path nar-path)
+                  ,@(if compression
+                        (list (symbol->string compression))
+                        '())
+                  ,(basename store-path)))))
+      (format #f "URL: ~a~%Compression: ~a~%~@[FileSize: ~a~%~]"
+              url
+              (or compression "none")
+              file-size)))
+
+  (let* ((base-info  (format #f
+                             "\
+StorePath: ~a
+~{~a~}\
+NarHash: sha256:~a
+NarSize: ~d
+References: ~a~%"
+                             store-path
+                             (map (match-lambda
+                                    ((compression compressed-size)
+                                     (store-item->recutils compression
+                                                           compressed-size)))
+                                  compressed-files)
+                             hash size
+                             (string-join references " ")))
+         ;; Do not render a "Deriver" or "System" line if we are rendering
+         ;; info for a derivation.
+         (info       (if derivation
+                         (format #f "~aSystem: ~a~%Deriver: ~a~%"
+                                 base-info
+                                 system
+                                 (basename derivation))
+                         base-info))
+         (signature  (base64-encode-string
+                      (canonical-sexp->string (signed-string info)))))
+  (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))