diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-05-24 12:10:49 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-05-24 12:10:49 +0100 |
| commit | 3de63f1f66d5f0eb157ee60bc864404f386ee2b0 (patch) | |
| tree | 5c06f3d66a37857bbe558e6dea2683584460da0b /scripts | |
| parent | 6caee98dbd8d72a55d510da86b197470b48d7c15 (diff) | |
| download | build-coordinator-3de63f1f66d5f0eb157ee60bc864404f386ee2b0.tar build-coordinator-3de63f1f66d5f0eb157ee60bc864404f386ee2b0.tar.gz | |
Support passing the build-server-id to the Guix Data Service
When querying for package derivations to build. This cuts out derivations that
have builds for that particular build server, meaning that less requests need
to be made to the coordinator.
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in | 41 |
1 files changed, 30 insertions, 11 deletions
diff --git a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in index 3de78fe..e7fbdb3 100644 --- a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in +++ b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in @@ -133,14 +133,19 @@ (define* (package-derivations-for-commit guix-data-service commit - #:key system target) + #:key system target + guix-data-service-build-server-id) (let ((data (guix-data-service-request guix-data-service (string-append "/revision/" commit "/package-derivations.json") - `((system . ,system) + (peek `((system . ,system) (target . ,target) (field . "(no-additional-fields)") - (all_results . "on"))))) + ,@(if guix-data-service-build-server-id + `((no_build_from_build_server + . ,guix-data-service-build-server-id)) + '()) + (all_results . "on")))))) (map (lambda (entry) (assoc-ref entry "derivation")) (vector->list @@ -186,7 +191,8 @@ systems-and-targets priority-for-derivation #:key (submit-builds-for-channel-instances? - #t)) + #t) + guix-data-service-build-server-id) (log-msg 'INFO "looking at revision " commit) (par-for-each (match-lambda @@ -220,7 +226,9 @@ (package-derivations-for-commit guix-data-service commit #:system system - #:target target)))) + #:target target + #:guix-data-service-build-server-id + guix-data-service-build-server-id)))) (log-msg 'INFO "submitting package builds for " system "=>" target " (" commit ")") @@ -271,6 +279,12 @@ (alist-cons 'guix-data-service arg (alist-delete 'guix-data-service result)))) + (option '("guix-data-service-build-server-id") #t #f + (lambda (opt name arg result) + (alist-cons 'guix-data-service-build-server-id + arg + (alist-delete 'guix-data-service-build-server-id + result)))) (option '("threads") #t #f (lambda (opt name arg result) (alist-cons 'threads @@ -357,11 +371,14 @@ (let ((arguments (or (assq-ref opts 'arguments) '()))) (unless (null? arguments) (for-each (lambda (commit) - (submit-builds-for-revision (assq-ref opts 'coordinator) - guix-data-service - commit - systems-and-targets - priority-for-derivation)) + (submit-builds-for-revision + (assq-ref opts 'coordinator) + guix-data-service + commit + systems-and-targets + priority-for-derivation + #:guix-data-service-build-server-id + (assq-ref opts 'guix-data-service-build-server-id))) arguments) (exit 0))) @@ -391,7 +408,9 @@ systems-and-targets priority-for-derivation #:submit-builds-for-channel-instances? - (assq-ref opts 'fetch-channel-instance-derivations)) + (assq-ref opts 'fetch-channel-instance-derivations) + #:guix-data-service-build-server-id + (assq-ref opts 'guix-data-service-build-server-id)) (record-revision-as-processed processed-commits-file commit))))) (while #t |