diff options
author | Christopher Baines <mail@cbaines.net> | 2024-06-08 22:38:09 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-06-08 22:38:09 +0100 |
commit | ad0a5efea4ac70ca02f68ddbaa82740b074dc0f4 (patch) | |
tree | 9083f54aab91779ff500c2939a37e925132222d7 /guix-qa-frontpage | |
parent | d75f8e9bec6a84bcea80a6fca1ec5847acb5e912 (diff) | |
download | qa-frontpage-ad0a5efea4ac70ca02f68ddbaa82740b074dc0f4.tar qa-frontpage-ad0a5efea4ac70ca02f68ddbaa82740b074dc0f4.tar.gz |
Add a non dynamic-wind version of call-with-zlib-input-port*
Diffstat (limited to 'guix-qa-frontpage')
-rw-r--r-- | guix-qa-frontpage/guix-data-service.scm | 11 | ||||
-rw-r--r-- | guix-qa-frontpage/utils.scm | 22 |
2 files changed, 25 insertions, 8 deletions
diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm index 7ba98bc..af9fb0b 100644 --- a/guix-qa-frontpage/guix-data-service.scm +++ b/guix-qa-frontpage/guix-data-service.scm @@ -109,13 +109,10 @@ (let ((json-body (match (response-content-encoding response) (('gzip) - ;; Prevent fibers issues with zlib - (non-blocking - (lambda () - (call-with-zlib-input-port - body - json->scm - #:format 'gzip)))) + (call-with-zlib-input-port* + body + json->scm + #:format 'gzip)) (_ (json->scm body))))) (if (or (> (response-code response) diff --git a/guix-qa-frontpage/utils.scm b/guix-qa-frontpage/utils.scm index 70f4cd9..12610f0 100644 --- a/guix-qa-frontpage/utils.scm +++ b/guix-qa-frontpage/utils.scm @@ -21,6 +21,7 @@ #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 threads) + #:use-module (zlib) #:use-module (fibers) #:use-module (fibers channels) #:use-module ((guix-build-coordinator utils) #:select (with-port-timeouts @@ -30,7 +31,8 @@ fibers-map fibers-batch-for-each fibers-for-each - non-blocking) + non-blocking + call-with-zlib-input-port*) #:re-export (with-fibers-port-timeouts open-socket-for-uri*)) @@ -160,3 +162,21 @@ (apply values results)) (('exception . exn) (raise-exception exn))))) + +(define* (call-with-zlib-input-port* port proc + #:key + (format 'zlib) + (buffer-size %default-buffer-size)) + "Call PROC with a port that wraps PORT and decompresses data read from it. +PORT is closed upon completion. The zlib internal buffer size is set to +BUFFER-SIZE bytes." + (let ((zlib (make-zlib-input-port port + #:format format + #:buffer-size buffer-size + #:close? #t))) + (call-with-values + (lambda () + (proc zlib)) + (lambda vals + (close-port zlib) + (apply values vals))))) |