cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make the job timeout configurable

Browse source
This commit is contained in:
Christopher Baines 2025-02-10 10:53:24 +00:00
parent 131967dc39
commit 37b7c568ed
2 changed files with 20 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

16
guix-data-service/jobs.scm
View file

@ -147,7 +147,9 @@ WHERE load_new_guix_revision_jobs.id = $1"
ignore-systems ignore-systems
ignore-targets ignore-targets
(free-space-requirement (free-space-requirement
(* 2 (expt 2 30)))) ; 2G ;; 2G
(* 2 (expt 2 30)))
timeout)
(define (fetch-new-jobs) (define (fetch-new-jobs)
(let ((free-space (free-disk-space "/gnu/store"))) (let ((free-space (free-disk-space "/gnu/store")))
(if (< free-space free-space-requirement) (if (< free-space free-space-requirement)
@ -204,7 +206,8 @@ WHERE load_new_guix_revision_jobs.id = $1"
handle-job-failure handle-job-failure
#:max-processes max-processes #:max-processes max-processes
#:priority-max-processes #:priority-max-processes
latest-branch-revision-max-processes)) latest-branch-revision-max-processes
#:timeout timeout))
(define* (log-for-job conn job-id (define* (log-for-job conn job-id
@ -312,10 +315,6 @@ WHERE job_id = $1")
4)) 4))
1)) 1))
(define default-timeout
(* (* 60 60) ;; 1 hour in seconds
72))
(define* (process-jobs-concurrently (define* (process-jobs-concurrently
fetch-new-jobs fetch-new-jobs
process-job process-job
@ -324,7 +323,7 @@ WHERE job_id = $1")
#:key #:key
(max-processes default-max-processes) (max-processes default-max-processes)
(priority-max-processes (* 2 max-processes)) (priority-max-processes (* 2 max-processes))
(timeout default-timeout)) timeout)
(define processes (define processes
(make-hash-table)) (make-hash-table))
@ -424,7 +423,8 @@ WHERE job_id = $1")
(atomic-box-set! exit? #t))) (atomic-box-set! exit? #t)))
(while #t (while #t
(kill-long-running-processes) (when timeout
(kill-long-running-processes))
(wait-on-processes) (wait-on-processes)
(display-status) (display-status)

14
scripts/guix-data-service-process-jobs.in
View file

@ -70,14 +70,22 @@
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'ignore-targets (alist-cons 'ignore-targets
(string-split arg #\,) (string-split arg #\,)
result)))
(option '("timeout") #t #f
(lambda (opt name arg result)
(alist-cons 'timeout
(string->number arg)
result))))) result)))))
(define %default-options (define %default-options
;; Alist of default option values ;; Alist of default option values
`((max-processes . ,default-max-processes) `((max-processes . ,default-max-processes)
(per-job-parallelism . 1) (per-job-parallelism . 1)
(ignore-systems . ()) (ignore-systems . ())
(ignore-targets . ()))) (ignore-targets . ())
(timeout . ,(* (* 60 60) ;; 1 hour in seconds
72))))
(define (parse-options args) (define (parse-options args)
(args-fold (args-fold
@ -130,7 +138,9 @@
#:ignore-systems (assq-ref opts 'ignore-systems) #:ignore-systems (assq-ref opts 'ignore-systems)
#:ignore-targets (assq-ref opts 'ignore-targets) #:ignore-targets (assq-ref opts 'ignore-targets)
#:free-space-requirement #:free-space-requirement
(assq-ref opts 'free-space-requirement))) (assq-ref opts 'free-space-requirement)
#:timeout
(assq-ref opts 'timeout)))
(lambda _ (lambda _
(backtrace)))) (backtrace))))
#:unwind? #t)))) #:unwind? #t))))