diff options
-rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 61 |
1 files changed, 36 insertions, 25 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index 21ade0d..7d93285 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -503,37 +503,48 @@ category-name category-value #:key (relationship 'no-dependent-builds)) + (define (fetch-build-uuids) + (fold-builds + build-coordinator + (lambda (build-details result) + (cons (assoc-ref build-details "uuid") result)) + '() + #:tags + `(((key . category) + (value . package)) + ((key . ,category-name) + (value . ,category-value))) + #:canceled #f + #:processed #f + #:relationship relationship)) + (simple-format (current-error-port) "canceling builds for ~A ~A\n" category-name category-value) (with-fibers-port-timeouts (lambda () - (for-each-build - build-coordinator - (lambda (build-details) - (retry-on-error - (lambda () - (send-cancel-build-request build-coordinator - (assoc-ref build-details "uuid") - #:skip-updating-derived-priorities? #t - #:ignore-if-build-required-by-another? - (if (eq? relationship 'unset) - #f - #t))) - #:times 6 - #:delay 15) - (simple-format (current-error-port) - "canceled ~A\n" - (assoc-ref build-details "uuid"))) - #:tags - `(((key . category) - (value . package)) - ((key . ,category-name) - (value . ,category-value))) - #:canceled #f - #:processed #f - #:relationship relationship)) + (let loop ((uuids-batch (fetch-build-uuids))) + + (for-each + (lambda (uuid) + (retry-on-error + (lambda () + (send-cancel-build-request build-coordinator + uuid + #:skip-updating-derived-priorities? #t + #:ignore-if-build-required-by-another? + (if (eq? relationship 'unset) + #f + #t))) + #:times 6 + #:delay 15) + (simple-format (current-error-port) + "canceled ~A\n" uuid)) + uuids-batch) + + (unless (null? uuids-batch) + (loop (fetch-build-uuids))))) #:timeout 60) (simple-format (current-error-port) "finshed canceling builds for ~A ~A\n" |