[no subject]

[Ludovic Courtès]

branch: master
commit dd30a1a25cd419614656a70b98adbe26e181458f
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 23 23:15:10 2018 +0100

    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.
---
 bin/cuirass.in           | 11 ++++++++++-
 src/cuirass/base.scm     | 27 +++++++++++++++++++++++++++
 src/cuirass/database.scm |  2 ++
 3 files changed, 39 insertions(+), 1 deletion(-)

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:address@hidden@} --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:address@hidden@} --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)