[no subject]

[Ludovic Courtès]

branch: main
commit 57bc09edeccb26edf6fd071f5451dc45b85781c3
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Dec 16 10:36:57 2024 +0100

    database: Add ‘db-cancel-old-pending-builds’.
    
    * src/cuirass/database.scm (db-cancel-old-pending-builds): New
    procedure.
---
 src/cuirass/database.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index abc3636..5444f5d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -220,6 +220,7 @@
             db-remove-workers
             db-clear-workers
             db-clear-build-queue
+            db-cancel-old-pending-builds
             db-get-log-from-output
             ;; Parameters.
             %create-database?
@@ -2316,6 +2317,17 @@ WHERE status = " (build-status submitted) " AND
         (log-info "rescheduled ~a builds submitted more than ~as ago"
                   rescheduled %build-submission-timeout)))))
 
+(define (db-cancel-old-pending-builds age)
+  "Cancel pending builds that were queued more than AGE seconds ago."
+  (with-db-connection db
+    (let ((canceled (exec-query/bind db "\
+UPDATE Builds SET status = " (build-status canceled) "
+ WHERE status = " (build-status scheduled) "
+   AND timestamp < (extract (epoch from now())::int - " age ");")))
+      (unless (zero? canceled)
+        (log-info "canceled ~a pending builds submitted more than ~as ago"
+                  canceled age)))))
+
 (define (db-remove-workers names)
   "Remove workers with any of the given NAMES.
 Also restart the builds that were started on those workers."