Add a hook to generate the files needed to provide substitutes

1 files changed, 58 insertions, 0 deletions

diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index 0116605..d419365 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -21,9 +21,15 @@
 (define-module (guix-build-coordinator hooks)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:use-module (gcrypt pk-crypto)
+  #:use-module (guix pki)
+  #:use-module (guix config)
+  #:use-module (guix build utils)
+  #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator datastore)
   #:use-module (guix-build-coordinator coordinator)
   #:export (default-build-success-hook
+            build-success-publish-hook
             default-build-failure-hook
             default-build-missing-inputs-hook))
 
@@ -36,6 +42,58 @@
                     build-id agent-id)
      (current-error-port))))
 
+
+(define* (build-success-publish-hook
+          publish-directory
+          #:key
+          (public-key  (read-file-sexp %public-key-file))
+          (private-key (read-file-sexp %private-key-file)))
+  (mkdir-p (string-append publish-directory "/nar/lzip"))
+
+  (lambda (datastore build-id)
+    (let* ((build-details
+            (datastore-find-build datastore build-id))
+           (derivation-name
+            (assq-ref build-details 'derivation-name)))
+      (for-each
+       (lambda (output)
+         (let* ((output-name
+                 (assq-ref output 'name))
+                (output-filename
+                 (assq-ref output 'output))
+                (nar-location
+                 (build-output-file-location datastore build-id
+                                             output-name))
+                (nar-destination
+                 (string-append publish-directory
+                                "/nar/lzip/"
+                                (basename output-filename)))
+                (narinfo-location
+                 (string-append publish-directory
+                                "/"
+                                (string-take (basename output-filename) 32)
+                                ".narinfo")))
+
+           (copy-file nar-location nar-destination)
+
+           (call-with-output-file narinfo-location
+             (lambda (port)
+               (display (narinfo-string
+                         output-filename
+                         (assq-ref output 'hash)
+                         (assq-ref output 'size)
+                         (vector->list
+                          (assq-ref output 'references))
+                         `((lzip ,(stat:size (stat nar-location #f))))
+                         #:system (datastore-find-derivation-system
+                                   datastore
+                                   derivation-name)
+                         #:derivation derivation-name
+                         #:public-key public-key
+                         #:private-key private-key)
+                        port)))))
+       (datastore-list-build-outputs datastore build-id)))))
+
 (define (default-build-failure-hook datastore build-id)
   (let ((agent-id
          (datastore-agent-for-build datastore build-id)))