diff options
-rw-r--r-- | guix-build-coordinator/hooks.scm | 96 |
1 files changed, 95 insertions, 1 deletions
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 5163a5d..a9a6850 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -25,8 +25,13 @@ #:use-module (ice-9 exceptions) #:use-module (gcrypt pk-crypto) #:use-module (zlib) + #:use-module (lzlib) #:use-module (guix pki) + #:use-module (guix store) + #:use-module (guix base32) #:use-module (guix config) + #:use-module (guix derivations) + #:use-module (guix serialization) #:use-module ((guix utils) #:select (default-keyword-arguments)) #:use-module (guix build utils) #:use-module (guix-build-coordinator config) @@ -86,7 +91,9 @@ (lambda (narinfo-filename narinfo-directory) (file-exists? (string-append narinfo-directory "/" narinfo-filename)))) - post-publish-hook) + post-publish-hook + (publish-referenced-derivation-source-files? #t) + derivation-substitute-urls) (mkdir-p (string-append publish-directory "/nar/lzip")) (lambda (build-coordinator build-id) @@ -97,6 +104,93 @@ (datastore-find-build datastore build-id)) (derivation-name (assq-ref build-details 'derivation-name))) + (when publish-referenced-derivation-source-files? + (with-store store + (unless (valid-path? store derivation-name) + (substitute-derivation derivation-name + #:substitute-urls + derivation-substitute-urls)) + + (let* ((drv (read-derivation-from-file derivation-name)) + (drv-sources + (derivation-sources drv)) + (referenced-source-files + (delete-duplicates + (append-map + (lambda (output) + (let ((refs + (or (and=> (assq-ref output 'references) + vector->list) + '()))) + + (filter + (lambda (source) + (member (basename source) refs)) + drv-sources))) + (datastore-list-build-outputs datastore build-id))))) + + (for-each + (lambda (source-filename) + (let* ((nar-filename + (string-append "nar/lzip/" + (basename source-filename))) + (nar-destination + (string-append publish-directory "/" + nar-filename)) + (tmp-nar-destination + (string-append publish-directory "/" + nar-filename + ".tmp")) + (narinfo-filename + (string-append (string-take (basename source-filename) 32) + ".narinfo")) + + (narinfo-location + (string-append narinfo-directory "/" + narinfo-filename)) + (path-info + (query-path-info store source-filename))) + + (unless (skip-publishing-proc narinfo-filename narinfo-directory) + (call-with-output-file tmp-nar-destination + (lambda (out) + (call-with-lzip-output-port out + (lambda (port) + (write-file source-filename port)) + #:level 9))) + + (rename-file tmp-nar-destination nar-destination) + + (call-with-output-file narinfo-location + (lambda (port) + (display (narinfo-string + source-filename + (bytevector->nix-base32-string + (path-info-hash path-info)) + (path-info-nar-size path-info) + (map basename + (path-info-references + path-info)) + `((lzip ,(stat:size (stat source-filename #f)))) + #:public-key public-key + #:private-key private-key) + port))) + + (when post-publish-hook + (with-exception-handler + (lambda (exn) + ;; Rollback narinfo creation, to make this more + ;; transactional + (delete-file narinfo-location) + + (raise-exception exn)) + (lambda () + (post-publish-hook publish-directory + narinfo-filename + nar-filename)) + #:unwind? #t))))) + referenced-source-files)))) + (for-each (lambda (output) (let* ((output-name |