guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add a status field to Evaluation table. 

The Evaluation table currently has an 'in_progress' field. Distinction between
succeeded and failed evaluations are based on the presence of Builds records
for the evaluation. It it also not possible to distinguish aborted evaluations
from failed evaluations.

Rename 'in_progress' field to 'status'. The 'status' field can be equal to
'started', 'succeeded', 'failed' or 'aborted'.

* src/cuirass/database.scm (evaluation-status): New exported enumeration.
(db-set-evaluations-done, db-set-evaluation-done): Remove them.
(db-abort-pending-evaluations, db-set-evaluation-status): New exported procedures.
(db-add-evaluation, db-get-builds, db-get-evaluations,
db-get-evaluations-build-summary, db-get-evaluation-summary): Adapt to use
'status' field instead of 'in_progress' field.
* src/cuirass/templates.scm (evaluation-badges): Ditto.
* src/schema.sql (Evaluations): Rename 'in_progress' field to 'status'.
* src/sql/upgrade-10.sql: New file.
* bin/cuirass.in (main): Use "db-abort-pending-evaluations" instead of
"db-set-evaluations-done".
* src/cuirass/base.scm (evaluate): Use "db-set-evaluation-status" instead of
"db-set-evaluations-done".
(build-packages): Use "db-set-evaluation-status" instead of
"db-set-evaluation-done".
* tests/database.scm (sqlite-exec): Adapt accordingly.
* tests/http.scm (evaluations-query-result): Ditto.
This commit is contained in:
Mathieu Othacehe 2020-09-10 14:25:19 +02:00
parent af12a80599
commit f5b0d39328
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
8 changed files with 97 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
bin/cuirass.in
View File

