diff options
| -rw-r--r-- | bin/cuirass.in | 11 | ||||
| -rw-r--r-- | src/cuirass/base.scm | 27 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 2 |
3 files changed, 39 insertions, 1 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index 4553567..56db386 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -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 diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index d125a3f..295c64b 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -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) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 869f8cc..4b6b062 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -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) |