[no subject]

[Ludovic Courtès]

branch: master
commit bb659b02ad7ae41313e9ee8590f85ccb552b630b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Aug 22 16:27:02 2023 +0200

    remote-worker: Browse Avahi services in a separate thread.
    
    Fixes a regression introduced in
    de8586080e04677cbe34c58f34715757ac61eea3, whereby 'cuirass
    remote-worker' would block forever in 'avahi-browse-service-thread'
    because nobody would get the message on MANAGEMENT-CHANNEL.
    
    * src/cuirass/scripts/remote-worker.scm (cuirass-remote-worker): Wrap
    'avahi-browse-service-thread' in 'call-with-new-thread'.
---
 src/cuirass/scripts/remote-worker.scm | 46 ++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 20 deletions(-)

diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index cbd991c..96a0b4a 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -57,7 +57,7 @@
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 match)
-  #:use-module ((ice-9 threads) #:select (current-processor-count))
+  #:use-module (ice-9 threads)
   #:export (cuirass-remote-worker))
 
 ;; Indicate if the process has to be stopped.
@@ -469,25 +469,31 @@ exiting."
 
         (let ((management-channel (make-channel)))
           (unless server-address
-            (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)
-                         workers)
-               (case action
-                 ((new-service)
-                  (put-message management-channel
-                               `(start-workers ,workers
-                                               ,(avahi-service->server service)
-                                               ,(avahi-service-local-address
-                                                 service)))
-                  (atomic-box-set! %stop-process? #t))))
-             #:ignore-local? #f
-             #:types (list remote-server-service-type)
-             #:stop-loop? (lambda ()
-                            (atomic-box-ref %stop-process?))))
+            (log-info (G_ "enabling server discovery with Avahi, type '~a'~%")
+                      remote-server-service-type)
+            (call-with-new-thread
+             (lambda ()
+               ;; XXX: Contrary to what one might think, this procedure does
+               ;; *not* spawn a new thread.
+               (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)
+                            workers)
+                  (case action
+                    ((new-service)
+                     (put-message management-channel
+                                  `(start-workers ,workers
+                                                  ,(avahi-service->server 
service)
+                                                  ,(avahi-service-local-address
+                                                    service)))
+                     (atomic-box-set! %stop-process? #t))))
+                #:ignore-local? #f
+                #:types (list remote-server-service-type)
+                #:stop-loop? (lambda ()
+                               (atomic-box-ref %stop-process?))))))
 
           (run-fibers
            (lambda ()