base: Restart pending builds upfront.

* src/cuirass/database.scm (db-get-builds)[format-where-clause]:
Honor (status pending) filter.
* src/cuirass/base.scm (restart-builds): New procedure.
* bin/cuirass.in (main): Fetch pending builds.  Start fiber that invokes
'restart-builds' on them.
This commit is contained in:
Ludovic Courtès 2018-01-23 23:15:10 +01:00
parent 06b8af00fb
commit dd30a1a25c
3 changed files with 39 additions and 1 deletions

View File

@ -107,7 +107,15 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
new-specs)))
(if one-shot?
(process-specs db (db-get-specifications db))
(begin
(let ((pending (db-get-builds db '((status pending)))))
;; First off, restart builds that had not completed or
;; were not even started on a previous run.
(spawn-fiber
(lambda ()
(with-store store
(with-database db
(restart-builds store db pending)))))
(spawn-fiber
(lambda ()
(with-database db
@ -115,6 +123,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(process-specs db (db-get-specifications db))
(log-message "sleeping for ~a seconds" interval)
(sleep interval)))))
(with-database db
(run-cuirass-server db
#:host host

View File

@ -37,6 +37,7 @@
#:use-module (ice-9 receive)
#:use-module (ice-9 threads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@ -47,6 +48,7 @@
fetch-repository
compile
evaluate
restart-builds
build-packages
prepare-git
process-specs
@ -291,6 +293,31 @@ updating DB accordingly."
(_
(log-message "build event: ~s" event))))
(define (restart-builds store db builds)
"Restart builds whose status in DB is \"pending\" (scheduled or started)."
(let-values (((valid stale)
(partition (lambda (build)
(let ((drv (assq-ref build #:derivation)))
(valid-path? store drv)))
builds)))
;; We cannot restart builds listed in STALE, so mark them as canceled.
(log-message "canceling ~a pending builds" (length stale))
(for-each (lambda (build)
(db-update-build-status! db (assq-ref build #:derivation)
(build-status canceled)))
stale)
;; Those in VALID can be restarted.
(log-message "restarting ~a pending builds" (length valid))
(parameterize ((current-build-output-port
(build-event-output-port (lambda (event status)
(handle-build-event db event))
#t)))
(build-derivations store
(map (lambda (build)
(assq-ref build #:derivation))
valid)))))
(define (build-packages store db jobs)
"Build JOBS and return a list of Build results."
(define (register job)

View File

@ -320,6 +320,8 @@ FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
(format #f "Derivations.system='~A'" system))
(('status 'done)
"Builds.status >= 0")
(('status 'pending)
"Builds.status < 0")
(_ #f)))
filters)))
(if (> (length where-clause) 0)