aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-09-18 11:39:49 +0100
committerChristopher Baines <mail@cbaines.net>2020-09-18 11:39:49 +0100
commit3792cc15e797abb639bf2f23bcab249ddec029ff (patch)
tree5103a8e39dab09e61f3f48cc174440cbab19e415 /scripts
parentfc0b533002f6d76e817e545fbc996b5af79bb9ee (diff)
downloadbuild-coordinator-3792cc15e797abb639bf2f23bcab249ddec029ff.tar
build-coordinator-3792cc15e797abb639bf2f23bcab249ddec029ff.tar.gz
Make the Guix Data Service to queue builds from configurable
Diffstat (limited to 'scripts')
-rw-r--r--scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in66
1 files changed, 44 insertions, 22 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 bb8627f..d20d10b 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
@@ -34,8 +34,6 @@
(guix-build-coordinator utils)
(guix-build-coordinator client-communication))
-(define %guix-data-service-host "data.guix.gnu.org")
-
(define %processed-commits-file "processed-revisions")
;; This gets populated from a file on startup
@@ -59,11 +57,12 @@
(define processed-derivations-hash
(make-hash-table 102400))
-(define* (guix-data-service-request path #:optional (query-parameters '()))
+(define* (guix-data-service-request guix-data-service
+ path
+ #:optional (query-parameters '()))
(define uri
(string->uri (string-append
- "https://"
- %guix-data-service-host
+ guix-data-service
path
(if (null? query-parameters)
""
@@ -83,8 +82,9 @@
#:times 6
#:delay 30))
-(define (unseen-revisions)
- (let ((data (guix-data-service-request "/repository/1/branch/master.json")))
+(define (unseen-revisions guix-data-service)
+ (let ((data (guix-data-service-request guix-data-service
+ "/repository/1/branch/master.json")))
(filter-map (lambda (entry)
(let ((commit (assoc-ref entry "commit-hash")))
(and (not (hash-ref processed-commits-hash
@@ -101,8 +101,11 @@
(hash-set! processed-commits-hash commit #t))
-(define (channel-instance-derivations-for-commit commit system)
+(define (channel-instance-derivations-for-commit guix-data-service
+ commit
+ system)
(let ((data (guix-data-service-request
+ guix-data-service
(string-append "/revision/" commit "/channel-instances.json"))))
(filter-map (lambda (entry)
(if (string=? system
@@ -112,8 +115,11 @@
(vector->list
(assoc-ref data "channel_instances")))))
-(define* (package-derivations-for-commit commit #:key system target)
+(define* (package-derivations-for-commit guix-data-service
+ commit
+ #:key system target)
(let ((data (guix-data-service-request
+ guix-data-service
(string-append "/revision/" commit "/package-derivations.json")
`((system . ,system)
(target . ,target)
@@ -131,15 +137,14 @@
#t))
derivations))
-(define* (submit-build coordinator derivation #:key (priority 0))
+(define* (submit-build coordinator guix-data-service derivation #:key (priority 0))
(retry-on-error
(lambda ()
(let ((response
(send-submit-build-request
coordinator
derivation
- (list
- (string-append "https://" %guix-data-service-host))
+ (list guix-data-service)
#f
priority
#t
@@ -158,24 +163,33 @@
#:times 30
#:delay 30))
-(define (submit-builds-for-revision coordinator commit systems-and-targets)
+(define (submit-builds-for-revision coordinator
+ guix-data-service
+ commit
+ systems-and-targets)
(simple-format #t "looking at revision ~A\n" commit)
(for-each
(match-lambda
((system . target)
(for-each (lambda (derivation)
- (submit-build coordinator derivation #:priority 1000))
- (channel-instance-derivations-for-commit commit system))
+ (submit-build coordinator
+ guix-data-service
+ derivation
+ #:priority 1000))
+ (channel-instance-derivations-for-commit guix-data-service
+ commit
+ system))
(let ((unprocessed-package-derivations
(filter (lambda (derivation)
(not (hash-ref processed-derivations-hash derivation)))
- (package-derivations-for-commit commit
+ (package-derivations-for-commit guix-data-service
+ commit
#:system system
#:target target))))
(for-each (lambda (derivation)
- (submit-build coordinator derivation))
+ (submit-build coordinator guix-data-service derivation))
unprocessed-package-derivations)
(record-derivations-as-processed unprocessed-package-derivations))))
systems-and-targets))
@@ -199,11 +213,16 @@
(lambda (opt name arg result)
(alist-cons 'coordinator
arg
- (alist-delete 'coordinator result))))))
-
+ (alist-delete 'coordinator result))))
+ (option '("guix-data-service") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'guix-data-service
+ arg
+ (alist-delete 'guix-data-service result))))))
(define %option-defaults
- '((coordinator . "http://127.0.0.1:8746")))
+ '((coordinator . "http://127.0.0.1:8746")
+ (guix-data-service . "https://data.guix.gnu.org")))
(define (parse-options options defaults args)
(args-fold
@@ -224,7 +243,9 @@
%option-defaults
(cdr (program-arguments))))
(systems-and-targets
- (assq-ref opts 'systems-and-targets)))
+ (assq-ref opts 'systems-and-targets))
+ (guix-data-service
+ (assq-ref opts 'guix-data-service)))
(unless systems-and-targets
(simple-format (current-error-port)
@@ -234,10 +255,11 @@
(while #t
(for-each (lambda (commit)
(submit-builds-for-revision (assq-ref opts 'coordinator)
+ guix-data-service
commit
systems-and-targets)
(record-revision-as-processed commit))
- (unseen-revisions))
+ (unseen-revisions guix-data-service))
(simple-format #t "waiting before checking for new revisions...\n")
(sleep 60))))