From fadb1cf50eb51cf8c9e06bbcc12f8583cfe0cc07 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 16 Sep 2020 21:00:41 +0100 Subject: Create a run-coordinator-service procedure This is moving in the direction of not having to use the script to start the service. I think for a Guix service definition, being able to specify some Guile code directly will be better. --- guix-build-coordinator/coordinator.scm | 64 ++++++++++++++++++++++++++++++++++ scripts/guix-build-coordinator.in | 60 +++++-------------------------- 2 files changed, 72 insertions(+), 52 deletions(-) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index a38045b..8d15fc7 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -27,8 +27,11 @@ #:use-module (ice-9 atomic) #:use-module (ice-9 threads) #:use-module (ice-9 exceptions) + #:use-module (web uri) #:use-module (gcrypt random) + #:use-module (fibers) #:use-module (fibers channels) + #:use-module (fibers conditions) #:use-module (prometheus) #:use-module (guix derivations) #:use-module (guix build utils) @@ -36,13 +39,18 @@ #:use-module (guix-build-coordinator config) #:use-module (guix-build-coordinator datastore) #:use-module (guix-build-coordinator build-allocator) + #:use-module (guix-build-coordinator agent-messaging http) + #:use-module (guix-build-coordinator client-communication) #:export (make-build-coordinator build-coordinator-datastore build-coordinator-hooks build-coordinator-metrics-registry build-coordinator-allocation-strategy + %default-agent-uri + %default-client-uri perform-coordinator-service-startup + run-coordinator-service submit-build new-agent @@ -104,6 +112,62 @@ (when trigger-build-allocation? (trigger-build-allocation build-coordinator))) +(define %default-agent-uri (string->uri "http://0.0.0.0:8745")) +(define %default-client-uri (string->uri "http://127.0.0.1:8746")) + +(define* (run-coordinator-service build-coordinator + #:key + (update-datastore? #t) + (pid-file #f) + (agent-communication-uri %default-agent-uri) + (client-communication-uri %default-client-uri) + secret-key-base) + (perform-coordinator-service-startup + build-coordinator + #:update-datastore? update-datastore? + #:pid-file pid-file) + + ;; 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))) + + (let ((finished? (make-condition))) + (call-with-sigint + (lambda () + (run-fibers + (lambda () + ;; Start the agent messaging server + (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 + secret-key-base + build-coordinator + chunked-request-channel) + (simple-format #t "listening on ~A:~A\n" + host port)))) + + ;; Start the client messaging server + (start-client-request-server + secret-key-base + (uri-host client-communication-uri) + (uri-port client-communication-uri) + build-coordinator + substitutes-channel) + + (wait finished?)))) + finished?)))) + (define* (submit-build build-coordinator derivation-file #:key requested-uuid diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 59341cc..1c4f673 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -37,7 +37,6 @@ (guix-build-coordinator datastore) (guix-build-coordinator coordinator) (guix-build-coordinator build-allocator) - (guix-build-coordinator agent-messaging http) (guix-build-coordinator client-communication)) (define %base-options @@ -182,8 +181,8 @@ (define %service-option-defaults ;; Alist of default option values - `((agent-communication . "http://0.0.0.0:8745") - (client-communication . "http://127.0.0.1:8746") + `((agent-communication . ,%default-agent-uri) + (client-communication . ,%default-client-uri) (allocation-strategy . ,basic-build-allocation-strategy) (build-submitted-hook . ,default-build-submitted-hook) (build-started-hook . ,default-build-started-hook) @@ -420,55 +419,12 @@ processed?: ~A #:allocation-strategy (assq-ref opts 'allocation-strategy)))) - (perform-coordinator-service-startup - build-coordinator - #:update-datastore? (assoc-ref opts 'update-database) - #:pid-file (assq-ref opts 'pid-file)) - (parameterize ((%show-error-details (assoc-ref opts 'show-error-details))) - ;; 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))) - - (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) - (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)) - - (wait finished?)))) - finished?))))))) + (run-coordinator-service + build-coordinator + #:update-datastore? (assoc-ref opts 'update-database) + #:pid-file (assq-ref opts 'pid-file) + #:agent-communication-uri (assq-ref opts 'agent-communication) + #:client-communication-uri (assq-ref opts 'client-communication)))))) -- cgit v1.2.3