From 9b9de08477afe0ea519f916ad3d33c9720c3278d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Dec 2018 23:01:51 +0100 Subject: publish: Add a 'Cache-Control' header on /nar responses. Fixes . Reported by Chris Marusich . * guix/scripts/publish.scm (render-nar/cached): Add #:ttl and honor it. (make-request-handler): Pass #:ttl to 'render-nar/cached'. * tests/publish.scm ("with cache, uncompressed"): Pass "--ttl=42h" to 'guix publish'. Check 'Cache-Control' on narinfo response and on nar response. --- tests/publish.scm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 0e793c1ee5..79a786e723 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -411,10 +411,12 @@ FileSize: ~a~%" (random-text)))) (test-equal "with cache, uncompressed" (list #t + (* 42 3600) ;TTL on narinfo `(("StorePath" . ,item) ("URL" . ,(string-append "nar/" (basename item))) ("Compression" . "none")) 200 ;nar/… + (* 42 3600) ;TTL on nar/… (path-info-nar-size (query-path-info %store item)) ;FileSize 404) ;nar/gzip/… @@ -423,7 +425,7 @@ FileSize: ~a~%" (let ((thread (with-separate-output-ports (call-with-new-thread (lambda () - (guix-publish "--port=6796" "-C2" + (guix-publish "--port=6796" "-C2" "--ttl=42h" (string-append "--cache=" cache))))))) (wait-until-ready 6796) (let* ((base "http://localhost:6796/") @@ -437,13 +439,19 @@ FileSize: ~a~%" (and (= 404 (response-code response)) (wait-for-file cached) - (let* ((body (http-get-port url)) + (let* ((response (http-get url)) + (body (http-get-port url)) (compressed (http-get (string-append base "nar/gzip/" (basename item)))) (uncompressed (http-get (string-append base "nar/" (basename item)))) (narinfo (recutils->alist body))) (list (file-exists? nar) + (match (assq-ref (response-headers response) + 'cache-control) + ((('max-age . ttl)) ttl) + (_ #f)) + (filter (lambda (item) (match item (("Compression" . _) #t) @@ -452,6 +460,11 @@ FileSize: ~a~%" (_ #f))) narinfo) (response-code uncompressed) + (match (assq-ref (response-headers uncompressed) + 'cache-control) + ((('max-age . ttl)) ttl) + (_ #f)) + (string->number (assoc-ref narinfo "FileSize")) (response-code compressed)))))))))) -- cgit v1.2.3