branch: main
commit 3665686d1e1997d189059e7583e77464a7dd1e20
Author: Ludovic Courtès <[email protected]>
AuthorDate: Mon Dec 16 10:45:17 2024 +0100
register: Add ‘--build-expiry’.
* src/cuirass/base.scm (build-queue-cleaner, spawn-build-queue-cleaner):
New procedures.
* src/cuirass/scripts/register.scm (show-help, %options): Add
‘--build-expiry’.
(cuirass-register): Call ‘spawn-build-queue-cleaner’ to honor
‘--build-expiry’.
* doc/cuirass.texi (Invocation): Document it.
---
doc/cuirass.texi | 8 ++++++++
src/cuirass/base.scm | 19 +++++++++++++++++++
src/cuirass/scripts/register.scm | 9 +++++++++
3 files changed, 36 insertions(+)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 895d91f..41dddc5 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -556,6 +556,14 @@ years.
This periodic cleanup ensures the database does not grow indefinitely.
It can also make some operations faster.
+@item --build-expiry=@var{duration}
+Periodically cancel pending builds older than @var{duration}, 4 months
+by default.
+
+This ensures that the backlog does not grow endlessly. Use a low value
+like @code{2w} (two weeks) when build freshness is more important than
+completeness.
+
@item --interval=@var{n}
@itemx -I @var{n}
Wait at most @var{n} seconds between each poll.
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 58dc63b..4b895c6 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -75,6 +75,7 @@
spawn-jobset-registry
spawn-gc-root-cleaner
spawn-build-maintainer
+ spawn-build-queue-cleaner
spawn-database-cleaner
lookup-jobset
@@ -1061,6 +1062,24 @@ one of the following symbols denoting the specific
maintenance task requested:
(spawn-fiber (build-maintainer channel #:period period))
channel))
+(define (build-queue-cleaner period expiry)
+ (log-info "pending builds older than ~as will be canceled every ~as"
+ expiry period)
+ (let loop ()
+ (db-cancel-old-pending-builds expiry)
+ (sleep period)
+ (loop)))
+
+(define* (spawn-build-queue-cleaner expiry #:optional (period (* 24 3600)))
+ "Spawn an agent that periodically cancels pending builds that are more than
+EXPIRY second old.
+
+In an ideal world, it won't find anything to cancel; in practice, that can
+prove to be useful for underpowered targets, where freshness matters more than
+completeness."
+ (spawn-fiber (build-queue-cleaner period expiry))
+ #t)
+
(define* (spawn-database-cleaner evaluation-max-age
#:optional (period (* 3600 24 7)))
"Spawn an agent that, every PERIOD seconds, removes evaluations older than
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index ce0f048..faab032 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -58,6 +58,8 @@
Keep build derivations live for at least DURATION.
--evaluation-ttl=DURATION
Remove evaluations older than DURATION.
+ --build-expiry=DURATION
+ Cancel pending builds older than DURATION.
-I, --interval=N Wait at most N seconds between each poll
--build-remote Use the remote build mechanism
--parallel-evaluations=N
@@ -83,6 +85,7 @@
(ttl (value #t))
(derivation-ttl (value #t))
(evaluation-ttl (value #t))
+ (build-expiry (value #t))
(version (single-char #\V) (value #f))
(help (single-char #\h) (value #f))))
@@ -248,6 +251,9 @@
(evaluation-ttl (time-second
(string->duration
(option-ref opts 'evaluation-ttl "24m"))))
+ (build-expiry (time-second
+ (string->duration
+ (option-ref opts 'build-expiry "4m"))))
(max-parallel-evaluations
(or (and=> (option-ref opts 'parallel-evaluations #f)
string->number)
@@ -317,6 +323,9 @@
;; Periodically delete old evaluations and builds.
(spawn-database-cleaner evaluation-ttl)
+ ;; Periodically cancel old pending builds.
+ (spawn-build-queue-cleaner build-expiry)
+
(spawn-fiber
(essential-task
'metrics exit-channel
