[no subject]

[Mathieu Othacehe]

branch: master
commit 0b19e82adc0582cc3c17e1a54444ca139a6779dd
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Feb 24 12:42:29 2021 +0100

    Restart the builds on unresponsive workers.
    
    * src/cuirass/database.scm (db-remove-unresponsive-workers): Restart the
    builds that are started on unresponsive workers.
    * tests/database.scm ("db-remove-unresponsive-workers"): Test it.
---
 src/cuirass/database.scm | 10 ++++++++++
 tests/database.scm       | 15 +++++++++++----
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 815636f..f9bba93 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1504,7 +1504,17 @@ SELECT name, address, machine, systems, last_seen from 
Workers"))
                      workers)))))))
 
 (define (db-remove-unresponsive-workers timeout)
+  "Remove the workers that are unresponsive since at least TIMEOUT seconds.
+Also restart the builds that are started on those workers."
   (with-db-worker-thread db
+    ;; Restart the builds that are marked as started on those workers.
+    (exec-query/bind db "
+UPDATE Builds SET status = -2, worker = null FROM
+(SELECT id FROM Workers LEFT JOIN Builds
+ON builds.worker = workers.name
+WHERE status = -1 AND
+(extract(epoch from now())::int - last_seen) > " timeout
+") AS expired WHERE builds.id = expired.id")
     (exec-query/bind db "DELETE FROM Workers WHERE
 (extract(epoch from now())::int - last_seen) > " timeout ";")))
 
diff --git a/tests/database.scm b/tests/database.scm
index f591e7a..03fdd65 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -361,11 +361,18 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
     (list %dummy-worker)
     (db-get-workers))
 
-  (test-equal "db-remove-unresponsive-workers"
-    '()
+  (test-assert "db-remove-unresponsive-workers"
     (begin
-      (db-remove-unresponsive-workers 50)
-      (db-get-workers)))
+      (let ((drv "/foo.drv"))
+        (db-update-build-worker! drv "worker")
+        (db-update-build-status! drv (build-status started))
+        (db-remove-unresponsive-workers 50)
+        (and (eq? (db-get-workers) '())
+             (let* ((build (db-get-build drv))
+                    (worker (assq-ref build #:worker))
+                    (status (assq-ref build #:status)))
+               (and (not worker)
+                    (eq? status (build-status scheduled))))))))
 
   (test-equal "db-clear-workers"
     '()