branch wip-offload updated: tmp26

[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 66ae0aa  tmp26
66ae0aa is described below

commit 66ae0aaaf87be55a696d5153b3cd40bda5147772
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Dec 18 12:04:23 2020 +0100

    tmp26
---
 src/cuirass/base.scm          |  5 ++++-
 src/cuirass/remote-server.scm | 50 +++++++++++++++++++++++++++----------------
 2 files changed, 36 insertions(+), 19 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index ddeab75..025756b 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -668,7 +668,10 @@ updating the database accordingly."
          (log-message "bogus build-failed event for '~a'" drv)))
     (('build-failed/log drv log)
      (log-message "build failed: '~a'" drv)
-     (db-update-build-status! drv (build-status failed)
+     (db-update-build-status! drv
+                              (if log
+                                  (build-status failed)
+                                  (build-status failed-dependency))
                               #:log-file log))
     (('workers workers)
      (db-clear-workers)
diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 6519c1e..cac2f5b 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -63,6 +63,9 @@
 (define %cache-directory
   (make-parameter #f))
 
+(define %log-directory
+  (make-parameter #f))
+
 (define %private-key
   (make-parameter #f))
 
@@ -84,6 +87,8 @@ Start a remote build server.\n"))
   (display (G_ "
   -c, --cache=DIRECTORY     cache built items to DIRECTORY"))
   (display (G_ "
+  -l, --log-directory=DIRECTORY   cache log files to DIRECTORY"))
+  (display (G_ "
   -u, --user=USER           change privileges to USER as soon as possible"))
   (display (G_ "
       --public-key=FILE     use FILE as the public key for signatures"))
@@ -117,6 +122,9 @@ Start a remote build server.\n"))
         (option '(#\c "cache") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'cache arg result)))
+        (option '(#\l "log-directory") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'log-directory arg result)))
         (option '(#\u "user") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'user arg result)))
@@ -362,7 +370,8 @@ build server signature."
 
        (unless (file-exists? hash-file)
          (mkdir-p (dirname hash-file))
-         (write-hash cache-directory hash-file path))))
+         (write-hash cache-directory hash-file path)
+         (chmod hash-file #o644))))
    outputs))
 
 (define (download-log-file cache-directory derivation url)
@@ -406,23 +415,26 @@ outputs are downloaded."
               (read-derivation-from-file drv))))
       (const '())))
 
-  (match (zmq-read-message message)
-    (('build-succeeded ('drv drv) ('url url) _ ...)
-     (info (G_ "Fetching derivation ~a build outputs.~%") drv)
-     (let ((outputs (build-outputs drv))
-           (log-file
-            (download-log-file (%cache-directory) drv url)))
-       (when (%add-to-store?)
-         (add-to-store outputs url))
-       (when (%cache-directory)
-         (download-nar (%cache-directory) outputs url))
-       (reply
-        (zmq-build-succeeded-message drv url log-file))))
-    (('build-failed ('drv drv) ('url url) _ ...)
-     (let ((log-file
-            (download-log-file (%cache-directory) drv url)))
-       (reply
-        (zmq-build-failed-message drv url log-file))))))
+  (let ((log-directory (%log-directory)))
+    (match (zmq-read-message message)
+      (('build-succeeded ('drv drv) ('url url) _ ...)
+       (info (G_ "Fetching derivation ~a build outputs.~%") drv)
+       (let ((outputs (build-outputs drv))
+             (log-file
+              (and log-directory
+                   (download-log-file log-directory drv url)))
+             (when (%add-to-store?)
+               (add-to-store outputs url)))
+         (when (%cache-directory)
+           (download-nar (%cache-directory) outputs url))
+         (reply
+          (zmq-build-succeeded-message drv url log-file))))
+      (('build-failed ('drv drv) ('url url) _ ...)
+       (let ((log-file
+              (and log-directory
+                   (download-log-file log-directory drv url))))
+         (reply
+          (zmq-build-failed-message drv url log-file)))))))
 
 (define (start-fetch-worker name)
   "Start a fetch worker thread with the given NAME.  This worker takes care of
@@ -580,6 +592,7 @@ exiting."
            (backend-port (assoc-ref opts 'backend-port))
            (publish-port (assoc-ref opts 'publish-port))
            (cache (assoc-ref opts 'cache))
+           (log-directory (assoc-ref opts 'log-directory))
            (user (assoc-ref opts 'user))
            (public-key
             (read-file-sexp
@@ -590,6 +603,7 @@ exiting."
 
       (parameterize ((%add-to-store? add-to-store?)
                      (%cache-directory cache)
+                     (%log-directory log-directory)
                      (%public-key public-key)
                      (%private-key private-key))
         (when user