From 10cfe37bd23848fb7901371b676358d711234e8c Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 16 Sep 2020 20:28:25 +0100 Subject: Refactor the fibers server starting code More clearly split out the things that need to happen prior to run-fibers, and the things that can happen after. --- scripts/guix-build-coordinator.in | 71 +++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index c7fbb1a..71111c0 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -467,51 +467,50 @@ processed?: ~A (parameterize ((%show-error-details (assoc-ref opts 'show-error-details))) - (let* ((agent-communication-thunk - (let ((agent-communication-uri - (assq-ref opts 'agent-communication))) - (match (uri-scheme agent-communication-uri) - ('http - (let ((host (uri-host agent-communication-uri)) - (port (uri-port agent-communication-uri)) - (chunked-request-channel - ;; There are fibers issues when trying to read the - ;; chunked requests - (make-worker-thread-channel (const '()) - #:parallelism 8))) - (lambda () - (simple-format #t "listening on ~A:~A\n" - host port) + ;; Create some worker thread channels, which need to be created prior + ;; to run-fibers being called. + (let ((chunked-request-channel + ;; There are fibers issues when trying to read the chunked + ;; requests, so do this in dedicated threads. + (make-worker-thread-channel (const '()) + #:parallelism 8)) + (substitutes-channel + (make-worker-thread-channel (const '()) + #:parallelism 2))) + + (start-hook-processing-threads build-coordinator) + (trigger-build-allocation build-coordinator) + + (let ((finished? (make-condition))) + (call-with-sigint + (lambda () + (run-fibers + (lambda () + ;; Start the agent messaging server + (let ((agent-communication-uri + (assq-ref opts 'agent-communication))) + (match (uri-scheme agent-communication-uri) + ('http + (let ((host (uri-host agent-communication-uri)) + (port (uri-port agent-communication-uri))) (http-agent-messaging-start-server port host (assq-ref opts 'secret-key-base) build-coordinator - chunked-request-channel))))))) - (client-communication-thunk - (let ((client-communication-uri - (assq-ref opts 'client-communication)) - (substitutes-channel - (make-worker-thread-channel (const '()) - #:parallelism 2))) - (lambda () + chunked-request-channel) + (simple-format #t "listening on ~A:~A\n" + host port))))) + + ;; Start the client messaging server + (let ((client-communication-uri + (assq-ref opts 'client-communication))) (start-client-request-server (assq-ref opts 'secret-key-base) (uri-host client-communication-uri) (uri-port client-communication-uri) build-coordinator - substitutes-channel))))) - - (start-hook-processing-threads build-coordinator) - (trigger-build-allocation build-coordinator) - - (let ((finished? (make-condition))) - (call-with-sigint - (lambda () - (run-fibers - (lambda () - (agent-communication-thunk) - (client-communication-thunk) + substitutes-channel)) (wait finished?)))) - finished?))))))) + finished?)))))))))) -- cgit v1.2.3