diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 25 |
1 files changed, 25 insertions, 0 deletions
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)) |