Return to compressing outputs then sending them

Trying to avoid the GnuTLS bindings breaking when the garbage collector runs
is quite difficult, and the current approach isn't very effective.

I want to try instead to support resuming partial uploads, as that should both
help with the GnuTLS GC issue, as well as network interruptions in general.

I think that approach is going to be easier with compressing the files
up-front, so revert to doing that.

This partially reverts commit 8258e9c8d9f729b2670a602c523c59847b676b1a.

1 files changed, 37 insertions, 9 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 5ae2929..afefb52 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -266,15 +266,43 @@
        (with-store store
          (query-path-info store file)))
 
-     (call-with-streaming-http-request
-      uri
-      (lambda (port)
-        (call-with-lzip-output-port port
-          (lambda (port)
-            (write-file file port))
-          #:level 9))
-      #:headers `((Authorization . ,auth-value))
-      #:report-bytes-sent report-bytes-sent))
+     (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 ()
+          (call-with-input-file template
+            (lambda (file-port)
+              (let-values (((response body)
+                            (call-with-streaming-http-request
+                             uri
+                             (lambda (port)
+                               (with-time-logging
+                                   (simple-format #f "sending ~A" file)
+                                 (dump-port file-port port
+                                            #:buffer-size 65536)))
+                             #:headers `((Authorization . ,auth-value)))))
+                (when (>= (response-code response) 400)
+                  (raise-exception
+                   (make-exception-with-message
+                    (coordinator-handle-failed-request log
+                                                       'PUT
+                                                       (uri-path uri)
+                                                       response
+                                                       body))))))))
+        #:times 12
+        #:delay (random 15))
+
+       (delete-file template)))
    args))
 
 (define-method (submit-log-file