[no subject]

[Ludovic Courtès]

branch: master
commit b498ff8f75fef31d29d07b682b8f24fca04b7e3e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 29 11:19:47 2023 +0200

    remote: Add more logging.
    
    * src/cuirass/scripts/remote-server.scm (read-worker-exp)[update-worker!]:
    Add 'log-debug' call.
    * src/cuirass/scripts/remote-worker.scm (start-worker): Add 'log-info'
    calls.
    (cuirass-remote-worker): Likewise.
    * tests/remote.scm (start-worker, start-server): Set 
'CUIRASS_LOGGING_LEVEL'.
---
 src/cuirass/scripts/remote-server.scm |  2 ++
 src/cuirass/scripts/remote-worker.scm | 48 +++++++++++++++++++++++------------
 tests/remote.scm                      |  2 ++
 3 files changed, 36 insertions(+), 16 deletions(-)

diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index 51ee069..38bac73 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -234,6 +234,8 @@ be used to reply to the worker."
     (let* ((worker* (worker
                      (inherit (sexp->worker base-worker))
                      (last-seen (current-time)))))
+      (log-debug (G_ "worker ~a is up and running")
+                 (worker-name worker*))
       (db-add-or-update-worker worker*)))
 
   (match (zmq-read-message
diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index 6bdb5c8..2a70398 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -1,6 +1,6 @@
 ;;; remote-worker.scm -- Remote build worker.
 ;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
-;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -374,9 +374,14 @@ and executing them.  The worker can reply on the same 
socket."
                 (port (server-port serv))
                 (endpoint (zmq-backend-endpoint address port)))
            (zmq-connect socket endpoint)
+           (log-info (G_ "worker ~a (PID ~a) connected to ~a")
+                     (worker-name wrk) (getpid) endpoint)
            (let* ((srv-info (read-server-info socket))
                   (server (server-info->server srv-info serv))
                   (worker (server-info->worker srv-info wrk)))
+             (log-info (G_ "server publish URL: ~a; server log port: ~a")
+                       (server-publish-url server)
+                       (server-log-port server))
              (ready socket worker)
              (worker-ping worker server)
              (let loop ()
@@ -427,6 +432,8 @@ exiting."
 
         (for-each (lambda (pid)
                     (when pid
+                      (log-info (G_ "terminating worker sub-process ~a")
+                                pid)
                       (kill pid SIGKILL)
                       (waitpid pid)))
                   (cons publish-pid worker-pids))
@@ -470,23 +477,32 @@ exiting."
                          #:private-key private-key))
 
         (if server-address
-            (for-each
-             (lambda (n)
-               (let* ((worker (worker
-                               (name (generate-worker-name))
-                               (machine (gethostname))
-                               (systems systems)))
-                      (addr (string-split server-address #\:))
-                      (server (match addr
-                                ((address port)
-                                 (server
-                                  (address address)
-                                  (port (string->number port)))))))
-                 (add-to-worker-pids!
-                  (start-worker worker server))))
-             (iota workers))
+            (begin
+              (log-info (N_ "creating ~a worker for build server at ~a"
+                            "creating ~a workers for build server at ~a"
+                            workers)
+                        workers server-address)
+              (for-each
+               (lambda (n)
+                 (let* ((worker (worker
+                                 (name (generate-worker-name))
+                                 (machine (gethostname))
+                                 (systems systems)))
+                        (addr (string-split server-address #\:))
+                        (server (match addr
+                                  ((address port)
+                                   (server
+                                    (address address)
+                                    (port (string->number port)))))))
+                   (add-to-worker-pids!
+                    (start-worker worker server))))
+               (iota workers)))
             (avahi-browse-service-thread
              (lambda (action service)
+               (log-info (N_ "discovered build server at ~a, creating ~a 
worker"
+                             "discovered build server at ~a, creating ~a 
workers"
+                             workers)
+                         (avahi-service-local-address service))
                (case action
                  ((new-service)
                   (for-each
diff --git a/tests/remote.scm b/tests/remote.scm
index b1da03f..94d9ccd 100644
--- a/tests/remote.scm
+++ b/tests/remote.scm
@@ -53,6 +53,7 @@
 
 (define (start-worker)
   (setenv "REQUEST_PERIOD" "1")
+  (setenv "CUIRASS_LOGGING_LEVEL" "debug")
   (worker (spawn "cuirass"
                  '("cuirass" "remote-worker"
                    "--server=127.0.0.1:5555"
@@ -67,6 +68,7 @@
 
 (define (start-server)
   (mkdir-p "tests/cache")
+  (setenv "CUIRASS_LOGGING_LEVEL" "debug")
   (server (spawn "cuirass"
                  (list "cuirass" "remote-server"
                        (string-append "--database=" (%package-database))