diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-12-30 23:04:01 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-12-30 23:04:01 +0000 |
| commit | ba8f2c11a2489d74212b65e5e167a26e66642a02 (patch) | |
| tree | f41d2a8524b69bfe8f20369be5ef53c156d5f4fb /guix-build-coordinator/agent.scm | |
| parent | c8a66c3c4d64a81d24e42d8881f5f4f4303a3a28 (diff) | |
| download | build-coordinator-ba8f2c11a2489d74212b65e5e167a26e66642a02.tar build-coordinator-ba8f2c11a2489d74212b65e5e167a26e66642a02.tar.gz | |
Only run one build when the load is high
This should avoid behaviour that I've observed where sometimes no builds are
running, because the load is high.
Diffstat (limited to 'guix-build-coordinator/agent.scm')
| -rw-r--r-- | guix-build-coordinator/agent.scm | 19 |
1 files changed, 7 insertions, 12 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 72ccb9e..f0de281 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -91,15 +91,6 @@ (write-textfile metrics-registry metrics-file))) - (define (wait-for-low-load build-id) - (let ((current-load (get-load-average #:period 1))) - (when (>= current-load max-1min-load-average) - (log-msg lgr 'INFO - build-id - ": holding build start due to high load (" current-load ")") - (sleep 30) - (wait-for-low-load build-id)))) - (define (process-job build) (let ((build-id (assoc-ref build "uuid")) (derivation-name (assoc-ref build "derivation-name"))) @@ -123,7 +114,6 @@ (write-metrics) (if (eq? (assq-ref pre-build-status 'result) 'success) (begin - (wait-for-low-load build-id) (log-msg lgr 'INFO build-id ": setup successful, building: " @@ -163,8 +153,13 @@ (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 max-parallel-builds - process-job))) + (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))) (let ((details (submit-status coordinator-uri uuid password 'idle #:log (build-log-procedure lgr |