Support sending and storing log files for builds

1 files changed, 50 insertions, 0 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 669981f..8fba5c2 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -44,6 +44,7 @@
   #:export (http-agent-messaging-start-server
 
             submit-status
+            submit-log-file
             submit-build-result
             report-setup-failure
             submit-output
@@ -214,6 +215,25 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (render-json
               "access denied"
               #:code 403))))
+      (('PUT "build" uuid "log" format)
+       (let ((agent-id-for-build
+              (datastore-agent-for-build datastore uuid)))
+         (if (authenticated? agent-id-for-build request)
+             (let ((output-file-name
+                    (build-log-file-location datastore uuid format)))
+               (mkdir-p (dirname output-file-name))
+               (call-with-output-file output-file-name
+                 (lambda (output-port)
+                   (let loop ((line (get-line body)))
+                     (unless (eof-object? line)
+                       (base64-decode line
+                                      base64-alphabet
+                                      output-port)
+                       (loop (get-line body))))))
+               (no-content))
+             (render-json
+              "access denied"
+              #:code 403))))
       (('PUT "build" uuid "output" output-name)
        (let ((agent-id-for-build
               (datastore-agent-for-build datastore uuid)))
@@ -309,6 +329,36 @@ port. Also, the port used can be changed by passing the --port option.\n"
        #:level 9))
    #:headers `((Authorization . ,auth-value))))
 
+(define (submit-log-file coordinator-uri agent-uuid password
+                         build-id file)
+  (define auth-value
+    (string-append
+     "Basic "
+     (base64-encode
+      (string->utf8
+       (string-append agent-uuid ":" password)))))
+
+  (define format
+    (cond
+     ((string-suffix? ".bz2" file) "bzip2")
+     ((string-suffix? ".gz" file)  "gzip")
+     (else
+      (error "unsupported log format for" file))))
+
+  (define uri
+    (coordinator-uri-for-path
+     coordinator-uri
+     (string-append "/build/" build-id "/log/" format)))
+
+  (call-with-streaming-http-request
+   uri
+   (lambda (request-port)
+     (call-with-input-file file
+       (lambda (file-port)
+         (dump-port file-port request-port))
+       #:binary #t))
+   #:headers `((Authorization . ,auth-value))))
+
 (define (submit-build-result coordinator-uri agent-uuid password
                              build-id result)
   (define auth-value