From 3792cc15e797abb639bf2f23bcab249ddec029ff Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 18 Sep 2020 11:39:49 +0100 Subject: Make the Guix Data Service to queue builds from configurable --- ...rdinator-queue-builds-from-guix-data-service.in | 66 ++++++++++++++-------- 1 file 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)))) -- cgit v1.2.3