branch master updated: remote: Discover server log-port and publish-port without Avahi.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 3870197  remote: Discover server log-port and publish-port without 
Avahi.
3870197 is described below

commit 38701970eba98319b147fb5e962ecd5391a1d51d
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Feb 10 17:37:37 2021 +0100

    remote: Discover server log-port and publish-port without Avahi.
    
    * src/cuirass/remote.scm (zmq-server-info, zmq-worker-request-info-message):
    New procedures.
    * src/cuirass/remote-server.scm (%log-port, %publish-port): New parameters.
    (read-worker-exp): Handle 'worker-request-info message.
    (remote-server): Set the new parameters.
    * src/cuirass/remote-worker.scm (start-worker): Rename "server" argument. 
Send
    a 'worker-request-info message to discover the server log port and publish
    port.
    (remote-worker): Adapt it.
---
 src/cuirass/remote-server.scm | 11 +++++
 src/cuirass/remote-worker.scm | 93 +++++++++++++++++++++++++++----------------
 src/cuirass/remote.scm        | 17 +++++++-
 3 files changed, 84 insertions(+), 37 deletions(-)

diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 4bf22fa..f01e64f 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -77,6 +77,12 @@
 (define %public-key
   (make-parameter #f))
 
+(define %log-port
+  (make-parameter #f))
+
+(define %publish-port
+  (make-parameter #f))
+
 (define service-name
   "Cuirass remote server")
 
@@ -185,6 +191,9 @@ be used to reply to the worker."
   (match (zmq-read-message exp)
     (('worker-ready worker)
      (update-worker! worker))
+    (('worker-request-info)
+     (reply-worker
+      (zmq-server-info (%log-port) (%publish-port))))
     (('worker-request-work name)
      (let ((build (pop-build name)))
        (if build
@@ -437,6 +446,8 @@ exiting."
              (assoc-ref opts 'private-key-file))))
 
       (parameterize ((%cache-directory cache)
+                     (%log-port log-port)
+                     (%publish-port publish-port)
                      (%trigger-substitute-url trigger-substitute-url)
                      (%package-database database)
                      (%public-key public-key)
diff --git a/src/cuirass/remote-worker.scm b/src/cuirass/remote-worker.scm
index 339e0ec..36e9d46 100644
--- a/src/cuirass/remote-worker.scm
+++ b/src/cuirass/remote-worker.scm
@@ -64,9 +64,9 @@ Start a remote build worker.\n"))
   (display (G_ "
   -p, --publish-port=PORT   publish substitutes on PORT"))
   (display (G_ "
-  -S, --server=SERVER       connect to SERVER"))
+  -s, --server=SERVER       connect to SERVER"))
   (display (G_ "
-  -s, --systems=SYSTEMS     list of supported SYSTEMS"))
+  -S, --systems=SYSTEMS     list of supported SYSTEMS"))
   (display (G_ "
       --public-key=FILE     use FILE as the public key for signatures"))
   (display (G_ "
@@ -230,7 +230,7 @@ command.  REPLY is a procedure that can be used to reply to 
this server."
          (sleep 60)
          (loop))))))
 
-(define (start-worker worker server)
+(define (start-worker worker serv)
   "Start a worker thread named NAME, reading commands from the DEALER socket
 and executing them.  The worker can reply on the same socket."
   (define (reply socket)
@@ -253,25 +253,47 @@ and executing them.  The worker can reply on the same 
socket."
        (list (make-bytevector 0)
              (string->bv (zmq-worker-request-work-message name))))))
 
+  (define (request-info socket)
+    (zmq-send-msg-parts-bytevector
+     socket
+     (list (make-bytevector 0)
+           (string->bv (zmq-worker-request-info-message)))))
+
+  (define (read-server-info socket serv)
+    (request-info socket)
+    (match (zmq-get-msg-parts-bytevector socket '())
+      ((empty info)
+       (match (zmq-read-message (bv->string info))
+         (('server-info
+           ('log-port log-port)
+           ('publish-port publish-port))
+          (let ((url (publish-url (server-address serv)
+                                  publish-port)))
+            (server
+             (inherit serv)
+             (log-port log-port)
+             (publish-url url))))))))
+
   (match (primitive-fork)
     (0
      (set-thread-name (worker-name worker))
      (let* ((socket (zmq-dealer-socket))
-            (address (server-address server))
-            (port (server-port server))
+            (address (server-address serv))
+            (port (server-port serv))
             (endpoint (zmq-backend-endpoint address port)))
        (zmq-connect socket endpoint)
        (ready socket)
-       (worker-ping worker server)
-       (let loop ()
-         (request-work socket)
-         (match (zmq-get-msg-parts-bytevector socket '())
-           ((empty command)
-            (run-command (bv->string command) server
-                         #:reply (reply socket)
-                         #:worker worker)))
-         (sleep 10)
-         (loop))))
+       (worker-ping worker serv)
+       (let ((server* (read-server-info socket serv)))
+         (let loop ()
+           (request-work socket)
+           (match (zmq-get-msg-parts-bytevector socket '())
+             ((empty command)
+              (run-command (bv->string command) server*
+                           #:reply (reply socket)
+                           #:worker worker)))
+           (sleep 10)
+           (loop)))))
     (pid pid)))
 
 
@@ -286,10 +308,6 @@ and executing them.  The worker can reply on the same 
socket."
 (define %worker-pids
   (make-atomic-box '()))
 
-(define (load-server file)
-  (let ((user-module (make-user-module '((cuirass remote)))))
-    (load* file user-module)))
-
 (define (add-to-worker-pids! pid)
   (let ((pids (atomic-box-ref %worker-pids)))
     (atomic-box-set! %worker-pids (cons pid pids))))
@@ -328,7 +346,7 @@ exiting."
            (address (assoc-ref opts 'address))
            (workers (assoc-ref opts 'workers))
            (publish-port (assoc-ref opts 'publish-port))
-           (server (assoc-ref opts 'server))
+           (server-address (assoc-ref opts 'server))
            (systems (assoc-ref opts 'systems))
            (public-key
             (read-file-sexp
@@ -345,23 +363,28 @@ exiting."
                        #:public-key public-key
                        #:private-key private-key))
 
-      (when (and server (not address))
+      (when (and server-address (not address))
         (leave (G_ "Address must be set when server is provided.~%")))
 
-      (if server
-          (let ((server (load-server server)))
-            (for-each
-             (lambda (n)
-               (let ((publish-url (local-publish-url address)))
-                 (add-to-worker-pids!
-                  (start-worker (worker
-                                 (name (generate-worker-name))
-                                 (address address)
-                                 (machine (gethostname))
-                                 (publish-url publish-url)
-                                 (systems systems))
-                                server))))
-             (iota workers)))
+      (if server-address
+          (for-each
+           (lambda (n)
+             (let* ((publish-url (local-publish-url address))
+                    (worker (worker
+                             (name (generate-worker-name))
+                             (address address)
+                             (machine (gethostname))
+                             (publish-url publish-url)
+                             (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)
              (case action
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 895c99c..c5a27ea 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -80,6 +80,8 @@
             zmq-worker-ping
             zmq-worker-ready-message
             zmq-worker-request-work-message
+            zmq-worker-request-info-message
+            zmq-server-info
             zmq-read-message
 
             remote-server-service-type))
@@ -172,8 +174,10 @@
   server?
   (address        server-address)
   (port           server-port)
-  (log-port       server-log-port)
-  (publish-url    server-publish-url))
+  (log-port       server-log-port
+                  (default #f))
+  (publish-url    server-publish-url
+                  (default #f)))
 
 (define (publish-url address port)
   "Return the publish url at ADDRESS and PORT."
@@ -447,5 +451,14 @@ retries a call to PROC."
   "Return a message that indicates that WORKER is requesting work."
   (format #f "~s" `(worker-request-work ,name)))
 
+(define (zmq-worker-request-info-message)
+  "Return a message requesting server information."
+  (format #f "~s" '(worker-request-info)))
+
+(define (zmq-server-info log-port publish-port)
+  "Return a message containing server information."
+  (format #f "~s" `(server-info (log-port ,log-port)
+                                (publish-port ,publish-port))))
+
 (define remote-server-service-type
   "_remote-server._tcp")