guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

http: Add 'Cache-Control' header on /static files.

Browse source 
* src/cuirass/http.scm (%static-file-ttl): New variable.
(url-handler)[respond-file]: Add #:ttl and honor it.
[respond-static-file]: Pass #:ttl.
This commit is contained in:
Ludovic Courtès 2023-06-15 14:12:08 +02:00
parent 7c9fc0645e
commit c74d60d194
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 10 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/cuirass/http.scm
View file

@ -490,6 +490,10 @@ passed, only display JOBS targeting this SYSTEM."
(define (request-path-components request)
(split-and-decode-uri-path (uri-path (request-uri request))))
(define %static-file-ttl
;; Time-to-live (in seconds) advertised for files under /static.
(* 12 3600))
(define (url-handler request body)
(define* (respond response #:key body)
@ -542,13 +546,16 @@ passed, only display JOBS targeting this SYSTEM."
(lambda (port)
(sxml->xml body port))))
(define* (respond-file file)
(define* (respond-file file #:key ttl)
(let ((content-type (or (assoc-ref %file-mime-types
(file-extension file))
'(application/octet-stream))))
(respond `((content-type . ,content-type)
(content-disposition
. (form-data (filename . ,(basename file))))
,@(if ttl
`((cache-control . ((max-age . ,ttl))))
'())
(x-raw-file . ,file)))))
(define (respond-static-file path)
@ -558,7 +565,8 @@ passed, only display JOBS targeting this SYSTEM."
(if (and (member file-name %file-white-list)
(file-exists? file-path)
(not (file-is-directory? file-path)))
(respond-file file-path)
(respond-file file-path
#:ttl %static-file-ttl)
(respond-not-found file-name))))
(define (respond-compressed-file file)