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:
parent
3b6502e25d
commit
33988f9b58
|
@ -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)
|
||||
(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))))
|
||||
(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
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in New Issue