diff options
| -rw-r--r-- | guix-build-coordinator/hooks.scm | 197 |
1 files changed, 107 insertions, 90 deletions
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 6ba0c20..ae5fd62 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -102,99 +102,116 @@ (build-coordinator-datastore build-coordinator)) (define (process-referenced-derivation-source-files drv-name) - (with-store store - (unless (valid-path? store drv-name) - (set-store-connection-timeout store) - - ;; TODO This isn't ideal as it can be blocked by GC - (substitute-derivation drv-name - #:substitute-urls - derivation-substitute-urls)) - - (let* ((drv (read-derivation-from-file drv-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) - '()))) - + (let* ((build-outputs + (datastore-list-build-outputs datastore build-id)) + (derivation-inputs + (datastore-find-derivation-inputs datastore drv-name)) + (potential-referenced-source-files + ;; Just subtract the inputs from the output references + (lset-difference + string=? + (delete-duplicates + (append-map (lambda (output) + ;; References don't include the store path + (or (and=> (assq-ref output 'references) + vector->list) + '())) + build-outputs) + string=?) + (map (lambda (input) + (basename (assq-ref input 'output))) + derivation-inputs)))) + + (if (null? potential-referenced-source-files) + '() + (with-store store + (unless (valid-path? store drv-name) + (set-store-connection-timeout store #:timeout 20) + + ;; TODO This isn't ideal as it can be blocked by GC + (substitute-derivation drv-name + #:substitute-urls + derivation-substitute-urls) + (add-temp-root store drv-name)) + + (let* ((drv (read-derivation-from-file drv-name)) + (drv-sources + (derivation-sources drv)) + (referenced-source-files (filter (lambda (source) - (member (basename source) refs)) + (if (member (basename source) + potential-referenced-source-files) + source + #f)) 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)))) + + (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 drv-name output) (let* ((output-name |