diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 38 |
1 files changed, 27 insertions, 11 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 9cd3f2d..189f148 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -24,6 +24,7 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:use-module (ice-9 ftw) #:use-module (ice-9 vlist) #:use-module (ice-9 match) @@ -62,6 +63,7 @@ build-coordinator-logger build-coordinator-listen-for-events + build-coordinator-get-state-id %known-hooks @@ -108,7 +110,9 @@ set-build-coordinator-allocator-thread!) (logger build-coordinator-logger) (events-channel build-coordinator-events-channel - set-build-coordinator-events-channel!)) + set-build-coordinator-events-channel!) + (get-state-id build-coordinator-get-state-id-proc + set-build-coordinator-get-state-id-proc!)) (define %known-hooks '(build-submitted @@ -123,17 +127,18 @@ (let* ((submission-channel (make-channel)) (listener-channels-box (make-atomic-box vlist-null)) - (state - (make-atomic-box - `((agents . ,(list->vector - (datastore-list-agents datastore)))))) - (buffer-size 10000) (event-buffer (make-vector buffer-size)) (current-state-id-and-event-buffer-index-box (make-atomic-box (cons 0 -1)))) + (define (get-state-id) + (match (atomic-box-ref + current-state-id-and-event-buffer-index-box) + ((current-state-id . event-buffer-index) + current-state-id))) + (define (spawn-fiber-for-listener callback after-state-id submission-channel @@ -248,7 +253,8 @@ #f (atomic-box-ref listener-channels-box))))))) - submission-channel)) + (values submission-channel + get-state-id))) (define (build-coordinator-send-event build-coordinator . args) (spawn-fiber @@ -272,6 +278,9 @@ ;; shouldn't exit until callback has finished being called (get-message listening-finished-channel))) +(define (build-coordinator-get-state-id build-coordinator) + ((build-coordinator-get-state-id-proc build-coordinator))) + (define* (make-build-coordinator #:key datastore hooks (metrics-registry (make-metrics-registry #:namespace @@ -424,10 +433,17 @@ (spawn-fiber-to-watch-for-deferred-builds build-coordinator) - (set-build-coordinator-events-channel! - build-coordinator - (make-events-channel - (build-coordinator-datastore build-coordinator))) + (let ((events-channel + get-state-id + (make-events-channel + (build-coordinator-datastore build-coordinator)))) + + (set-build-coordinator-events-channel! + build-coordinator + events-channel) + (set-build-coordinator-get-state-id-proc! + build-coordinator + get-state-id)) ;; Start the agent messaging server (match (uri-scheme agent-communication-uri) |