branch: main
commit f9797893145dd6ca7712efb7af6180a1f8e35c87
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Tue Apr 1 11:42:08 2025 +0200
base: Fail-safe if an evaluation’s spec was removed.
Evaluations might start or complete after their corresponding
specification has been removed. Swallow “foreign key constraint
violations” errors that occur in such situations.
* src/cuirass/database.scm (db-add-evaluation/fail-safe)
(db-set-evaluation-status/fail-safe): New procedures.
* src/cuirass/base.scm (evaluate, start-evaluation)
(jobset-evaluator): Use them.
---
src/cuirass/base.scm | 15 ++++++++-------
src/cuirass/database.scm | 33 +++++++++++++++++++++++++++++++++
2 files changed, 41 insertions(+), 7 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index cc17ead..479b976 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -684,8 +684,8 @@ Return a list of jobs that are associated to EVAL-ID."
;; otherwise, suppose that data read from port are
;; correct and keep things going.
((? eof-object?)
- (db-set-evaluation-status eval-id
- (evaluation-status failed))
+ (db-set-evaluation-status/fail-safe eval-id spec
+ (evaluation-status
failed))
#f)
(_ #t))))
(close-port (cdr log-pipe))
@@ -715,9 +715,10 @@ evaluation ID before the evaluation is started."
;; Include possible channel dependencies
(channels channels)))
(checkouttime (time-second (current-time time-utc)))
- (eval-id (db-add-evaluation (specification-name spec) instances
- #:timestamp timestamp
- #:checkouttime checkouttime)))
+ (eval-id (db-add-evaluation/fail-safe (specification-name spec)
+ instances
+ #:timestamp timestamp
+ #:checkouttime checkouttime)))
(and eval-id
(guard (c ((evaluation-error? c)
@@ -771,8 +772,8 @@ evaluation ID before the evaluation is started."
(derivations (map build-derivation builds)))
(log-info "evaluation ~a of jobset '~a' registered ~a builds"
eval-id (specification-name spec) (length builds))
- (db-set-evaluation-status eval-id
- (evaluation-status succeeded))
+ (db-set-evaluation-status/fail-safe eval-id spec
+ (evaluation-status
succeeded))
;; Register a GC root for each derivation so that they are not
;; garbage collected before getting built.
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 6e0923d..fd366c7 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -154,9 +154,11 @@
db-get-specifications
evaluation-status
db-add-evaluation
+ db-add-evaluation/fail-safe
db-abort-pending-evaluations
db-remove-old-evaluations
db-set-evaluation-status
+ db-set-evaluation-status/fail-safe
db-set-evaluation-time
build-status
build-weather
@@ -709,6 +711,25 @@ RETURNING id;"))
(rollback #f)
eval-id)))))
+(define* (db-add-evaluation/fail-safe spec-name instances
+ #:key
+ (checkouttime 0)
+ (evaltime 0)
+ timestamp)
+ "Like 'db-add-evaluation', but catch errors that might occur for
+example of SPEC was deleted from the database in the meantime. Return the
+evaluation ID if it was inserted and #f otherwise."
+ (catch 'psql-query-error
+ (lambda ()
+ (db-add-evaluation spec-name instances
+ #:checkouttime checkouttime
+ #:evaltime evaltime
+ #:timestamp timestamp))
+ (lambda (key . args)
+ (log-error "failed to add evaluation for jobset '~a': ~s"
+ spec-name args)
+ #f)))
+
(define (db-abort-pending-evaluations)
(with-db-connection db
(exec-query/bind db "UPDATE Evaluations SET status =
@@ -720,6 +741,18 @@ RETURNING id;"))
(exec-query/bind db "UPDATE Evaluations SET status =
" status " WHERE id = " eval-id ";")))
+(define (db-set-evaluation-status/fail-safe eval-id spec status)
+ "Like 'db-set-evaluation-status', but catch errors that might occur for
+example of SPEC was deleted from the database in the meantime."
+ (catch 'psql-query-error
+ (lambda ()
+ (db-set-evaluation-status eval-id status))
+ (lambda (key . args)
+ (log-error "failed to update evaluation ~a of \
+jobset '~a': ~s"
+ eval-id (specification-name spec))
+ #f)))
+
(define (db-set-evaluation-time eval-id)
(define now
(time-second (current-time time-utc)))
