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

Save evaluations and checkouts timestamps. 

src/cuirass/base.scm (fetch-input): Add the commit timestamp to the returned
association list,
(process-specs): Pass a timestamp taken at procedure start and another one
taken after inputs are fetched to "db-add-evaluation" procedure. Once the
evaluation is over, call "db-set-evaluation-time" to save the evaluation
completion time.
src/cuirass/database.scm (db-set-evaluation-time): New procedure,
(db-add-checkout): Handle the "timestamp" field,
(db-add-evaluation): add "checkouttime" and "evaltime" arguments. Modify the
associated SQL query accordingly.
(db-get-builds): Use "Builds.timestamp" instead of "timestamp" as this field
is also part of the Evaluations table.
src/schema.sql (Checkouts): Add "timestamp" field,
(Evaluations): add "timestamp", "checkouttime" and "evaltime" fields.
src/sql/upgrade-9.sql: New file.
tests/database.scm (sqlite-exec): Adapt Evaluations table insertions to include
"timestamp", "checkouttime" and "evaltime" required fields.
This commit is contained in:
Mathieu Othacehe 2020-09-06 13:03:08 +02:00
parent b135a02bf2
commit 154232bc76
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
5 changed files with 65 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/cuirass/base.scm
View File

@ -198,6 +198,10 @@ read-only directory."
branch
(string-append "origin/" branch)))
(define (commit-timestamp directory commit)
(with-repository directory repository
(commit-time (commit-lookup repository (string->oid commit)))))
(let ((name (assq-ref input #:name))
(url (assq-ref input #:url))
(branch (and=> (assq-ref input #:branch)
@ -209,10 +213,15 @@ read-only directory."
(tag (and=> (assq-ref input #:tag)
(lambda (t)
`(tag . ,t)))))
(let-values (((directory commit)
(latest-repository-commit store url
#:cache-directory (%package-cachedir)
#:ref (or branch commit tag))))
(let*-values (((directory commit)
(latest-repository-commit store url
#:cache-directory
(%package-cachedir)
#:ref (or branch commit tag)))
((timestamp)
(commit-timestamp
(url-cache-directory url (%package-cachedir))
commit)))
;; TODO: When WRITABLE-COPY? is true, we could directly copy the
;; checkout directly in a writable location instead of copying it to the
;; store first.
@ -224,6 +233,7 @@ read-only directory."
`((#:input . ,name)
(#:directory . ,directory)
(#:commit . ,commit)
(#:timestamp . ,timestamp)
(#:load-path . ,(assq-ref input #:load-path))
(#:no-compile? . ,(assq-ref input #:no-compile?)))))))
@ -809,8 +819,12 @@ by PRODUCT-SPECS."
(define (process spec)
(with-store store
(let* ((name (assoc-ref spec #:name))
(timestamp (time-second (current-time time-utc)))
(checkouts (fetch-inputs spec))
(eval-id (db-add-evaluation name checkouts)))
(checkouttime (time-second (current-time time-utc)))
(eval-id (db-add-evaluation name checkouts
#:timestamp timestamp
#:checkouttime checkouttime)))
(when eval-id
(compile-checkouts spec (filter compile? checkouts))
(spawn-fiber
@ -824,6 +838,7 @@ by PRODUCT-SPECS."
(log-message "evaluating spec '~a'" name)
(with-store store
(let ((jobs (evaluate store spec eval-id checkouts)))
(db-set-evaluation-time eval-id)
(log-message "building ~a jobs for '~a'"
(length jobs) name)
(build-packages store jobs eval-id))))))

33
src/cuirass/database.scm
View File

@ -47,6 +47,7 @@
db-add-evaluation
db-set-evaluations-done
db-set-evaluation-done
db-set-evaluation-time
db-get-pending-derivations
build-status
db-add-build
@ -336,12 +337,13 @@ the same revision already exists for SPEC-NAME, return #f."
(catch-sqlite-error
(sqlite-exec db "\
INSERT INTO Checkouts (specification, revision, evaluation, input,
directory) VALUES ("
directory, timestamp) VALUES ("
spec-name ", "
(assq-ref checkout #:commit) ", "
eval-id ", "
(assq-ref checkout #:input) ", "
(assq-ref checkout #:directory) ");")
(assq-ref checkout #:directory) ", "
(or (assq-ref checkout #:timestamp) 0) ");")
(last-insert-rowid db)
;; If we get a unique-constraint-failed error, that means we have
@ -436,13 +438,21 @@ SELECT * FROM Specifications ORDER BY name DESC;")))
,(with-input-from-string build-outputs read)))
specs)))))))
(define (db-add-evaluation spec-name checkouts)
(define* (db-add-evaluation spec-name checkouts
#:key
(checkouttime 0)
(evaltime 0)
timestamp)
"Add a new evaluation for SPEC-NAME only if one of the CHECKOUTS is new.
Otherwise, return #f."
(define now
(or timestamp (time-second (current-time time-utc))))
(with-db-worker-thread db
(sqlite-exec db "BEGIN TRANSACTION;")
(sqlite-exec db "INSERT INTO Evaluations (specification, in_progress)
VALUES (" spec-name ", true);")
(sqlite-exec db "INSERT INTO Evaluations (specification, in_progress,
timestamp, checkouttime, evaltime)
VALUES (" spec-name ", true, " now "," checkouttime "," evaltime ");")
(let* ((eval-id (last-insert-rowid db))
(new-checkouts (filter-map
(cut db-add-checkout spec-name eval-id <>)
@ -471,6 +481,15 @@ WHERE id = " eval-id ";")
`((#:evaluation . ,eval-id)
(#:in_progress . #f)))))
(define (db-set-evaluation-time eval-id)
(define now
(time-second (current-time time-utc)))
(with-db-worker-thread
db
(sqlite-exec db "UPDATE Evaluations SET evaltime = " now
"WHERE id = " eval-id ";")))
(define-syntax-rule (with-database body ...)
"Run BODY with %DB-CHANNEL being dynamically bound to a channel providing a
worker thread that allows database operations to run without intefering with
@ -772,11 +791,11 @@ FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
(('order . 'finish-time) "stoptime DESC")
(('order . 'finish-time+build-id) "stoptime DESC, Builds.id DESC")
(('order . 'start-time) "starttime DESC")
(('order . 'submission-time) "timestamp DESC")
(('order . 'submission-time) "Builds.timestamp DESC")
;; With this order, builds in 'running' state (-1) appear
;; before those in 'scheduled' state (-2).
(('order . 'status+submission-time)
"status DESC, timestamp DESC, Builds.id ASC")
"status DESC, Builds.timestamp DESC, Builds.id ASC")
(_ "Builds.id DESC")))
(define (where-conditions filters)

4
src/schema.sql
View File

@ -31,6 +31,7 @@ CREATE TABLE Checkouts (
evaluation INTEGER NOT NULL,
input TEXT NOT NULL,
directory TEXT NOT NULL,
timestamp INTEGER NOT NULL,
PRIMARY KEY (specification, revision),
FOREIGN KEY (evaluation) REFERENCES Evaluations (id),
FOREIGN KEY (specification) REFERENCES Specifications (name),
@ -41,6 +42,9 @@ CREATE TABLE Evaluations (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification TEXT NOT NULL,
in_progress INTEGER NOT NULL,
timestamp INTEGER NOT NULL,
checkouttime INTEGER NOT NULL,
evaltime INTEGER NOT NULL,
FOREIGN KEY (specification) REFERENCES Specifications (name)
);

9
src/sql/upgrade-9.sql Normal file
View File

@ -0,0 +1,9 @@
BEGIN TRANSACTION;
ALTER TABLE Evaluations ADD timestamp INTEGER NOT NULL DEFAULT 0;
ALTER TABLE Evaluations ADD checkouttime INTEGER NOT NULL DEFAULT 0;
ALTER TABLE Evaluations ADD evaltime INTEGER NOT NULL DEFAULT 0;
ALTER TABLE Checkouts ADD timestamp INTEGER NOT NULL DEFAULT 0;
COMMIT;

9
tests/database.scm
View File

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