1 files changed, 37 insertions, 30 deletions

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index b221199..9887d05 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -6,6 +6,7 @@
   #:use-module (ice-9 q)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 popen)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
@@ -254,30 +255,41 @@ upcoming chunk."
         '())))
 
 (define (with-gc-protection thunk)
-  (monitor
-   (dynamic-wind
-     gc-disable
-     thunk
-     gc-enable)))
-
-(define (make-gc-guard-port port)
-  (define (%put-char c)
-    (write c port))
+  (dynamic-wind
+    gc-disable
+    thunk
+    gc-enable))
 
+(define* (make-chunked-output-port* port #:key (keep-alive? #f)
+                                    (buffering 1200))
   (define (%put-string s)
-    (display s port))
+    (let ((length (string-length s)))
+      (unless (eq? length 0)
+        (with-gc-protection
+         (lambda ()
+           (put-string port (number->string length 16))
+           (put-string port "\r\n")
+           (write s port)
+           (put-string port "\r\n"))))))
+  (define (%put-char c)
+    (%put-string (list->string (list c))))
 
   (define (flush)
+    (force-output port))
+  (define (safe-flush)
+    (with-gc-protection flush))
+  (define (close)
     (with-gc-protection
      (lambda ()
-       (force-output port))))
-
-  (define (close)
-    (close-port port))
-
-  (make-soft-port
-   (vector %put-char %put-string flush #f close)
-   "w"))
+       (flush)
+       (put-string port "0\r\n\r\n")
+       (force-output port)
+       (unless keep-alive?
+         (close-port port)))))
+  (let ((ret (make-soft-port
+              (vector %put-char %put-string safe-flush #f close) "w")))
+    (setvbuf ret 'block buffering)
+    ret))
 
 (define* (call-with-streaming-http-request uri callback
                                            #:key (headers '()))
@@ -294,7 +306,7 @@ upcoming chunk."
            #:port port)))
 
     (set-port-encoding! port "ISO-8859-1")
-    (setvbuf port 'block 65536)
+    (setvbuf port 'block (expt 2 13))
     (with-exception-handler
         (lambda (exp)
           (simple-format #t "error: PUT ~A: ~A\n" (uri-path uri) exp)
@@ -302,14 +314,11 @@ upcoming chunk."
           (raise-exception exp))
       (lambda ()
         (let ((request (write-request request port)))
-          (let ((chunked-output-port
-                 (make-gc-guard-port
-                  (make-chunked-output-port
+          (let* ((chunked-output-port
+                  (make-chunked-output-port*
                    port
-                   #:buffering 65536
-                   #:keep-alive? #t))))
-
-            (setvbuf chunked-output-port 'block 1048576)
+                   #:buffering (expt 2 12)
+                   #:keep-alive? #t)))
 
             ;; A SIGPIPE will kill Guile, so ignore it
             (sigaction SIGPIPE
@@ -318,12 +327,10 @@ upcoming chunk."
 
             (set-port-encoding! chunked-output-port "ISO-8859-1")
             (callback chunked-output-port)
+            (close-port chunked-output-port)
+
             (with-gc-protection
              (lambda ()
-               (close-port chunked-output-port)
-               (display "\r\n" port)
-               (force-output port)
-
                (let ((response (read-response port)))
                  (let ((body (read-response-body response)))
                    (close-port port)