diff options
| -rw-r--r-- | nar-herder/server.scm | 24 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 32 |
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))) |