From 954c1e9d4723d1e72da29a3760ab4034d5f829a2 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 26 Aug 2020 18:54:51 +0100 Subject: Change how agents handle store connections Keep a connection open for longer, to allow for doing things like registering gc roots. --- guix-build-coordinator/agent.scm | 115 ++++++++++++++++++++------------------- 1 file changed, 58 insertions(+), 57 deletions(-) diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index a2c55ef..c8a640a 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -54,48 +54,50 @@ (derivation-name (assoc-ref build "derivation-name"))) (simple-format #t "~A: setting up to build: ~A\n" build-id derivation-name) - (let ((pre-build-status (pre-build-process - derivation-substitute-urls - non-derivation-substitute-urls - derivation-name))) - (if (eq? (assq-ref pre-build-status 'result) 'success) - (begin - (simple-format #t "~A: setup successful, building: ~A\n" - build-id derivation-name) - (report-build-start coordinator-uri uuid password - build-id) - (let* ((result (perform-build derivation-name)) - ;; TODO Check this handles timezones right - (end-time (localtime (current-time) "UTC"))) - (retry-on-error - (lambda () - (let ((log-file (derivation-log-file derivation-name))) - (unless log-file - (raise-exception - (make-exception-with-message - (simple-format #f "log file missing for ~A (~A)" - derivation-name build-id)))) + (with-store store + (let ((pre-build-status (pre-build-process + store + derivation-substitute-urls + non-derivation-substitute-urls + derivation-name))) + (if (eq? (assq-ref pre-build-status 'result) 'success) + (begin + (simple-format #t "~A: setup successful, building: ~A\n" + build-id derivation-name) + (report-build-start coordinator-uri uuid password + build-id) + (let* ((result (perform-build store derivation-name)) + ;; TODO Check this handles timezones right + (end-time (localtime (current-time) "UTC"))) + (retry-on-error + (lambda () + (let ((log-file (derivation-log-file derivation-name))) + (unless log-file + (raise-exception + (make-exception-with-message + (simple-format #f "log file missing for ~A (~A)" + derivation-name build-id)))) - (simple-format #t "~A: uploading log file ~A\n" - build-id log-file) - (submit-log-file - coordinator-uri uuid password - build-id - log-file))) - #:times 6 - #:delay 30) - ((if result - post-build-success - post-build-failure) - uuid coordinator-uri password - build-id - derivation-name - end-time))) - (begin - (simple-format #t "~A: failure: ~A\n" build-id pre-build-status) - (report-setup-failure coordinator-uri uuid password - build-id - pre-build-status)))))) + (simple-format #t "~A: uploading log file ~A\n" + build-id log-file) + (submit-log-file + coordinator-uri uuid password + build-id + log-file))) + #:times 6 + #:delay 30) + ((if result + post-build-success + post-build-failure) + uuid coordinator-uri password + build-id + derivation-name + end-time))) + (begin + (simple-format #t "~A: failure: ~A\n" build-id pre-build-status) + (report-setup-failure coordinator-uri uuid password + build-id + pre-build-status))))))) (let-values (((process-job-with-queue count-jobs) (create-work-queue max-parallel-builds @@ -121,7 +123,8 @@ jobs))))) (sleep 5)))) -(define (pre-build-process derivation-substitute-urls +(define (pre-build-process store + derivation-substitute-urls non-derivation-substitute-urls derivation-name) (define (find-missing-inputs inputs) @@ -132,7 +135,7 @@ (valid-path? store path)) output-paths)) (path-substitutes - (with-store store + (begin (set-build-options store #:substitute-urls non-derivation-substitute-urls) @@ -167,12 +170,11 @@ (make-exception-with-message "timeout fetching inputs")) (begin ;; Download the substitutes - (with-store store - (set-build-options store - #:substitute-urls - non-derivation-substitute-urls) + (set-build-options store + #:substitute-urls + non-derivation-substitute-urls) - (build-things store missing-paths))))) + (build-things store missing-paths)))) #:times 6 #:delay 60) @@ -233,22 +235,21 @@ '((result . failure) (failure_reason . could_not_delete_outputs)))))) -(define (perform-build derivation-name) - (with-store store - (set-build-options store - #:use-substitutes? #f) +(define (perform-build store derivation-name) + (set-build-options store + #:use-substitutes? #f) - (parameterize ((current-build-output-port (%make-void-port "w"))) - (catch #t - (lambda () - (build-things store (list derivation-name)) + (parameterize ((current-build-output-port (%make-void-port "w"))) + (catch #t + (lambda () + (build-things store (list derivation-name)) #t) (lambda (key . args) (simple-format (current-error-port) "error: build: ~A ~A\n" key args) - #f))))) + #f)))) (define (post-build-failure uuid coordinator-uri password build-id derivation end-time) -- cgit v1.2.3