publish: Add '--negative-ttl'.
* guix/scripts/publish.scm (show-help, %options): Add '--negative-ttl'. (render-narinfo, render-narinfo/cached, make-request-handler): Add #:negative-ttl and honor it. (run-publish-server): Add #:narinfo-negative-ttl and honor it. (guix-publish): Honor '--negative-ttl'. * tests/publish.scm ("negative TTL", "no negative TTL"): New tests.
This commit is contained in:
parent
dc3504913d
commit
938ffcbb05
|
@ -12703,6 +12703,16 @@ Additionally, when @option{--cache} is used, cached entries that have
|
||||||
not been accessed for @var{ttl} and that no longer have a corresponding
|
not been accessed for @var{ttl} and that no longer have a corresponding
|
||||||
item in the store, may be deleted.
|
item in the store, may be deleted.
|
||||||
|
|
||||||
|
@item --negative-ttl=@var{ttl}
|
||||||
|
Similarly produce @code{Cache-Control} HTTP headers to advertise the
|
||||||
|
time-to-live (TTL) of @emph{negative} lookups---missing store items, for
|
||||||
|
which the HTTP 404 code is returned. By default, no negative TTL is
|
||||||
|
advertised.
|
||||||
|
|
||||||
|
This parameter can help adjust server load and substitute latency by
|
||||||
|
instructing cooperating clients to be more or less patient when a store
|
||||||
|
item is missing.
|
||||||
|
|
||||||
@item --cache-bypass-threshold=@var{size}
|
@item --cache-bypass-threshold=@var{size}
|
||||||
When used in conjunction with @option{--cache}, store items smaller than
|
When used in conjunction with @option{--cache}, store items smaller than
|
||||||
@var{size} are immediately available, even when they are not yet in
|
@var{size} are immediately available, even when they are not yet in
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
||||||
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
|
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
|
||||||
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||||
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
|
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
|
@ -101,6 +101,8 @@ Publish ~a over HTTP.\n") %store-directory)
|
||||||
--workers=N use N workers to bake items"))
|
--workers=N use N workers to bake items"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--ttl=TTL announce narinfos can be cached for TTL seconds"))
|
--ttl=TTL announce narinfos can be cached for TTL seconds"))
|
||||||
|
(display (G_ "
|
||||||
|
--negative-ttl=TTL announce missing narinfos can be cached for TTL seconds"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
--nar-path=PATH use PATH as the prefix for nar URLs"))
|
--nar-path=PATH use PATH as the prefix for nar URLs"))
|
||||||
(display (G_ "
|
(display (G_ "
|
||||||
|
@ -224,6 +226,13 @@ usage."
|
||||||
(leave (G_ "~a: invalid duration~%") arg))
|
(leave (G_ "~a: invalid duration~%") arg))
|
||||||
(alist-cons 'narinfo-ttl (time-second duration)
|
(alist-cons 'narinfo-ttl (time-second duration)
|
||||||
result))))
|
result))))
|
||||||
|
(option '("negative-ttl") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(let ((duration (string->duration arg)))
|
||||||
|
(unless duration
|
||||||
|
(leave (G_ "~a: invalid duration~%") arg))
|
||||||
|
(alist-cons 'narinfo-negative-ttl (time-second duration)
|
||||||
|
result))))
|
||||||
(option '("nar-path") #t #f
|
(option '("nar-path") #t #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'nar-path arg result)))
|
(alist-cons 'nar-path arg result)))
|
||||||
|
@ -390,14 +399,14 @@ References: ~a~%"
|
||||||
|
|
||||||
(define* (render-narinfo store request hash
|
(define* (render-narinfo store request hash
|
||||||
#:key ttl (compressions (list %no-compression))
|
#:key ttl (compressions (list %no-compression))
|
||||||
(nar-path "nar"))
|
(nar-path "nar") negative-ttl)
|
||||||
"Render metadata for the store path corresponding to HASH. If TTL is true,
|
"Render metadata for the store path corresponding to HASH. If TTL is true,
|
||||||
advertise it as the maximum validity period (in seconds) via the
|
advertise it as the maximum validity period (in seconds) via the
|
||||||
'Cache-Control' header. This allows 'guix substitute' to cache it for an
|
'Cache-Control' header. This allows 'guix substitute' to cache it for an
|
||||||
appropriate duration. NAR-PATH specifies the prefix for nar URLs."
|
appropriate duration. NAR-PATH specifies the prefix for nar URLs."
|
||||||
(let ((store-path (hash-part->path store hash)))
|
(let ((store-path (hash-part->path store hash)))
|
||||||
(if (string-null? store-path)
|
(if (string-null? store-path)
|
||||||
(not-found request #:phrase "")
|
(not-found request #:phrase "" #:ttl negative-ttl)
|
||||||
(values `((content-type . (application/x-nix-narinfo))
|
(values `((content-type . (application/x-nix-narinfo))
|
||||||
,@(if ttl
|
,@(if ttl
|
||||||
`((cache-control (max-age . ,ttl)))
|
`((cache-control (max-age . ,ttl)))
|
||||||
|
@ -512,7 +521,7 @@ interpreted as the basename of a store item."
|
||||||
|
|
||||||
(define* (render-narinfo/cached store request hash
|
(define* (render-narinfo/cached store request hash
|
||||||
#:key ttl (compressions (list %no-compression))
|
#:key ttl (compressions (list %no-compression))
|
||||||
(nar-path "nar")
|
(nar-path "nar") negative-ttl
|
||||||
cache pool)
|
cache pool)
|
||||||
"Respond to the narinfo request for REQUEST. If the narinfo is available in
|
"Respond to the narinfo request for REQUEST. If the narinfo is available in
|
||||||
CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
|
CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
|
||||||
|
@ -536,7 +545,7 @@ requested using POOL."
|
||||||
#:compression
|
#:compression
|
||||||
(first compressions)))))
|
(first compressions)))))
|
||||||
(cond ((string-null? item)
|
(cond ((string-null? item)
|
||||||
(not-found request))
|
(not-found request #:ttl negative-ttl))
|
||||||
((file-exists? cached)
|
((file-exists? cached)
|
||||||
;; Narinfo is in cache, send it.
|
;; Narinfo is in cache, send it.
|
||||||
(values `((content-type . (application/x-nix-narinfo))
|
(values `((content-type . (application/x-nix-narinfo))
|
||||||
|
@ -584,7 +593,7 @@ requested using POOL."
|
||||||
#:phrase "We're baking it"
|
#:phrase "We're baking it"
|
||||||
#:ttl 300))) ;should be available within 5m
|
#:ttl 300))) ;should be available within 5m
|
||||||
(else
|
(else
|
||||||
(not-found request #:phrase "")))))
|
(not-found request #:phrase "" #:ttl negative-ttl)))))
|
||||||
|
|
||||||
(define (compress-nar cache item compression)
|
(define (compress-nar cache item compression)
|
||||||
"Save in directory CACHE the nar for ITEM compressed with COMPRESSION."
|
"Save in directory CACHE the nar for ITEM compressed with COMPRESSION."
|
||||||
|
@ -974,7 +983,7 @@ methods, return the applicable compression."
|
||||||
(define* (make-request-handler store
|
(define* (make-request-handler store
|
||||||
#:key
|
#:key
|
||||||
cache pool
|
cache pool
|
||||||
narinfo-ttl
|
narinfo-ttl narinfo-negative-ttl
|
||||||
(nar-path "nar")
|
(nar-path "nar")
|
||||||
(compressions (list %no-compression)))
|
(compressions (list %no-compression)))
|
||||||
(define compression-type?
|
(define compression-type?
|
||||||
|
@ -1006,10 +1015,12 @@ methods, return the applicable compression."
|
||||||
#:cache cache
|
#:cache cache
|
||||||
#:pool pool
|
#:pool pool
|
||||||
#:ttl narinfo-ttl
|
#:ttl narinfo-ttl
|
||||||
|
#:negative-ttl narinfo-negative-ttl
|
||||||
#:nar-path nar-path
|
#:nar-path nar-path
|
||||||
#:compressions compressions)
|
#:compressions compressions)
|
||||||
(render-narinfo store request hash
|
(render-narinfo store request hash
|
||||||
#:ttl narinfo-ttl
|
#:ttl narinfo-ttl
|
||||||
|
#:negative-ttl narinfo-negative-ttl
|
||||||
#:nar-path nar-path
|
#:nar-path nar-path
|
||||||
#:compressions compressions)))
|
#:compressions compressions)))
|
||||||
;; /nar/file/NAME/sha256/HASH
|
;; /nar/file/NAME/sha256/HASH
|
||||||
|
@ -1068,7 +1079,7 @@ methods, return the applicable compression."
|
||||||
#:key
|
#:key
|
||||||
advertise? port
|
advertise? port
|
||||||
(compressions (list %no-compression))
|
(compressions (list %no-compression))
|
||||||
(nar-path "nar") narinfo-ttl
|
(nar-path "nar") narinfo-ttl narinfo-negative-ttl
|
||||||
cache pool)
|
cache pool)
|
||||||
(when advertise?
|
(when advertise?
|
||||||
(let ((name (service-name)))
|
(let ((name (service-name)))
|
||||||
|
@ -1084,6 +1095,7 @@ methods, return the applicable compression."
|
||||||
#:pool pool
|
#:pool pool
|
||||||
#:nar-path nar-path
|
#:nar-path nar-path
|
||||||
#:narinfo-ttl narinfo-ttl
|
#:narinfo-ttl narinfo-ttl
|
||||||
|
#:narinfo-negative-ttl narinfo-negative-ttl
|
||||||
#:compressions compressions)
|
#:compressions compressions)
|
||||||
concurrent-http-server
|
concurrent-http-server
|
||||||
`(#:socket ,socket)))
|
`(#:socket ,socket)))
|
||||||
|
@ -1127,6 +1139,7 @@ methods, return the applicable compression."
|
||||||
(user (assoc-ref opts 'user))
|
(user (assoc-ref opts 'user))
|
||||||
(port (assoc-ref opts 'port))
|
(port (assoc-ref opts 'port))
|
||||||
(ttl (assoc-ref opts 'narinfo-ttl))
|
(ttl (assoc-ref opts 'narinfo-ttl))
|
||||||
|
(negative-ttl (assoc-ref opts 'narinfo-negative-ttl))
|
||||||
(compressions (match (filter-map (match-lambda
|
(compressions (match (filter-map (match-lambda
|
||||||
(('compression . compression)
|
(('compression . compression)
|
||||||
compression)
|
compression)
|
||||||
|
@ -1192,6 +1205,7 @@ consider using the '--user' option!~%")))
|
||||||
"publish worker"))
|
"publish worker"))
|
||||||
#:nar-path nar-path
|
#:nar-path nar-path
|
||||||
#:compressions compressions
|
#:compressions compressions
|
||||||
|
#:narinfo-negative-ttl negative-ttl
|
||||||
#:narinfo-ttl ttl))))))
|
#:narinfo-ttl ttl))))))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
;;; Copyright © 2015 David Thompson <davet@gnu.org>
|
||||||
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
|
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
|
||||||
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -700,6 +700,36 @@ References: ~%"
|
||||||
(= (response-content-length response) (stat:size (stat log)))
|
(= (response-content-length response) (stat:size (stat log)))
|
||||||
(first (response-content-type response))))))
|
(first (response-content-type response))))))
|
||||||
|
|
||||||
|
(test-equal "negative TTL"
|
||||||
|
`(404 42)
|
||||||
|
|
||||||
|
(call-with-temporary-directory
|
||||||
|
(lambda (cache)
|
||||||
|
(let ((thread (with-separate-output-ports
|
||||||
|
(call-with-new-thread
|
||||||
|
(lambda ()
|
||||||
|
(guix-publish "--port=6786" "-C0"
|
||||||
|
"--negative-ttl=42s"))))))
|
||||||
|
(wait-until-ready 6786)
|
||||||
|
|
||||||
|
(let* ((base "http://localhost:6786/")
|
||||||
|
(url (string-append base (make-string 32 #\z)
|
||||||
|
".narinfo"))
|
||||||
|
(response (http-get url)))
|
||||||
|
(list (response-code response)
|
||||||
|
(match (assq-ref (response-headers response) 'cache-control)
|
||||||
|
((('max-age . ttl)) ttl)
|
||||||
|
(_ #f))))))))
|
||||||
|
|
||||||
|
(test-equal "no negative TTL"
|
||||||
|
`(404 #f)
|
||||||
|
(let* ((uri (publish-uri
|
||||||
|
(string-append "/" (make-string 32 #\z)
|
||||||
|
".narinfo")))
|
||||||
|
(response (http-get uri)))
|
||||||
|
(list (response-code response)
|
||||||
|
(assq-ref (response-headers response) 'cache-control))))
|
||||||
|
|
||||||
(test-equal "/log/NAME not found"
|
(test-equal "/log/NAME not found"
|
||||||
404
|
404
|
||||||
(let ((uri (publish-uri "/log/does-not-exist")))
|
(let ((uri (publish-uri "/log/does-not-exist")))
|
||||||
|
|
Loading…
Reference in New Issue