diff options
Diffstat (limited to 'guix-build-coordinator/hooks.scm')
| -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 |