diff options
author | Christopher Baines <mail@cbaines.net> | 2021-03-06 18:55:30 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-03-06 18:55:30 +0000 |
commit | e5d82a24a0776865a0b1ba7324b295e2a390a4a8 (patch) | |
tree | 237aeddc7c1e9f2977869e72ffacd3ff2e53400e | |
parent | 1f79fc38a17ceda30f378efd4e7f80f252c99b4d (diff) | |
download | build-coordinator-e5d82a24a0776865a0b1ba7324b295e2a390a4a8.tar build-coordinator-e5d82a24a0776865a0b1ba7324b295e2a390a4a8.tar.gz |
Make the build failure retry hook more flexible
Now a procedure can be passed in, which should return arguments for the builds
to submit.
I'm looking at using this to spread retries across a range of machines for
example, by specifying different tags for each of the retries.
-rw-r--r-- | guix-build-coordinator/hooks.scm | 42 |
1 files changed, 30 insertions, 12 deletions
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index 263d783..7577891 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -27,6 +27,7 @@ #:use-module (zlib) #:use-module (guix pki) #:use-module (guix config) + #:use-module ((guix utils) #:select (default-keyword-arguments)) #:use-module (guix build utils) #:use-module (guix-build-coordinator config) #:use-module (guix-build-coordinator utils) @@ -238,7 +239,8 @@ build-id) (current-error-port))) -(define* (build-failure-retry-hook #:key (retries 2)) +(define* (build-failure-retry-hook #:key + (retries 2)) (lambda (build-coordinator build-id) (define datastore (build-coordinator-datastore build-coordinator)) @@ -248,25 +250,41 @@ (all-builds-for-derivation-count (datastore-count-builds-for-derivation datastore derivation-name - #:include-canceled? #f))) - (when (= 1 all-builds-for-derivation-count) + #:include-canceled? #f)) + (retries-list + (if (procedure? retries) + (retries #:build-details build-details + #:derivation-details (datastore-find-derivation + datastore + derivation-name) + #:builds-for-derivation-count + all-builds-for-derivation-count) + (if (= 1 all-builds-for-derivation-count) + '() + (make-list retries '()))))) + (unless (null? retries-list) (display (simple-format #f "~A: submitting ~A retries for\n ~A\n" - build-id retries derivation-name)) + build-id (length retries-list) derivation-name)) (for-each - (lambda (retry) + (lambda (retry-arguments index) (let ((details - (submit-build build-coordinator derivation-name - #:priority (assq-ref build-details 'priority) - #:tags (datastore-fetch-build-tags - datastore - build-id)))) + (apply submit-build + build-coordinator derivation-name + (default-keyword-arguments + retry-arguments + (list + #:priority (assq-ref build-details 'priority) + #:tags (datastore-fetch-build-tags + datastore + build-id)))))) (display (simple-format #f "~A: submitted retry ~A as ~A\n" build-id - (+ 1 retry) + index (assq-ref details 'build-submitted))))) - (iota retries)))))) + retries-list + (iota (length retries-list) 1)))))) (define* (build-recompress-log-file-hook #:key recompress-to |