From 37b7c568ed53aa6e49ae5bbd6a8b5a7b5ad1a1d5 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 10 Feb 2025 10:53:24 +0000
Subject: [PATCH] Make the job timeout configurable

---
 guix-data-service/jobs.scm                | 16 ++++++++--------
 scripts/guix-data-service-process-jobs.in | 14 ++++++++++++--
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
index 3eb8403..b045133 100644
--- a/guix-data-service/jobs.scm
+++ b/guix-data-service/jobs.scm
@@ -147,7 +147,9 @@ WHERE load_new_guix_revision_jobs.id = $1"
                        ignore-systems
                        ignore-targets
                        (free-space-requirement
-                        (* 2 (expt 2 30)))) ; 2G
+                        ;; 2G
+                        (* 2 (expt 2 30)))
+                       timeout)
   (define (fetch-new-jobs)
     (let ((free-space (free-disk-space "/gnu/store")))
       (if (< free-space free-space-requirement)
@@ -204,7 +206,8 @@ WHERE load_new_guix_revision_jobs.id = $1"
                              handle-job-failure
                              #:max-processes max-processes
                              #:priority-max-processes
-                             latest-branch-revision-max-processes))
+                             latest-branch-revision-max-processes
+                             #:timeout timeout))
 
 
 (define* (log-for-job conn job-id
@@ -312,10 +315,6 @@ WHERE job_id = $1")
                  4))
        1))
 
-(define default-timeout
-  (* (* 60 60) ;; 1 hour in seconds
-     72))
-
 (define* (process-jobs-concurrently
           fetch-new-jobs
           process-job
@@ -324,7 +323,7 @@ WHERE job_id = $1")
           #:key
           (max-processes default-max-processes)
           (priority-max-processes (* 2 max-processes))
-          (timeout default-timeout))
+          timeout)
 
   (define processes
     (make-hash-table))
@@ -424,7 +423,8 @@ WHERE job_id = $1")
       (atomic-box-set! exit? #t)))
 
   (while #t
-    (kill-long-running-processes)
+    (when timeout
+      (kill-long-running-processes))
     (wait-on-processes)
     (display-status)
 
diff --git a/scripts/guix-data-service-process-jobs.in b/scripts/guix-data-service-process-jobs.in
index 64f9ad2..dc666be 100644
--- a/scripts/guix-data-service-process-jobs.in
+++ b/scripts/guix-data-service-process-jobs.in
@@ -70,14 +70,22 @@
                 (lambda (opt name arg result)
                   (alist-cons 'ignore-targets
                               (string-split arg #\,)
+                              result)))
+        (option '("timeout") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'timeout
+                              (string->number arg)
                               result)))))
 
+
 (define %default-options
   ;; Alist of default option values
   `((max-processes . ,default-max-processes)
     (per-job-parallelism . 1)
     (ignore-systems . ())
-    (ignore-targets . ())))
+    (ignore-targets . ())
+    (timeout        . ,(* (* 60 60) ;; 1 hour in seconds
+                          72))))
 
 (define (parse-options args)
   (args-fold
@@ -130,7 +138,9 @@
                 #:ignore-systems (assq-ref opts 'ignore-systems)
                 #:ignore-targets (assq-ref opts 'ignore-targets)
                 #:free-space-requirement
-                (assq-ref opts 'free-space-requirement)))
+                (assq-ref opts 'free-space-requirement)
+                #:timeout
+                (assq-ref opts 'timeout)))
              (lambda _
                (backtrace))))
        #:unwind? #t))))