[no subject]

[Mathieu Othacehe]

branch: master
commit 830817aaac1516eb86092ee0204dee1017d71cec
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Aug 12 10:50:03 2021 +0200

    remote-server: Add a no-publish argument.
    
    * src/cuirass/scripts/remote-server.scm (%options, %default-options): Add a
    no-publish argument.
    (show-help): Document it.
    (cuirass-remote-server): Honor it.
    * src/cuirass/scripts/remote-worker.scm (start-worker): Do not call
    publish-url if the publish-port is false.
    * src/cuirass/remote.scm (avahi-service->server): Ditto.
    * doc/cuirass.texi (Invokint the cuirass remote-server): Document it.
---
 doc/cuirass.texi                      |  5 +++++
 src/cuirass/remote.scm                |  6 ++++--
 src/cuirass/scripts/remote-server.scm | 31 +++++++++++++++++++++----------
 src/cuirass/scripts/remote-worker.scm |  5 +++--
 4 files changed, 33 insertions(+), 14 deletions(-)

diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index b2e3836..9627c52 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -634,6 +634,11 @@ at @var{URL}.
 Change privileges to @var{user} as soon as possible---i.e., once the
 signing key has been read.
 
+@item --no-publish
+Do not start a publish server and ignore the @code{publish-port}
+argument. This can be useful if there is a standalone publish server
+standing next to the remote server.
+
 @item --public-key=@var{file}
 @itemx --private-key=@var{file}
 Use the specific @var{file}s as the public/private key pair used to sign
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 6dc4b43..2867af8 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -183,8 +183,10 @@ given NAME."
          (txt (avahi-service-txt service))
          (params (service-txt->params txt))
          (log-port (number-param params 'log-port))
-         (publish-port (number-param params 'publish-port))
-         (publish-url (publish-url address publish-port)))
+         (publish-port (and=> (assq-ref params 'publish-port)
+                              string->number))
+         (publish-url (and publish-port
+                           (publish-url address publish-port))))
     `((#:log-port . ,log-port)
       (#:publish-url . ,publish-url))))
 
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index e8139be..6c4086c 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -120,6 +120,8 @@ Start a remote build server.\n") (%program-name))
   (display (G_ "
   -u, --user=USER           change privileges to USER as soon as possible"))
   (display (G_ "
+      --no-publish          do not start a publish server"))
+  (display (G_ "
       --public-key=FILE     use FILE as the public key for signatures"))
   (display (G_ "
       --private-key=FILE    use FILE as the private key for signatures"))
@@ -160,6 +162,9 @@ Start a remote build server.\n") (%program-name))
         (option '(#\c "cache") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'cache arg result)))
+        (option '(#\s "no-publish") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'no-publish #t result)))
         (option '(#\T "trigger-substitute-url") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'trigger-substitute-url arg result)))
@@ -177,6 +182,7 @@ Start a remote build server.\n") (%program-name))
   `((backend-port     . 5555)
     (log-port         . 5556)
     (publish-port     . 5557)
+    (no-publish       . #f)
     (ttl              . "3d")
     (public-key-file  . ,%public-key-file)
     (private-key-file . ,%private-key-file)))
@@ -527,7 +533,9 @@ exiting."
                              %default-options))
            (backend-port (assoc-ref opts 'backend-port))
            (log-port (assoc-ref opts 'log-port))
-           (publish-port (assoc-ref opts 'publish-port))
+           (no-publish (assoc-ref opts 'no-publish))
+           (publish-port (and (not no-publish)
+                              (assoc-ref opts 'publish-port)))
            (cache (assoc-ref opts 'cache))
            (parameters (assoc-ref opts 'parameters))
            (ttl (assoc-ref opts 'ttl))
@@ -569,11 +577,12 @@ exiting."
         (%gc-root-directory
          (default-gc-root-directory))
 
-        (atomic-box-set!
-         %publish-pid
-         (publish-server publish-port
-                         #:public-key public-key
-                         #:private-key private-key))
+        (unless no-publish
+          (atomic-box-set!
+           %publish-pid
+           (publish-server publish-port
+                           #:public-key public-key
+                           #:private-key private-key)))
 
         (atomic-box-set!
          %avahi-thread
@@ -583,10 +592,12 @@ exiting."
           #:port backend-port
           #:stop-loop? (lambda ()
                          (atomic-box-ref %stop-process?))
-          #:txt (list (string-append "log-port="
-                                     (number->string log-port))
-                      (string-append "publish-port="
-                                     (number->string publish-port)))))
+          #:txt `(,(string-append "log-port="
+                                  (number->string log-port))
+                  ,@(if publish-port
+                      (list (string-append "publish-port="
+                                           (number->string publish-port)))
+                      '()))))
 
         (receive-logs log-port (%cache-directory))
 
diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index b35bbc7..5002b4f 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -285,8 +285,9 @@ and executing them.  The worker can reply on the same 
socket."
   (define (server-info->server info serv)
     (match info
       ((_ log-port publish-port)
-       (let ((url (publish-url (server-address serv)
-                               publish-port)))
+       (let ((url (and publish-port
+                       (publish-url (server-address serv)
+                                    publish-port))))
          (server
           (inherit serv)
           (log-port log-port)