guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

Improve worker status page queries.

Browse source
This commit is contained in:
Mathieu Othacehe 2021-03-12 17:06:30 +01:00
parent 8379c803dc
commit 6438742f99
No known key found for this signature in database
GPG key ID: 8354763531769CA6
3 changed files with 67 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
src/cuirass/database.scm
View file

@ -67,7 +67,7 @@
db-get-output
db-get-outputs
db-get-time-since-previous-build
db-get-build-percentage
db-get-build-percentages
db-register-builds
db-update-build-status!
db-update-build-worker!
@ -100,6 +100,7 @@
db-add-or-update-worker
db-get-worker
db-get-workers
db-worker-current-builds
db-remove-unresponsive-workers
db-clear-workers
db-clear-build-queue
@ -650,24 +651,28 @@ WHERE job_name = " job-name "AND specification = " specification
(string->number time))
(else #f))))
(define (db-get-build-percentage build-id)
"Return the build completion percentage for BUILD-ID."
(define (db-get-build-percentages build-ids)
(define builds
(format #f "{~a}"
(string-join
(map number->string build-ids) ",")))
(with-db-worker-thread db
(match (expect-one-row
(exec-query/bind db "
SELECT LEAST(duration::float/last_duration * 100, 100)::int AS percentage FROM
(SELECT (extract(epoch from now())::int - starttime) as duration,
last_build.duration AS last_duration FROM builds,
(SELECT GREATEST((stoptime - starttime), 1) AS duration FROM Builds
WHERE job_name IN
(SELECT job_name from Builds WHERE id = " build-id ")
AND status >= 0
ORDER BY Builds.timestamp DESC LIMIT 1) last_build
where id = " build-id ") d;
"))
((time)
(string->number time))
(else #f))))
(let loop ((rows
(exec-query/bind db "
SELECT LEAST(duration::float/last_duration * 100, 100)::int AS percentage
FROM (SELECT DISTINCT ON (b1.id) b1.id AS id,
GREATEST((b2.stoptime - b2.starttime), 1) AS last_duration,
(extract(epoch from now())::int - b1.starttime) AS duration FROM builds AS b1
LEFT JOIN builds AS b2 ON b1.job_name = b2.job_name WHERE b1.id IN
(SELECT id FROM builds WHERE id = ANY(" builds "))
AND b2.status >= 0 ORDER BY b1.id, b2.id DESC) d;"))
(percentages '()))
(match rows
(() (reverse percentages))
(((percentage) . rest)
(loop rest
(cons (string->number percentage) percentages)))))))
(define (db-register-builds jobs eval-id specification)
(define (new-outputs? outputs)
@ -1450,6 +1455,23 @@ SELECT name, address, machine, systems, last_seen from Workers"))
(last-seen (string->number last-seen)))
workers)))))))
(define (db-worker-current-builds)
"Return the list of builds that are been built on the available workers.
Multiple builds can be marked as started on the same worker if the fetching
workers do not keep up. Only pick the build with the latest start time."
(with-db-worker-thread db
(let loop ((rows (exec-query db "
SELECT DISTINCT ON (name) name, builds.id FROM Workers
INNER JOIN Builds ON workers.name = builds.worker
AND Builds.status = -1 ORDER BY name,
Builds.starttime DESC, Builds.id DESC;"))
(builds '()))
(match rows
(() (reverse builds))
(((name id) . rest)
(loop rest
(cons (db-get-build (string->number id)) builds)))))))
(define (db-remove-unresponsive-workers timeout)
"Remove the workers that are unresponsive since at least TIMEOUT seconds.
Also restart the builds that are started on those workers."

16
src/cuirass/http.scm
View file

@ -857,15 +857,13 @@ into a specification record and return it."
(html-page
"Workers status"
(let* ((workers (db-get-workers))
(builds (db-get-builds `((status . started)
(order . status+submission-time))))
(builds* (map (lambda (build)
(let* ((id (assoc-ref build #:id))
(percentage
(db-get-build-percentage id)))
`(,@build
(#:percentage . ,percentage))))
builds)))
(builds (db-worker-current-builds))
(percentages (db-get-build-percentages builds))
(builds*
(map (lambda (build percentage)
`(,@build
#:percentage . ,percentage))
builds percentages)))
(workers-status workers builds*))
'())))

22
tests/database.scm
View file

@ -450,7 +450,7 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
#:outputs `(("out" . "/bar"))))
(sort (db-get-pending-derivations) string<?)))
(test-assert "db-get-build-percentage"
(test-assert "db-get-build-percentages"
(begin
(let* ((ts (time-second (current-time time-utc)))
(old `((#:derivation . "/last.drv")
@ -479,7 +479,9 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
(match (expect-one-row
(exec-query (%db) "SELECT MAX(id) FROM Builds;"))
((id) (string->number id)))))
(>= (db-get-build-percentage last-id) 50)))))
(match (db-get-build-percentages (list last-id))
((percentage)
(>= percentage 50)))))))
(test-equal "db-update-build-status!"
(list #f 1)
@ -597,6 +599,22 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
((product)
(equal? (assq-ref product #:path) (getcwd))))))
(test-assert "db-worker-current-builds"
(begin
(let ((drv-1
(db-add-build (make-dummy-build "/build-1.drv")))
(drv-2
(db-add-build (make-dummy-build "/build-2.drv"))))
(db-add-or-update-worker %dummy-worker)
(db-update-build-worker! drv-1 "worker")
(db-update-build-worker! drv-2 "worker")
(db-update-build-status! drv-1 (build-status started))
(db-update-build-status! drv-2 (build-status started))
(match (db-worker-current-builds)
((build)
(eq? (assq-ref (db-get-build drv-2) #:id)
(assq-ref build #:id)))))))
(test-assert "db-close"
(begin
(db-close (%db))