Revert "Revert "Read chunked request bodies in different threads to avoid blocking""

Fibers gets upset when trying to upload files: Attempt to suspend fiber within
continuation barrier, so try doing this in a thread.

This reverts commit 63b0fa9c37a5cd540bcbb975598baa8ef1a3831b.

1 files changed, 41 insertions, 20 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 19f0fdd..b691353 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -81,6 +81,12 @@ if there was no request body."
   (define hook-channel
     (make-hook-channel datastore hooks))
 
+  (define chunked-request-channel
+    ;; I can't work out how to stop the blocking when reading the chunked
+    ;; request bodies, so just do it in a different thread.
+    (make-worker-thread-channel (const '())
+                                #:parallelism 4))
+
   (trigger-build-allocation)
   (call-with-error-handling
    (lambda ()
@@ -99,7 +105,8 @@ if there was no request body."
                            secret-key-base
                            datastore
                            trigger-build-allocation
-                           hook-channel)))
+                           hook-channel
+                           chunked-request-channel)))
       #:host host
       #:port port))
    #:on-error 'backtrace
@@ -146,7 +153,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     secret-key-base
                     datastore
                     trigger-build-allocation
-                    hook-channel)
+                    hook-channel
+                    chunked-request-channel)
   (define (authenticated? uuid request)
     (let* ((authorization-base64
             (match (assq-ref (request-headers request)
@@ -247,15 +255,21 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (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))
+               (if (call-with-worker-thread
+                    chunked-request-channel
+                    (lambda ()
+                      (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
+                    "error"
+                    #:code 500)))
              (render-json
               "access denied"
               #:code 403))))
@@ -266,15 +280,22 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (let ((output-file-name
                     (build-output-file-location datastore uuid output-name)))
                (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))
+               (if (call-with-worker-thread
+                    chunked-request-channel
+                    (lambda ()
+                      (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))))))
+                      #t))
+                   (no-content)
+                   (render-json
+                    "error"
+                    #:code 500)))
              (render-json
               "access denied"
               #:code 403))))