Properly close the port when making client requests

1 files changed, 14 insertions, 10 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index f1d0208..3f59dad 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -680,7 +680,7 @@
              (current-error-port)
              "error: coordinator-http-request: ~A ~A: ~A\n"
              method path (response-code response))
-            (let ((body
+            (let ((parsed-body
                    (catch #t
                      (lambda ()
                        (if (equal? '(application/json (charset . "utf-8"))
@@ -694,22 +694,26 @@
                         "error decoding body ~A ~A\n"
                         key args)
                        #f))))
+              (close-port body)
               (raise-exception
                (make-exception-with-message
-                body))))
+                parsed-body))))
 
           (begin
             (set-port-encoding! body "UTF-8")
 
             (values
-             (if (equal? '(application/json-seq)
-                         (response-content-type response))
-                 (json-seq->scm
-                  body
-                  ;; TODO I would like to use 'throw, but it always raises an
-                  ;; exception, so this needs fixing upstream first
-                  #:handle-truncate 'replace)
-                 (json->scm body))
+             (let ((parsed-body
+                    (if (equal? '(application/json-seq)
+                                (response-content-type response))
+                        (json-seq->scm
+                         body
+                         ;; TODO I would like to use 'throw, but it always raises an
+                         ;; exception, so this needs fixing upstream first
+                         #:handle-truncate 'replace)
+                        (json->scm body))))
+               (close-port body)
+               parsed-body)
              response))))))
 
 (define* (send-submit-build-request