diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-03-29 09:45:00 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-03-29 09:45:00 +0100 |
| commit | 9d875a4f4fdc8c4a40983038a78512203d4924e0 (patch) | |
| tree | e811b7c01639d9b44fca8f073b8292f148dd9d0d | |
| parent | ba006b2cd3ea52a39f422c6259e04ec63e9d08e4 (diff) | |
| download | build-coordinator-9d875a4f4fdc8c4a40983038a78512203d4924e0.tar build-coordinator-9d875a4f4fdc8c4a40983038a78512203d4924e0.tar.gz | |
Guard against exceptions in the thread pool monitor thread
As I've seen the dreaded encoding-error here now that there's some logging.
| -rw-r--r-- | guix-build-coordinator/utils.scm | 60 |
1 files changed, 34 insertions, 26 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index c2e503f..965edde 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -1290,32 +1290,40 @@ References: ~a~%" (lambda () (lock-mutex pool-mutex) (while #t - (let ((idle-threads (hash-count (lambda (index val) - (eq? #f val)) - running-job-args))) - - (let ((thread-info - (hash-fold - (lambda (k v result) - (string-append - result - (simple-format #f " ~A: ~A" k v))) - "" - running-job-args))) - (unless (string-null? thread-info) - (display - (string-append - (simple-format #f "~A thread pool: " name) - thread-info - "\n\n")))) - - (when (= 0 idle-threads) - (start-new-threads-if-necessary (get-thread-count)))) - - (wait-condition-variable - job-available - pool-mutex - (+ 15 (time-second (current-time))))))) + (with-exception-handler + (lambda _ + ;; Things are going really wrong, we probably can't even + ;; log without risking another exception, so just sleep and + ;; try again. + (sleep 10)) + (lambda () + (let ((idle-threads (hash-count (lambda (index val) + (eq? #f val)) + running-job-args))) + + (let ((thread-info + (hash-fold + (lambda (k v result) + (string-append + result + (simple-format #f " ~A: ~A" k v))) + "" + running-job-args))) + (unless (string-null? thread-info) + (display + (string-append + (simple-format #f "~A thread pool: " name) + thread-info + "\n\n")))) + + (when (= 0 idle-threads) + (start-new-threads-if-necessary (get-thread-count)))) + + (wait-condition-variable + job-available + pool-mutex + (+ 15 (time-second (current-time))))) + #:unwind? #t)))) (start-new-threads-if-necessary (get-thread-count))) |