From 3f53272c37968a7b1b5c746ad158aa7fc718ca53 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 20 Nov 2021 21:00:46 +0000
Subject: Compress outputs outside of the upload slot

So that the only thing taking place in the upload slot, is the actual upload,
which should improve throughput.
---
 guix-build-coordinator/agent-messaging/http.scm | 94 ++++++++++---------------
 1 file changed, 38 insertions(+), 56 deletions(-)

(limited to 'guix-build-coordinator/agent-messaging/http.scm')

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index ac45ca3..6f87426 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -295,63 +295,45 @@
         (string-append "/build/" build-id "/output/" output-name
                        (if resume? "/partial" ""))))
 
-     (define path-info
-       (with-store store
-         (query-path-info store file)))
-
      (define (perform-upload)
-       (let* ((directory (or (getenv "TMPDIR") "/tmp"))
-              (template  (string-append directory
-                                        "/guix-build-coordinator-file.XXXXXX"))
-              (out       (mkstemp! template)))
-         (log 'INFO "compressing " file " -> " template " prior to sending")
-         (call-with-lzip-output-port out
-           (lambda (port)
-             (write-file file port))
-           #:level 9)
-         (close-port out)
-
-         (log 'INFO "finished compressing " file ", now sending")
-         (retry-on-error
-          (lambda ()
-            (let ((bytes (or (get-partial-upload-bytes)
-                             (get-completed-upload-bytes))))
-              ;; Check if the server has all the bytes
-              (unless (and bytes
-                           (eq? bytes (stat:size (stat template))))
-
-                ;; Still more to send
-                (call-with-input-file template
-                  (lambda (file-port)
-                    (when bytes
-                      (seek file-port bytes SEEK_SET)
-                      (log 'INFO "resuming upload from byte " bytes))
-
-                    (let-values (((response body)
-                                  (call-with-streaming-http-request
-                                   (uri #:resume? (integer? bytes))
-                                   (lambda (port)
-                                     (with-time-logging
-                                         (simple-format #f "sending ~A" file)
-                                       (dump-port file-port port
-                                                  #:buffer-size 65536)))
-                                   #:headers `((Authorization . ,auth-value))
-                                   #:method (if bytes 'POST 'PUT)
-                                   #:report-bytes-sent report-bytes-sent)))
-                      (when (>= (response-code response) 400)
-                        (raise-exception
-                         (make-exception-with-message
-                          (coordinator-handle-failed-request
-                           log
-                           'PUT
-                           (uri-path
-                            (uri #:resume? (integer? bytes)))
-                           response
-                           body))))))))))
-          #:times 100
-          #:delay (random 15))
-
-         (delete-file template)))
+       (retry-on-error
+        (lambda ()
+          (let ((bytes (or (get-partial-upload-bytes)
+                           (get-completed-upload-bytes))))
+            ;; Check if the server has all the bytes
+            (unless (and bytes
+                         (eq? bytes (stat:size (stat template))))
+
+              ;; Still more to send
+              (call-with-input-file file
+                (lambda (file-port)
+                  (when bytes
+                    (seek file-port bytes SEEK_SET)
+                    (log 'INFO "resuming upload from byte " bytes))
+
+                  (let-values (((response body)
+                                (call-with-streaming-http-request
+                                 (uri #:resume? (integer? bytes))
+                                 (lambda (port)
+                                   (with-time-logging
+                                       (simple-format #f "sending ~A" file)
+                                     (dump-port file-port port
+                                                #:buffer-size 65536)))
+                                 #:headers `((Authorization . ,auth-value))
+                                 #:method (if bytes 'POST 'PUT)
+                                 #:report-bytes-sent report-bytes-sent)))
+                    (when (>= (response-code response) 400)
+                      (raise-exception
+                       (make-exception-with-message
+                        (coordinator-handle-failed-request
+                         log
+                         'PUT
+                         (uri-path
+                          (uri #:resume? (integer? bytes)))
+                         response
+                         body))))))))))
+        #:times 100
+        #:delay (random 15)))
 
      (unless (get-completed-upload-bytes)
        (perform-upload)))
-- 
cgit v1.2.3