From 38c9b26ef104936d8d483cab630aa43fda8e8499 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 13 Mar 2023 18:13:37 +0000 Subject: Add a combined variant of the post-publish-hook To the build-success-publish-hook. This should make it possible to pass all nars and narinfo's to the nar-herder in one go, which in turn should make it possible to have the nar-herder validate referential integrity, even in the case where one build has multiple outputs which have circular references. --- guix-build-coordinator/hooks.scm | 325 ++++++++++++++++++++++----------------- 1 file changed, 180 insertions(+), 145 deletions(-) (limited to 'guix-build-coordinator') diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 9917a98..4845f6d 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -92,6 +92,7 @@ (file-exists? (string-append narinfo-directory "/" narinfo-filename)))) post-publish-hook + combined-post-publish-hook (publish-referenced-derivation-source-files? #t) derivation-substitute-urls) (mkdir-p (string-append publish-directory "/nar/lzip")) @@ -100,154 +101,188 @@ (define datastore (build-coordinator-datastore build-coordinator)) + (define (process-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))))) + + (filter-map + (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))) + + (if (skip-publishing-proc narinfo-filename narinfo-directory) + #f + (begin + (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 nar-destination #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)) + + (cons narinfo-filename + nar-filename))))) + referenced-source-files)))) + + (define (process-output output) + (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-filename + (string-append "nar/lzip/" + (basename output-filename))) + (nar-destination + (string-append publish-directory "/" + nar-filename)) + (narinfo-filename + (string-append (string-take (basename output-filename) 32) + ".narinfo")) + + (narinfo-location + (string-append narinfo-directory "/" + narinfo-filename))) + + (if (skip-publishing-proc narinfo-filename narinfo-directory) + #f + (begin + (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))) + + (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)) + + (cons narinfo-filename + nar-filename)))))) + (let* ((build-details (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 nar-destination #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 - (assq-ref output 'name)) - (output-filename - (assq-ref output 'output)) - (nar-location - (build-output-file-location datastore build-id - output-name)) - (nar-filename - (string-append "nar/lzip/" - (basename output-filename))) - (nar-destination - (string-append publish-directory "/" - nar-filename)) - (narinfo-filename - (string-append (string-take (basename output-filename) 32) - ".narinfo")) - - (narinfo-location - (string-append narinfo-directory "/" - narinfo-filename))) - - (unless (skip-publishing-proc narinfo-filename narinfo-directory) - (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))) - - (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))))) - (datastore-list-build-outputs datastore build-id))))) + (assq-ref build-details 'derivation-name)) + (narinfos-and-nars + (append + (if publish-referenced-derivation-source-files? + (process-referenced-derivation-source-files) + '()) + (filter-map + process-output + (datastore-list-build-outputs datastore build-id))))) + (when combined-post-publish-hook + (with-exception-handler + (lambda (exn) + ;; Rollback narinfo creation, to make this more + ;; transactional + (for-each + (match-lambda + ((narinfo-filename . _) + (delete-file narinfo-filename))) + narinfos-and-nars) + + (raise-exception exn)) + (lambda () + (combined-post-publish-hook publish-directory + narinfos-and-nars)) + #:unwind? #t))))) (define* (build-success-s3-publish-hook s3-bucket -- cgit v1.2.3