diff options
author | Christopher Baines <mail@cbaines.net> | 2023-03-14 09:34:57 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-03-14 09:34:57 +0000 |
commit | 1c5775e5442764286a993b30bfc39b89898ff82c (patch) | |
tree | e8ef4bf2d9abec71731ce21aa3075d06617db516 | |
parent | e5e1c91059d9e205fdbb2d2cc871cc9cb24b3855 (diff) | |
download | build-coordinator-1c5775e5442764286a993b30bfc39b89898ff82c.tar build-coordinator-1c5775e5442764286a993b30bfc39b89898ff82c.tar.gz |
Fix some incorrect refactoring in the publish hook
-rw-r--r-- | guix-build-coordinator/hooks.scm | 119 |
1 files changed, 59 insertions, 60 deletions
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 0f81f90..ad03465 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -194,66 +194,65 @@ referenced-source-files)))) (define (process-output drv-name 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 - drv-name) - #:derivation drv-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* ((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 + drv-name) + #:derivation drv-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)) |