aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--nar-herder/server.scm24
-rw-r--r--scripts/nar-herder.in32
2 files changed, 47 insertions, 9 deletions
diff --git a/nar-herder/server.scm b/nar-herder/server.scm
index 2c68dad..d84424d 100644
--- a/nar-herder/server.scm
+++ b/nar-herder/server.scm
@@ -222,7 +222,8 @@
"\n"))))
(define* (make-request-handler database storage-root
- #:key ttl negative-ttl logger
+ #:key base-ttl base-cached-compressions-ttl
+ negative-ttl logger
metrics-registry
maybe-trigger-creation-of-compressed-nars)
(define hostname
@@ -797,14 +798,19 @@
(assq-ref opts 'host) ":" (assq-ref opts 'port))
(run-server/patched
- (make-request-handler database
- canonical-storage
- #:ttl (assq-ref opts 'narinfo-ttl)
- #:negative-ttl (assq-ref opts 'narinfo-negative-ttl)
- #:logger lgr
- #:metrics-registry metrics-registry
- #:maybe-trigger-creation-of-compressed-nars
- maybe-trigger-creation-of-compressed-nars)
+ (make-request-handler
+ database
+ canonical-storage
+ #:base-ttl (or (assq-ref opts 'narinfo-new-ttl)
+ (assq-ref opts 'narinfo-ttl))
+ #:base-cached-compressions-ttl
+ (or (assq-ref opts 'new-cached-compressions-narinfo-ttl)
+ (assq-ref opts 'cached-compressions-narinfo-ttl))
+ #:negative-ttl (assq-ref opts 'narinfo-negative-ttl)
+ #:logger lgr
+ #:metrics-registry metrics-registry
+ #:maybe-trigger-creation-of-compressed-nars
+ maybe-trigger-creation-of-compressed-nars)
#:host (assq-ref opts 'host)
#:port (assq-ref opts 'port))
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index cfa4fe7..e81da92 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -219,6 +219,38 @@
(exit 1))
(alist-cons 'narinfo-ttl (time-second duration)
result))))
+ (option '("new-ttl") #t #f
+ (lambda (opt name arg result)
+ (let ((duration (string->duration arg)))
+ (unless duration
+ (simple-format (current-error-port)
+ "~A: invalid duration\n"
+ arg)
+ (exit 1))
+ (alist-cons 'new-narinfo-ttl (time-second duration)
+ result))))
+ (option '("cached-compressions-ttl") #t #f
+ (lambda (opt name arg result)
+ (let ((duration (string->duration arg)))
+ (unless duration
+ (simple-format (current-error-port)
+ "~A: invalid duration\n"
+ arg)
+ (exit 1))
+ (alist-cons 'cached-compressions-narinfo-ttl
+ (time-second duration)
+ result))))
+ (option '("new-cached-compressions-ttl") #t #f
+ (lambda (opt name arg result)
+ (let ((duration (string->duration arg)))
+ (unless duration
+ (simple-format (current-error-port)
+ "~A: invalid duration\n"
+ arg)
+ (exit 1))
+ (alist-cons 'new-cached-compressions-narinfo-ttl
+ (time-second duration)
+ result))))
(option '("negative-ttl") #t #f
(lambda (opt name arg result)
(let ((duration (string->duration arg)))