Hide logging from garbage collection

1 files changed, 22 insertions, 18 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 656cfc3..3101622 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -308,24 +308,28 @@ but the guix-daemon claims it's unavailable")
            (output-file-names
             (map derivation-output-path (map cdr outputs))))
       (if (any file-exists? output-file-names)
-          (catch
-            #t
-            (lambda ()
-              (log-msg lgr 'DEBUG build-id ": deleting "
-                       (if (eq? (length output-file-names) 1)
-                           "output"
-                           "outputs"))
-              ;; There can be issues deleting links when collecting garbage
-              ;; from multiple threads
-              (monitor
-               (with-store store
-                 (delete-paths store output-file-names)))
-              #t)
-            (lambda (key args)
-              (log-msg lgr 'ERROR
-                       "delete-outputs: "
-                       key args)
-              #f))
+          (let ((log-port (open-output-string)))
+            (catch
+              #t
+              (lambda ()
+                (log-msg lgr 'DEBUG build-id ": deleting "
+                         (if (eq? (length output-file-names) 1)
+                             "output"
+                             "outputs"))
+                ;; There can be issues deleting links when collecting garbage
+                ;; from multiple threads
+                (monitor
+                 (with-store store
+                   ;; TODO Do something with the logged output
+                   (parameterize ((current-build-output-port log-port))
+                     (delete-paths store output-file-names))))
+                #t)
+              (lambda (key args)
+                (display (get-output-string log-port))
+                (log-msg lgr 'ERROR
+                         "delete-outputs: "
+                         key args)
+                #f)))
           #t)))
 
   (let ((derivation