diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-03-24 09:30:06 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-03-25 14:00:41 +0000 |
| commit | a1b49b3b45e5484cb93419be3711b6ab85495bee (patch) | |
| tree | 973269e542b4e92705ca19fae2360b2eeec5cf11 /scripts | |
| parent | a865c013ddc5ab7a20dfef75cb3a776ea9ccfe16 (diff) | |
| download | nar-herder-a1b49b3b45e5484cb93419be3711b6ab85495bee.tar nar-herder-a1b49b3b45e5484cb93419be3711b6ab85495bee.tar.gz | |
Rework the cached compressions system
The initial implementation was flawed since guix assumes that any
compression mentioned in the narinfo will be available for the
lifetime of the narinfo, and the nar-herder was deleting cached
compressions without taking this in to account.
This commit adds support for scheduling the removal of a cached
compression and this schedule is used to inform the TTLs for narinfos.
I'm unsure of the value in caching narinfos so maybe some of this
complexity can be removed in the future.
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) |