aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-01-22 10:46:34 +0100
committerLudovic Courtès <ludo@gnu.org>2018-01-22 11:15:50 +0100
commit33988f9b5876e4b44cabe1997a91eb604931c1ca (patch)
tree5980155f32e47ef95ec5268f7c496410a43c50aa
parent3b6502e25d421ddc6dec3ed828ef23f311e279a6 (diff)
downloadguix-33988f9b5876e4b44cabe1997a91eb604931c1ca.tar
guix-33988f9b5876e4b44cabe1997a91eb604931c1ca.tar.gz
publish: Restore gzip compression in cache-less mode.
Fixes <https://bugs.gnu.org/30184>. Regression introduced in 297e04d66010ada31a40f40143d81bf6b62affcc. Reported by Christopher Baines <mail@cbaines.net>. * guix/scripts/publish.scm (nar-response-port): Add 'compression' parameter and honor it. (http-write): Get 'x-nar-compression' from the initial RESPONSE.
-rw-r--r--guix/scripts/publish.scm16
-rw-r--r--tests/publish.scm16
2 files changed, 25 insertions, 7 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 1673fb9f33..b5dfdab32f 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -672,10 +672,10 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
exp ...)
(const #f)))
-(define (nar-response-port response)
+(define (nar-response-port response compression)
"Return a port on which to write the body of RESPONSE, the response of a
/nar request, according to COMPRESSION."
- (match (assoc-ref (response-headers response) 'x-nar-compression)
+ (match compression
(($ <compression> 'gzip level)
;; Note: We cannot used chunked encoding here because
;; 'make-gzip-output-port' wants a file port.
@@ -697,11 +697,13 @@ blocking."
(call-with-new-thread
(lambda ()
(set-thread-name "publish nar")
- (let* ((response (write-response (sans-content-length response)
- client))
- (port (begin
- (force-output client)
- (nar-response-port response))))
+ (let* ((compression (assoc-ref (response-headers response)
+ 'x-nar-compression))
+ (response (write-response (sans-content-length response)
+ client))
+ (port (begin
+ (force-output client)
+ (nar-response-port response compression))))
;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in
;; 'render-nar', BODY here is just the file name of the store item.
;; We call 'write-file' from here because we know that's the only
diff --git a/tests/publish.scm b/tests/publish.scm
index bd1a75cf00..8c88a8c93d 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -111,6 +111,10 @@
(sleep 1)
(loop (- i 1))))))
+(define %gzip-magic-bytes
+ ;; Magic bytes of gzip file.
+ #vu8(#x1f #x8b))
+
;; Wait until the two servers are ready.
(wait-until-ready 6789)
@@ -215,6 +219,18 @@ FileSize: ~a~%"
(unless (zlib-available?)
(test-skip 1))
+(test-equal "/nar/gzip/* is really gzip"
+ %gzip-magic-bytes
+ ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
+ ;; uncompressed gzip, the test above doesn't check whether it's actually
+ ;; gzip. This is what this test does. See <https://bugs.gnu.org/30184>.
+ (let ((nar (http-get-port
+ (publish-uri
+ (string-append "/nar/gzip/" (basename %item))))))
+ (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
+
+(unless (zlib-available?)
+ (test-skip 1))
(test-equal "/*.narinfo with compression"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))