publish: Restore gzip compression in cache-less mode.

Fixes <https://bugs.gnu.org/30184>.
Regression introduced in 297e04d660.
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.
This commit is contained in:
Ludovic Courtès 2018-01-22 10:46:34 +01:00
parent 3b6502e25d
commit 33988f9b58
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 25 additions and 7 deletions

View File

@ -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

View File

@ -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)
@ -213,6 +217,18 @@ FileSize: ~a~%"
(cut restore-file <> temp)))
(call-with-input-file temp read-string))))
(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"