branch wip-offload updated: tmp8

[Mathieu Othacehe]

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

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

The following commit(s) were added to refs/heads/wip-offload by this push:
     new 9e56089  tmp8
9e56089 is described below

commit 9e56089615878a15c92d683fef1d505672a7acbb
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Dec 14 11:09:18 2020 +0100

    tmp8
---
 src/cuirass/remote-server.scm |  1 +
 src/cuirass/remote-worker.scm | 39 +++++++++++++++++++++------------------
 src/cuirass/remote.scm        | 24 +++++++++++++++---------
 3 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 3e96446..849b554 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -480,6 +480,7 @@ frontend to the workers connected through the TCP backend."
                                 #:reply-worker reply-worker)))
             ((worker empty client empty rest)
              (let ((message (list client (zmq-empty-delimiter) rest)))
+               (pk (bv->string rest))
                (if (need-fetching? (bv->string rest))
                    (zmq-send-msg-parts-bytevector fetch-socket message)
                    (zmq-send-msg-parts-bytevector client-socket message))))))
diff --git a/src/cuirass/remote-worker.scm b/src/cuirass/remote-worker.scm
index 3e24515..25b6ab3 100644
--- a/src/cuirass/remote-worker.scm
+++ b/src/cuirass/remote-worker.scm
@@ -152,24 +152,25 @@ build server identified by SERVICE-NAME using the REPLY 
procedure.
 The publish server of the build server is added to the list of the store
 substitutes-urls.  This way derivations that are not present on the worker can
 still be substituted."
-  (with-store store
-    (let ((publish-url (server-publish-url server))
-          (local-publish-url (worker-publish-url worker))
-          (name (worker-name worker)))
-      (add-substitute-url store publish-url)
-      (empty-cache!)
-      (reply (zmq-build-started-message drv name))
-      (guard (c ((store-protocol-error? c)
-                 (info (G_ "Derivation `~a' build failed: ~a~%")
-                       drv (store-protocol-error-message c))
-                 (reply (zmq-build-failed-message drv))))
-        (if (build-derivations store (list drv))
-            (begin
-              (info (G_ "Derivation ~a build succeeded.~%") drv)
-              (reply (zmq-build-succeeded-message drv local-publish-url)))
-            (begin
-              (info (G_ "Derivation ~a build failed.~%") drv)
-              (reply (zmq-build-failed-message drv))))))))
+  (parameterize ((current-build-output-port (%make-void-port "w")))
+    (with-store store
+      (let ((publish-url (server-publish-url server))
+            (local-publish-url (worker-publish-url worker))
+            (name (worker-name worker)))
+        (add-substitute-url store publish-url)
+        (empty-cache!)
+        (reply (zmq-build-started-message drv name))
+        (guard (c ((store-protocol-error? c)
+                   (info (G_ "Derivation `~a' build failed: ~a~%")
+                         drv (store-protocol-error-message c))
+                   (reply (zmq-build-failed-message drv))))
+          (if (build-derivations store (list drv))
+              (begin
+                (info (G_ "Derivation ~a build succeeded.~%") drv)
+                (reply (zmq-build-succeeded-message drv local-publish-url)))
+              (begin
+                (info (G_ "Derivation ~a build failed.~%") drv)
+                (reply (zmq-build-failed-message drv)))))))))
 
 (define* (run-command command server
                       #:key
@@ -276,6 +277,8 @@ exiting."
         (exit 1)))))
 
 (define (remote-worker args)
+  (signal-handler)
+
   (with-error-handling
     (let* ((opts (args-fold* args %options
                              (lambda (opt name arg result)
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index d4e94f2..4937a4f 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -229,15 +229,21 @@ PRIVATE-KEY to sign narinfos."
      (parameterize ((%public-key public-key)
                     (%private-key private-key))
        (with-store store
-         (let* ((address (make-socket-address AF_INET INADDR_ANY 0))
-                (socket-address
-                 (make-socket-address (sockaddr:fam address)
-                                      (sockaddr:addr address)
-                                      port))
-                (socket (open-server-socket socket-address)))
-           (run-publish-server socket store
-                               #:compressions
-                               (list %default-gzip-compression))))))
+         (let ((log-file (open-file "/tmp/publish.log" "w")))
+           (close-fdes 1)
+           (close-fdes 2)
+           (dup2 (fileno log-file) 1)
+           (dup2 (fileno log-file) 2)
+           (close-port log-file)
+           (let* ((address (make-socket-address AF_INET INADDR_ANY 0))
+                  (socket-address
+                   (make-socket-address (sockaddr:fam address)
+                                        (sockaddr:addr address)
+                                        port))
+                  (socket (open-server-socket socket-address)))
+             (run-publish-server socket store
+                                 #:compressions
+                                 (list %default-gzip-compression)))))))
     (pid pid)))