[no subject]

[Ludovic Courtès]

branch: master
commit e8543d7aa9db6fb513ac454876431b4c7fa4d9c7
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 28 12:14:49 2018 +0200

    base: Add 'cancel-old-builds'.
    
    * src/cuirass/base.scm (cancel-old-builds): New procedure.
---
 src/cuirass/base.scm | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index a3fc316..7522a57 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -50,6 +50,7 @@
             compile
             evaluate
             clear-build-queue
+            cancel-old-builds
             restart-builds
             build-packages
             prepare-git
@@ -492,6 +493,14 @@ procedure is meant to be called at startup."
   (log-message "marking stale builds as \"scheduled\"...")
   (sqlite-exec db "UPDATE Builds SET status = -2 WHERE status = -1;"))
 
+(define (cancel-old-builds db age)
+  "Cancel builds older than AGE seconds."
+  (log-message "canceling builds older than ~a seconds..." age)
+  (sqlite-exec db
+               "UPDATE Builds SET status = 4 WHERE status = -2 AND timestamp < 
"
+               (- (time-second (current-time time-utc)) age)
+               ";"))
+
 (define (restart-builds db builds)
   "Restart builds whose status in DB is \"pending\" (scheduled or started)."
   (with-store store