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.

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))))))