diff options
Diffstat (limited to 'guix-build-coordinator/agent.scm')
| -rw-r--r-- | guix-build-coordinator/agent.scm | 42 |
1 files changed, 33 insertions, 9 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 6e7d083..c5094d4 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -21,7 +21,9 @@ (define-module (guix-build-coordinator agent) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (ice-9 match) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix derivations) #:use-module (guix-build-coordinator agent-messaging http) #:export (run-agent)) @@ -39,22 +41,44 @@ (for-each (lambda (build) (let ((derivation-name (assoc-ref build "derivation-name"))) (pre-build-process derivation-name) - (build-derivation derivation-name))) + (perform-build derivation-name))) builds))) (define (pre-build-process derivation-name) + (define (substitute-derivation derivation-name) + (catch #t + (lambda () + (with-store store + (set-build-options store + #:print-extended-build-trace? #t + #:multiplexed-build-output? #t) + (with-status-report + (lambda (event status new) + (print-build-event event status new) + (match event + (('substituter-succeeded substituted-drv) + (when (string=? derivation-name + substituted-drv) + (close-connection store))) + (_ #t))) + (build-things store (list derivation-name))))) + (lambda (key . args) + ;; This is a hack, to ignore errors relating to closing the store + ;; connection. + #f))) + (let ((derivation (if (file-exists? derivation-name) (read-derivation-from-file derivation-name) - (and (with-store store - (build-things store (list derivation-name))) + (and (substitute-derivation derivation-name) (read-derivation-from-file derivation-name))))) - (let ((outputs (derivation-outputs derivation))) - (with-store store - (delete-paths - store - (map derivation-output-path (map cdr outputs)))) + (let* ((outputs (derivation-outputs derivation)) + (output-file-names + (map derivation-output-path (map cdr outputs)))) + (when (any file-exists? output-file-names) + (with-store store + (delete-paths store output-file-names))) (let* ((inputs (derivation-inputs derivation)) (output-paths @@ -63,7 +87,7 @@ (with-store store (build-things store output-paths)))))) -(define (build-derivation derivation-name) +(define (perform-build derivation-name) (with-store store (set-build-options store #:use-substitutes? #f) |