diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-12-30 23:12:11 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-12-30 23:12:11 +0000 |
| commit | c5b0372fd99c609da1d018bc4ee092428ec5605b (patch) | |
| tree | a658a32cc3138d372acee299e79aa32b31a7f9db | |
| parent | ba8f2c11a2489d74212b65e5e167a26e66642a02 (diff) | |
| download | build-coordinator-c5b0372fd99c609da1d018bc4ee092428ec5605b.tar build-coordinator-c5b0372fd99c609da1d018bc4ee092428ec5605b.tar.gz | |
Avoid fetching builds when they won't start immediately
| -rw-r--r-- | guix-build-coordinator/agent.scm | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index f0de281..d5c2031 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -147,19 +147,20 @@ #:log (build-log-procedure lgr build-id)))))))) + (define (current-max-builds) + (let ((current-load (get-load-average #:period 1))) + (if (>= current-load max-1min-load-average) + 1 + max-parallel-builds))) + (add-handler! lgr port-log) (open-log! lgr) (log-msg lgr 'INFO "starting agent " uuid) (log-msg lgr 'INFO "connecting to coordinator " coordinator-uri) (let-values (((process-job-with-queue count-jobs list-jobs) - (create-work-queue - (lambda () - (let ((current-load (get-load-average #:period 1))) - (if (>= current-load max-1min-load-average) - 1 - max-parallel-builds))) - process-job))) + (create-work-queue current-max-builds + process-job))) (let ((details (submit-status coordinator-uri uuid password 'idle #:log (build-log-procedure lgr @@ -170,7 +171,7 @@ (vector->list (assoc-ref details "builds"))) (while #t - (if (< (count-jobs) max-parallel-builds) + (if (< (count-jobs) (current-max-builds)) (let* ((queued-build-ids (map (lambda (job-args) (assoc-ref (car job-args) "uuid")) |