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.

2 files changed, 29 insertions, 0 deletions

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)