From 9b9de08477afe0ea519f916ad3d33c9720c3278d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 17 Dec 2018 23:01:51 +0100
Subject: publish: Add a 'Cache-Control' header on /nar responses.

Fixes <https://bugs.gnu.org/33721>.
Reported by Chris Marusich <cmmarusich@gmail.com>.

* 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.
---
 guix/scripts/publish.scm | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

(limited to 'guix/scripts')

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c5326b33da..a236f3e45c 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -537,14 +537,19 @@ requested using POOL."
         (not-found request))))
 
 (define* (render-nar/cached store cache request store-item
-                            #:key (compression %no-compression))
+                            #:key ttl (compression %no-compression))
   "Respond to REQUEST with a nar for STORE-ITEM.  If the nar is in CACHE,
-return it; otherwise, return 404."
+return it; otherwise, return 404.  When TTL is true, use it as the
+'Cache-Control' expiration time."
   (let ((cached (nar-cache-file cache store-item
                                 #:compression compression)))
     (if (file-exists? cached)
         (values `((content-type . (application/octet-stream
                                    (charset . "ISO-8859-1")))
+                  ,@(if ttl
+                        `((cache-control (max-age . ,ttl)))
+                        '())
+
                   ;; XXX: We're not returning the actual contents, deferring
                   ;; instead to 'http-write'.  This is a hack to work around
                   ;; <http://bugs.gnu.org/21093>.
@@ -819,6 +824,7 @@ blocking."
                                      %default-gzip-compression))))
                  (if cache
                      (render-nar/cached store cache request store-item
+                                        #:ttl narinfo-ttl
                                         #:compression compression)
                      (render-nar store request store-item
                                  #:compression compression)))
@@ -829,6 +835,7 @@ blocking."
            (if (nar-path? components)
                (if cache
                    (render-nar/cached store cache request store-item
+                                      #:ttl narinfo-ttl
                                       #:compression %no-compression)
                    (render-nar store request store-item
                                #:compression %no-compression))
-- 
cgit v1.2.3