diff options
Diffstat (limited to 'scripts')
-rw-r--r-- | scripts/nar-herder.in | 68 |
1 files changed, 51 insertions, 17 deletions
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index e81da92..e4ce9c2 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -208,18 +208,49 @@ arg (alist-delete 'cached-compression-nar-source result)))) - - (option '("ttl") #t #f + (option '("cached-compressions-unused-removal-duration") #t #f (lambda (opt name arg result) - (let ((duration (string->duration arg))) - (unless duration - (simple-format (current-error-port) - "~A: invalid duration\n" - arg) + (alist-cons + 'cached-compression-unused-removal-duration + (match (string-split arg #\=) + ((_) + (simple-format + (current-error-port) + "cached-compressions-unused-removal-duration: you must specify compression and value\n") (exit 1)) - (alist-cons 'narinfo-ttl (time-second duration) - result)))) - (option '("new-ttl") #t #f + ((type duration-string) + (cons (string->symbol type) + (let ((duration (string->duration duration-string))) + (unless duration + (simple-format + (current-error-port) + "~A: cached-compressions-unused-removal-duration: invalid duration\n" + arg) + (exit 1)) + + duration)))) + result))) + (option '("cached-compressions-ttl") #t #f + (lambda (opt name arg result) + (alist-cons 'cached-compression-ttl + (match (string-split arg #\=) + ((_) + (simple-format + (current-error-port) + "cached-compressions-ttl: you must specify compression and value\n") + (exit 1)) + ((type ttl-string) + (let ((duration (string->duration ttl-string))) + (unless duration + (simple-format (current-error-port) + "~A: invalid duration\n" + arg) + (exit 1)) + + (cons (string->symbol type) + (time-second duration))))) + result))) + (option '("cached-compressions-new-ttl") #t #f (lambda (opt name arg result) (let ((duration (string->duration arg))) (unless duration @@ -227,9 +258,14 @@ "~A: invalid duration\n" arg) (exit 1)) - (alist-cons 'new-narinfo-ttl (time-second duration) + (alist-cons 'cached-compression-new-ttl + (match (string-split arg #\=) + ((type size) + (cons (string->symbol type) + (time-second duration)))) result)))) - (option '("cached-compressions-ttl") #t #f + + (option '("ttl") #t #f (lambda (opt name arg result) (let ((duration (string->duration arg))) (unless duration @@ -237,10 +273,9 @@ "~A: invalid duration\n" arg) (exit 1)) - (alist-cons 'cached-compressions-narinfo-ttl - (time-second duration) + (alist-cons 'narinfo-ttl (time-second duration) result)))) - (option '("new-cached-compressions-ttl") #t #f + (option '("new-ttl") #t #f (lambda (opt name arg result) (let ((duration (string->duration arg))) (unless duration @@ -248,8 +283,7 @@ "~A: invalid duration\n" arg) (exit 1)) - (alist-cons 'new-cached-compressions-narinfo-ttl - (time-second duration) + (alist-cons 'new-narinfo-ttl (time-second duration) result)))) (option '("negative-ttl") #t #f (lambda (opt name arg result) |