aboutsummaryrefslogtreecommitdiff
path: root/guix-qa-frontpage
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-06-08 22:38:09 +0100
committerChristopher Baines <mail@cbaines.net>2024-06-08 22:38:09 +0100
commitad0a5efea4ac70ca02f68ddbaa82740b074dc0f4 (patch)
tree9083f54aab91779ff500c2939a37e925132222d7 /guix-qa-frontpage
parentd75f8e9bec6a84bcea80a6fca1ec5847acb5e912 (diff)
downloadqa-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.scm11
-rw-r--r--guix-qa-frontpage/utils.scm22
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)))))