branch: main
commit 1adae5b2aa62cfbcd07602cfed72111e0212a136
Author: Romain GARBAGE <[email protected]>
AuthorDate: Mon Feb 24 15:38:10 2025 +0100
register: Add support for event logging in the jobset evaluator.
* src/cuirass/base.scm (spawn-jobset-evaluator, jobset-evaluator): Add
support
for event logging.
* src/cuirass/scripts/register.scm (cuirass-register): Add support for event
logging in jobset evaluator.
Signed-off-by: Ludovic Courtès <[email protected]>
---
src/cuirass/base.scm | 17 ++++++++++++++---
src/cuirass/scripts/register.scm | 3 ++-
2 files changed, 16 insertions(+), 4 deletions(-)
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index efa3dc8..41e0d5f 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -699,10 +699,11 @@ Return a list of jobs that are associated to EVAL-ID."
(name (specification-name spec))
(id eval-id)))))))))
-(define (start-evaluation spec instances timestamp)
+(define (start-evaluation spec instances timestamp event-log)
"Start an evaluation of SPEC using the given channel INSTANCES. Return #f if
nothing has changed (and thus no new evaluation was created), otherwise return
-the ID of the new evaluation."
+the ID of the new evaluation. EVENT-LOG is a Fibers channel used to return the
+evaluation ID before the evaluation is started."
(let* ((channels (map channel-instance-channel instances))
(new-spec (specification
(inherit spec)
@@ -726,6 +727,11 @@ the ID of the new evaluation."
;; dependencies that are not declared in the initial specification
;; channels. Update the given SPEC to take them into account.
(db-add-or-update-specification new-spec)
+ ;; Since evaluate blocks until the end of evaluation, an
+ ;; evaluation-started event is sent just before starting the
+ ;; evaluation.
+ (put-message event-log
+ `(new-event (evaluation-started ,eval-id ,spec)))
(evaluate spec eval-id)
(db-set-evaluation-time eval-id)
@@ -734,6 +740,7 @@ the ID of the new evaluation."
(define* (jobset-evaluator channel
#:key
builder
+ event-log
(max-parallel-evaluations
(current-processor-count)))
(define pool
@@ -752,13 +759,15 @@ the ID of the new evaluation."
(with-resource-from-pool pool token
(log-info "evaluating '~a' with token #~a"
(specification-name spec) token)
- (start-evaluation spec instances timestamp)))
+ (start-evaluation spec instances timestamp event-log)))
(when eval-id
(let* ((builds (db-get-builds `((evaluation . ,eval-id))))
(derivations (map build-derivation builds)))
(log-info "evaluation ~a of jobset '~a' registered ~a builds"
eval-id (specification-name spec) (length builds))
+ (put-message event-log
+ `(new-event (evaluation-completed ,eval-id
,spec)))
(db-set-evaluation-status eval-id
(evaluation-status succeeded))
@@ -774,6 +783,7 @@ the ID of the new evaluation."
(define* (spawn-jobset-evaluator #:key
builder
+ event-log
(max-parallel-evaluations
(current-processor-count)))
"Spawn the actor responsible for evaluating jobsets for a given spec and set
@@ -782,6 +792,7 @@ concurrently; it sends derivation build requests to
BUILDER."
(let ((channel (make-channel)))
(spawn-fiber (jobset-evaluator channel
#:builder builder
+ #:event-log event-log
#:max-parallel-evaluations
max-parallel-evaluations))
channel))
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index 1698a8c..e977458 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -278,7 +278,8 @@
(evaluator (spawn-jobset-evaluator
#:max-parallel-evaluations
max-parallel-evaluations
- #:builder builder))
+ #:builder builder
+ #:event-log event-log-service))
(update-service (spawn-channel-update-service)))
(clear-build-queue)
