[no subject]

[Ludovic Courtès]

branch: wip-actors
commit f6ba99d966e8fcf608b4a033b04905520bd70bd3
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Sep 1 23:22:27 2023 +0200

    register: Listen for commands on a "bridge" socket.
    
    * src/cuirass/base.scm (%bridge-socket-file-name): New variable.
    * src/cuirass/scripts/register.scm (open-bridge-socket, bridge)
    (spawn-bridge): New procedures.
    (cuirass-register): Call 'spawn-bridge'.
---
 src/cuirass/base.scm             |  5 +++
 src/cuirass/scripts/register.scm | 73 ++++++++++++++++++++++++++++++++++++++--
 2 files changed, 76 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 75d704f..c7633e8 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -82,6 +82,7 @@
             latest-checkouts
 
             ;; Parameters.
+            %bridge-socket-file-name
             %package-cachedir
             %gc-root-directory
             %gc-root-ttl
@@ -224,6 +225,10 @@ context."
   (make-parameter (or (getenv "CUIRASS_RUN_STATE_DIRECTORY")
                       (string-append (%cuirass-state-directory) "/run"))))
 
+(define %bridge-socket-file-name
+  (make-parameter (string-append (%cuirass-run-state-directory)
+                                 "/cuirass/bridge")))
+
 (define (evaluation-log-file eval-id)
   "Return the name of the file containing the output of evaluation EVAL-ID."
   (string-append (%cuirass-state-directory)
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index 0373e5f..1dec7d6 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -35,6 +35,7 @@
   #:use-module (fibers)
   #:use-module (fibers channels)
   #:use-module (srfi srfi-19)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 getopt-long)
   #:export (cuirass-register))
@@ -76,6 +77,69 @@
     (help           (single-char #\h) (value #f))))
 
 
+;;;
+;;; Bridge with other Cuirass processes.
+;;;
+
+;; Other processes such as 'cuirass web' may need to notify 'cuirass register'
+;; of events--e.g., configuration changes.  Ideally, they'd transparently talk
+;; to the relevant actor, whether it's process-local or not, but we're not
+;; there yet (hi, Goblins!).  The "bridge" below works around this
+;; shortcoming: it takes commands over a Unix-domain socket and forwards them
+;; to the relevant actor.
+
+(define (open-bridge-socket)
+  (let ((sock (socket AF_UNIX
+                      (logior SOCK_STREAM SOCK_NONBLOCK SOCK_CLOEXEC)
+                      0))
+        (file (%bridge-socket-file-name)))
+    (log-info "opening bridge socket at '~a'" file)
+    (mkdir-p (dirname file))
+    (chmod (dirname file) #o700)
+    (false-if-exception (delete-file file))
+    (bind sock AF_UNIX file)
+    (listen sock 2)
+    sock))
+
+(define (bridge channel                           ;currently unused
+                socket registry)
+  (define (serve-client socket)
+    (let loop ((count 0))
+      (define command
+        (false-if-exception (read socket)))
+
+      (if (eof-object? command)
+          (begin
+            (close-port socket)
+            (log-info "terminating bridge server after ~a commands"
+                      count))
+          (begin
+            (log-debug "bridge received command: ~s" command)
+
+            ;; Note: The protocol is bare-bones and unversioned; the 'cuirass'
+            ;; processes are meant to be upgraded in lockstep.
+            (match command
+              (`(register-jobset ,name)
+               (register-jobset registry (db-get-specification name)))
+              (_
+               #f))
+            (loop (+ 1 count))))))
+
+  (lambda ()
+    (let loop ()
+      (match (accept socket (logior SOCK_NONBLOCK SOCK_CLOEXEC))
+        ((connection . peer)
+         (spawn-fiber (lambda ()
+                        (log-info "bridge accepted connection")
+                        (serve-client connection)))
+         (loop))))))
+
+(define (spawn-bridge socket registry)
+  (let ((channel (make-channel)))
+    (spawn-fiber (bridge channel socket registry))
+    channel))
+
+
 ;;;
 ;;; Entry point.
 ;;;
@@ -147,8 +211,13 @@
                          (restart-builds))))
 
                      ;; Spawn one monitoring actor for each jobset.
-                     (spawn-jobset-registry update-service
-                                            #:polling-period interval)
+                     (let ((registry (spawn-jobset-registry
+                                      update-service
+                                      #:polling-period interval)))
+                       ;; Spawn the bridge through which other 'cuirass'
+                       ;; processes, such as 'cuirass web', may talk to the
+                       ;; registry.
+                       (spawn-bridge (open-bridge-socket) registry))
 
                      (spawn-fiber
                       (essential-task