diff options
author | Christopher Baines <mail@cbaines.net> | 2021-02-06 10:35:24 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-02-06 10:35:24 +0000 |
commit | b44a9f373c42b58cadcb6791d85960dbee0bb98b (patch) | |
tree | 787955e3cf83f989940f3118123c935bfcd56134 | |
parent | 6341d714dd28e7f09773cd28b5801c71d11318b1 (diff) | |
download | build-coordinator-b44a9f373c42b58cadcb6791d85960dbee0bb98b.tar build-coordinator-b44a9f373c42b58cadcb6791d85960dbee0bb98b.tar.gz |
Trigger build allocations when necessary for deferred builds
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 25 | ||||
-rw-r--r-- | guix-build-coordinator/datastore.scm | 1 | ||||
-rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 39 |
3 files changed, 65 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)) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index c977ff0..24b9bbb 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -53,6 +53,7 @@ (re-export datastore-count-builds-for-derivation) (re-export datastore-list-processed-builds) (re-export datastore-list-unprocessed-builds) +(re-export datastore-find-first-unallocated-deferred-build) (re-export datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds) (re-export datastore-insert-unprocessed-hook-event) (re-export datastore-count-unprocessed-hook-events) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index d7def51..72b91ae 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -67,6 +67,7 @@ datastore-replace-agent-tags datastore-list-processed-builds datastore-list-unprocessed-builds + datastore-find-first-unallocated-deferred-build datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds datastore-insert-unprocessed-hook-event datastore-count-unprocessed-hook-events @@ -1869,6 +1870,44 @@ ORDER BY priority DESC" builds))))) +(define-method (datastore-find-first-unallocated-deferred-build + (datastore <sqlite-datastore>)) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT uuid, derivation_name, priority, created_at, deferred_until +FROM builds +WHERE processed = 0 + AND canceled = 0 + AND deferred_until IS NOT NULL + AND uuid NOT IN (SELECT build_id FROM build_allocation_plan) +ORDER BY deferred_until ASC +LIMIT 1" + #:cache? #t))) + + (let ((result + (match (sqlite-step statement) + (#(uuid derivation_name priority created_at deferred_until) + `((uuid . ,uuid) + (derivation-name . ,derivation_name) + (priority . ,priority) + (created-at . ,(if (string? created_at) + (string->date created_at + "~Y-~m-~d ~H:~M:~S") + #f)) + (deferred-until . ,(if (string? deferred_until) + (string->date deferred_until + "~Y-~m-~d ~H:~M:~S") + #f)))) + (#f #f)))) + (sqlite-reset statement) + + result))))) + (define-method (datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds (datastore <sqlite-datastore>) created-after) |