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:
parent
06b8af00fb
commit
dd30a1a25c
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue