01/01: publish: Restore gzip compression in cache-less mode.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 33988f9b5876e4b44cabe1997a91eb604931c1ca
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jan 22 10:46:34 2018 +0100

    publish: Restore gzip compression in cache-less mode.
    
    Fixes <https://bugs.gnu.org/30184>.
    Regression introduced in 297e04d66010ada31a40f40143d81bf6b62affcc.
    Reported by Christopher Baines <address@hidden>.
    
    * guix/scripts/publish.scm (nar-response-port): Add 'compression'
    parameter and honor it.
    (http-write): Get 'x-nar-compression' from the initial RESPONSE.
---
 guix/scripts/publish.scm | 16 +++++++++-------
 tests/publish.scm        | 16 ++++++++++++++++
 2 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 1673fb9..b5dfdab 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 bd1a75c..8c88a8c 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)))