aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-12-06 17:59:29 +0000
committerChristopher Baines <mail@cbaines.net>2023-12-06 17:59:29 +0000
commit65bbc4d8629be2d74a3399e6911010f614527af5 (patch)
tree953fca0403ce9fe73f1251809aab70c3ffbfaec5
parent71422515ecc05bb67a715050bc1a5ff27e51f0f0 (diff)
downloadbuild-coordinator-65bbc4d8629be2d74a3399e6911010f614527af5.tar
build-coordinator-65bbc4d8629be2d74a3399e6911010f614527af5.tar.gz
Guard against exceptions in the thread pool
-rw-r--r--guix-build-coordinator/utils.scm19
1 files changed, 16 insertions, 3 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 7fe0470..e07ed9b 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -1066,7 +1066,20 @@ References: ~a~%"
((number? thread-count-parameter)
(const thread-count-parameter))
(else
- thread-count-parameter)))
+ (lambda ()
+ (with-exception-handler
+ (lambda (exn)
+ (count-threads))
+ thread-count-parameter
+ #:unwind? #t)))))
+
+ (define (get-job/safe running-jobs)
+ (with-exception-handler
+ (lambda (exn)
+ #f)
+ (lambda ()
+ (get-job running-jobs))
+ #:unwind? #t))
(define (count-threads)
(hash-count (const #t) running-job-args))
@@ -1137,12 +1150,12 @@ References: ~a~%"
#f)
(let ((job-args
- (or (get-job (list-jobs))
+ (or (get-job/safe (list-jobs))
;; #f from wait-condition-variable indicates a timeout
(if (wait-condition-variable
job-available
pool-mutex)
- (get-job (list-jobs))
+ (get-job/safe (list-jobs))
#f))))
(if job-args
(begin