diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-08-23 11:10:40 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-08-23 11:14:43 +0100 |
| commit | 06a44693c4f25109f945e5aa6c7c4670df72b690 (patch) | |
| tree | cd5e62a9983dadcf051f15ae93e57d9c9b8c673c | |
| parent | f9408ba75803baccd0d44de06b5c2b609fd42315 (diff) | |
| download | build-coordinator-06a44693c4f25109f945e5aa6c7c4670df72b690.tar build-coordinator-06a44693c4f25109f945e5aa6c7c4670df72b690.tar.gz | |
Properly close the port when making client requests
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 24 |
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 |