@ -162,14 +162,15 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(clear-build-queue)
;; If Cuirass was stopped during an evaluation, consider
;; it done. Builds that were not registered during this
;; evaluation will be registered during the next
;; evaluation.
(db-set-evaluations-done)
;; If Cuirass was stopped during an evaluation,
;; abort it. Builds that were not registered
;; during this evaluation will be registered
;; during the next evaluation.
(db-abort-pending-evaluations)
;; First off, restart builds that had not completed or
;; were not even started on a previous run.
;; First off, restart builds that had not
;; completed or were not even started on a
;; previous run.
(spawn-fiber
(essential-task
'restart-builds exit-channel

6
src/cuirass/base.scm
View File

@ -355,7 +355,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-done eval-id) ;failed!
(db-set-evaluation-status eval-id
(evaluation-status failed))
(close-port (cdr log-pipe))
(raise (condition
(&evaluation-error
@ -729,7 +730,8 @@ by PRODUCT-SPECS."
(log-message "evaluation ~a registered ~a new derivations"
eval-id (length derivations))
(db-set-evaluation-done eval-id)
(db-set-evaluation-status eval-id
(evaluation-status succeeded))
(spawn-builds store derivations)

56
src/cuirass/database.scm
View File

@ -44,9 +44,10 @@
db-remove-specification
db-get-specification
db-get-specifications
evaluation-status
db-add-evaluation
db-set-evaluations-done
db-set-evaluation-done
db-abort-pending-evaluations
db-set-evaluation-status
db-set-evaluation-time
db-get-pending-derivations
build-status
@ -438,6 +439,12 @@ SELECT * FROM Specifications ORDER BY name DESC;")))
,(with-input-from-string build-outputs read)))
specs)))))))
(define-enumeration evaluation-status
(started -1)
(succeeded 0)
(failed 1)
(aborted 2))
(define* (db-add-evaluation spec-name checkouts
#:key
(checkouttime 0)
@ -450,9 +457,10 @@ Otherwise, return #f."
(with-db-worker-thread db
(sqlite-exec db "BEGIN TRANSACTION;")
(sqlite-exec db "INSERT INTO Evaluations (specification, in_progress,
(sqlite-exec db "INSERT INTO Evaluations (specification, status,
timestamp, checkouttime, evaltime)
VALUES (" spec-name ", true, " now "," checkouttime "," evaltime ");")
VALUES (" spec-name "," (evaluation-status started) ","
now "," checkouttime "," evaltime ");")
(let* ((eval-id (last-insert-rowid db))
(new-checkouts (filter-map
(cut db-add-checkout spec-name eval-id <>)
@ -468,18 +476,16 @@ VALUES (" spec-name ", true, " now "," checkouttime "," evaltime ");")
(sqlite-exec db "COMMIT;")
eval-id)))))
(define (db-set-evaluations-done)
(define (db-abort-pending-evaluations)
(with-db-worker-thread db
(sqlite-exec db "UPDATE Evaluations SET in_progress = false;")))
(sqlite-exec db "UPDATE Evaluations SET status =
" (evaluation-status aborted) " WHERE status = "
(evaluation-status started))))
(define (db-set-evaluation-done eval-id)
(define (db-set-evaluation-status eval-id status)
(with-db-worker-thread db
(sqlite-exec db "UPDATE Evaluations SET in_progress = false
WHERE id = " eval-id ";")
(db-add-event 'evaluation
(time-second (current-time time-utc))
`((#:evaluation . ,eval-id)
(#:in_progress . #f)))))
(sqlite-exec db "UPDATE Evaluations SET status =
" status " WHERE id = " eval-id ";")))
(define (db-set-evaluation-time eval-id)
(define now
@ -795,7 +801,7 @@ FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
;; With this order, builds in 'running' state (-1) appear
;; before those in 'scheduled' state (-2).
(('order . 'status+submission-time)
"status DESC, Builds.timestamp DESC, Builds.id ASC")
"Builds.status DESC, Builds.timestamp DESC, Builds.id ASC")
(_ "Builds.id DESC")))
(define (where-conditions filters)
@ -984,18 +990,18 @@ WHERE evaluation =" eval-id ";"))
(define (db-get-evaluations limit)
(with-db-worker-thread db
(let loop ((rows (sqlite-exec db "SELECT id, specification, in_progress,
(let loop ((rows (sqlite-exec db "SELECT id, specification, status,
timestamp, checkouttime, evaltime
FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
(evaluations '()))
(match rows
(() (reverse evaluations))
((#(id specification in-progress timestamp checkouttime evaltime)
((#(id specification status timestamp checkouttime evaltime)
. rest)
(loop rest
(cons `((#:id . ,id)
(#:specification . ,specification)
(#:in-progress . ,in-progress)
(#:status . ,status)
(#:timestamp . ,timestamp)
(#:checkouttime . ,checkouttime)
(#:evaltime . ,evaltime)
@ -1005,9 +1011,9 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
(define (db-get-evaluations-build-summary spec limit border-low border-high)
(with-db-worker-thread db
(let loop ((rows (sqlite-exec db "
SELECT E.id, E.in_progress, B.succeeded, B.failed, B.scheduled
SELECT E.id, E.status, B.succeeded, B.failed, B.scheduled
FROM
(SELECT id, in_progress
(SELECT id, status
FROM Evaluations
WHERE (specification=" spec ")
AND (" border-low "IS NULL OR (id >" border-low "))
@ -1024,10 +1030,10 @@ ORDER BY E.id ASC;"))
(evaluations '()))
(match rows
(() evaluations)
((#(id in-progress succeeded failed scheduled) . rest)
((#(id status succeeded failed scheduled) . rest)
(loop rest
(cons `((#:id . ,id)
(#:in-progress . ,in-progress)
(#:status . ,status)
(#:checkouts . ,(db-get-checkouts id))
(#:succeeded . ,(or succeeded 0))
(#:failed . ,(or failed 0))
@ -1053,10 +1059,10 @@ WHERE specification=" spec)))
(define (db-get-evaluation-summary id)
(with-db-worker-thread db
(let ((rows (sqlite-exec db "
SELECT E.id, E.in_progress, E.timestamp, E.checkouttime, E.evaltime,
SELECT E.id, E.status, E.timestamp, E.checkouttime, E.evaltime,
B.total, B.succeeded, B.failed, B.scheduled
FROM
(SELECT id, in_progress, timestamp, checkouttime, evaltime
(SELECT id, status, timestamp, checkouttime, evaltime
FROM Evaluations
WHERE (id=" id ")) E
LEFT JOIN
@ -1068,10 +1074,10 @@ ON B.evaluation=E.id
ORDER BY E.id ASC;")))
(and=> (expect-one-row rows)
(match-lambda
(#(id in-progress timestamp checkouttime evaltime
(#(id status timestamp checkouttime evaltime
total succeeded failed scheduled)
`((#:id . ,id)
(#:in-progress . ,in-progress)
(#:status . ,status)
(#:total . ,(or total 0))
(#:timestamp . ,timestamp)
(#:checkouttime . ,checkouttime)

61
src/cuirass/templates.scm
View File

@ -31,7 +31,8 @@
#:use-module (guix progress)
#:use-module (guix store)
#:use-module ((guix utils) #:select (string-replace-substring))
#:use-module ((cuirass database) #:select (build-status))
#:use-module ((cuirass database) #:select (build-status
evaluation-status))
#:export (html-page
specifications-table
evaluation-info-table
@ -372,32 +373,38 @@ system whose names start with " (code "guile-") ":" (br)
(if (string=? changes "") '(em "None") changes)))
(define (evaluation-badges evaluation)
(if (zero? (assq-ref evaluation #:in-progress))
(let ((succeeded (assq-ref evaluation #:succeeded))
(failed (assq-ref evaluation #:failed))
(scheduled (assq-ref evaluation #:scheduled)))
;; XXX: Since we don't have information in the database about whether
;; an evaluation failed, assume that it failed when it produced zero
;; build jobs.
(if (zero? (+ succeeded failed scheduled))
`((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "/log/raw")
(class "oi oi-x text-danger")
(title "Failed")
(aria-hidden "true"))
""))
`((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=succeeded")
(class "badge badge-success")
(title "Succeeded"))
,succeeded)
(a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=failed")
(class "badge badge-danger")
(title "Failed"))
,failed)
(a (@ (href "/eval/" ,(assq-ref evaluation #:id) "?status=pending")
(class "badge badge-secondary")
(title "Scheduled"))
,scheduled))))
'((em "In progress…"))))
(let ((status (assq-ref evaluation #:status)))
(if (= status (evaluation-status started))
'((em "In progress…"))
(cond
((= status (evaluation-status failed))
`((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "/log/raw")
(class "oi oi-x text-danger")
(title "Failed")
(aria-hidden "true"))
"")))
((= status (evaluation-status aborted))
`((a (@ (href "/eval/" ,(assq-ref evaluation #:id) "/log/raw")
(class "oi oi-x text-warning")
(title "Aborted")
(aria-hidden "true"))
"")))
((= status (evaluation-status succeeded))
`((a (@ (href "/eval/" ,(assq-ref evaluation #:id)
"?status=succeeded")
(class "badge badge-success")
(title "Succeeded"))
,(assq-ref evaluation #:succeeded))
(a (@ (href "/eval/" ,(assq-ref evaluation #:id)
"?status=failed")
(class "badge badge-danger")
(title "Failed"))
,(assq-ref evaluation #:failed))
(a (@ (href "/eval/" ,(assq-ref evaluation #:id)
"?status=pending")
(class "badge badge-secondary")
(title "Scheduled"))
,(assq-ref evaluation #:scheduled))))))))
(define (evaluation-info-table name evaluations id-min id-max)
"Return HTML for the EVALUATION table NAME. ID-MIN and ID-MAX are

2
src/schema.sql
View File

@ -41,7 +41,7 @@ CREATE TABLE Checkouts (
CREATE TABLE Evaluations (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification TEXT NOT NULL,
in_progress INTEGER NOT NULL,
status INTEGER NOT NULL,
timestamp INTEGER NOT NULL,
checkouttime INTEGER NOT NULL,
evaltime INTEGER NOT NULL,

12
src/sql/upgrade-10.sql Normal file
View File

@ -0,0 +1,12 @@
BEGIN TRANSACTION;
ALTER TABLE Evaluations RENAME COLUMN in_progress TO status;
-- Set all pending evaluations to aborted.
UPDATE Evaluations SET status = 2 WHERE status = 1;
-- All evaluations that did not trigger any build are set to failed.
UPDATE Evaluations SET status = 1 WHERE id NOT IN
(SELECT evaluation FROM Builds);
COMMIT;

12
tests/database.scm
View File

@ -97,14 +97,14 @@
(test-assert "sqlite-exec"
(begin
(sqlite-exec (%db) "\
INSERT INTO Evaluations (specification, in_progress,
timestamp, checkouttime, evaltime) VALUES (1, false, 0, 0, 0);")
INSERT INTO Evaluations (specification, status,
timestamp, checkouttime, evaltime) VALUES (1, 0, 0, 0, 0);")
(sqlite-exec (%db) "\
INSERT INTO Evaluations (specification, in_progress,
timestamp, checkouttime, evaltime) VALUES (2, false, 0, 0, 0);")
INSERT INTO Evaluations (specification, status,
timestamp, checkouttime, evaltime) VALUES (2, 0, 0, 0, 0);")
(sqlite-exec (%db) "\
INSERT INTO Evaluations (specification, in_progress,
timestamp, checkouttime, evaltime) VALUES (3, false, 0, 0, 0);")
INSERT INTO Evaluations (specification, status,
timestamp, checkouttime, evaltime) VALUES (3, 0, 0, 0, 0);")
(sqlite-exec (%db) "SELECT * FROM Evaluations;")))
(test-equal "db-add-specification"

2
tests/http.scm
View File

@ -78,7 +78,7 @@
(define evaluations-query-result
#(((#:id . 2)
(#:specification . "guix")
(#:in-progress . 1)
(#:status . -1)
(#:checkouts . #(((#:commit . "fakesha2")
(#:input . "savannah")
(#:directory . "dir3")))))))