From b44a9f373c42b58cadcb6791d85960dbee0bb98b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 6 Feb 2021 10:35:24 +0000 Subject: Trigger build allocations when necessary for deferred builds --- guix-build-coordinator/coordinator.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'guix-build-coordinator/coordinator.scm') diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 06b5a40..b345498 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -226,6 +226,8 @@ (datastore-spawn-fibers (build-coordinator-datastore build-coordinator)) + (spawn-fiber-to-watch-for-deferred-builds build-coordinator) + ;; Start the agent messaging server (match (uri-scheme agent-communication-uri) ('http @@ -496,6 +498,29 @@ trigger-build-allocation) +(define (spawn-fiber-to-watch-for-deferred-builds coordinator) + (spawn-fiber + (lambda () + (while #t + (sleep 60) ; 1 minute + (with-exception-handler + (lambda (exn) + (simple-format (current-error-port) + "exception when watching for deferred builds: ~A\n" + exn)) + (lambda () + (let ((first-deferred-build + (datastore-find-first-unallocated-deferred-build + (build-coordinator-datastore coordinator)))) + (when (and first-deferred-build + (time<=? (date->time-utc + (assq-ref first-deferred-build 'deferred-until)) + (current-time))) + (simple-format #t "guix-build-coordinator: triggering build allocation for deferred build: ~A\n" (assq-ref first-deferred-build 'uuid)) + (trigger-build-allocation coordinator)))) + #:unwind? #t))) + #:parallel? #t)) + (define (start-hook-processing-threads build-coordinator) (define wait-timeout-seconds (* 60 5)) -- cgit v1.2.3