~ruther/guix-local

33988f9b5876e4b44cabe1997a91eb604931c1ca — Ludovic Courtès 8 years ago 3b6502e
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.
2 files changed, 25 insertions(+), 7 deletions(-)

M guix/scripts/publish.scm
M tests/publish.scm
M guix/scripts/publish.scm => guix/scripts/publish.scm +9 -7
@@ 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

M tests/publish.scm => tests/publish.scm +16 -0
@@ 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)))