diff options
author | Christopher Baines <mail@cbaines.net> | 2021-01-22 10:01:23 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-01-22 10:01:23 +0000 |
commit | 3673bda6064038bd56469993d4df5487b7054a53 (patch) | |
tree | 2008a6928d566940a2f635d3244e2af037d3c972 | |
parent | 9e696733ac638acbb3c47197b2484cb6ecbc76a0 (diff) | |
download | build-coordinator-3673bda6064038bd56469993d4df5487b7054a53.tar build-coordinator-3673bda6064038bd56469993d4df5487b7054a53.tar.gz |
Don't use with-exception-handler with (backtrace)
With with-exception-handler being called with #:unwind? #f (implicitly). This
breaks Guile internals used by (backtrace) [1], meaning you get a different
exception/backtrace when Guile itself breaks.
This should avoid the "string->number: Wrong type argument in position
1 (expecting string): #f" exception I've been haunted by for the last year.
1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=46009
-rw-r--r-- | guix-build-coordinator/agent-messaging/http/server.scm | 37 | ||||
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 30 | ||||
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 20 | ||||
-rw-r--r-- | guix-build-coordinator/utils.scm | 15 | ||||
-rw-r--r-- | guix-build-coordinator/utils/fibers.scm | 15 |
5 files changed, 46 insertions, 71 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm index 8a5e990..338bab6 100644 --- a/guix-build-coordinator/agent-messaging/http/server.scm +++ b/guix-build-coordinator/agent-messaging/http/server.scm @@ -427,26 +427,21 @@ port. Also, the port used can be changed by passing the --port option.\n" (render-json `((error . ,(agent-error-details exn))) #:code 400) - (begin - (match method-and-path-components - ((method path-components ...) - (simple-format - (current-error-port) - "error: when processing: /~A ~A\n ~A" - method (string-join path-components "/") - exn))) - (render-json - `((error . ,(simple-format #f "~A" exn))) - #:code 500)))) + (render-json + `((error . ,(simple-format #f "~A" exn))) + #:code 500))) (lambda () - (with-exception-handler - (lambda (exn) - (catch #t - (lambda () - (backtrace)) - (lambda (key . args) - (simple-format (current-error-port) - "error: guile crashed printing backtrace\n"))) - (raise-exception exn)) - controller-thunk)) + (with-throw-handler #t + controller-thunk + (lambda (key . args) + (unless (and (eq? '%exception key) + (agent-error? (car args))) + (match method-and-path-components + ((method path-components ...) + (simple-format + (current-error-port) + "error: when processing: /~A ~A\n ~A ~A" + method (string-join path-components "/") + key args))) + (backtrace))))) #:unwind? #t)) diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 580773b..4fdfade 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -380,27 +380,21 @@ (with-exception-handler (lambda (exn) - (match method-and-path-components - ((method path-components ...) - (simple-format - (current-error-port) - "error: when processing client request: /~A ~A\n ~A" - method (string-join path-components "/") - exn))) (render-json - `((error . ,(simple-format #f "~A" exn))) + `((error . 500)) #:code 500)) (lambda () - (with-exception-handler - (lambda (exn) - (catch #t - (lambda () - (backtrace)) - (lambda (key . args) - (simple-format (current-error-port) - "error: guile crashed printing backtrace\n"))) - (raise-exception exn)) - controller-thunk)) + (with-throw-handler #t + controller-thunk + (lambda (key . args) + (match method-and-path-components + ((method path-components ...) + (simple-format + (current-error-port) + "error: when processing client request: /~A ~A\n ~A ~A\n" + method (string-join path-components "/") + key args))) + (backtrace)))) #:unwind? #t)) (define* (render-json json #:key (extra-headers '()) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index c6a71f5..f874c48 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -467,27 +467,15 @@ (metric-increment failure-counter-metric) (atomic-box-set! allocation-needed #t)) (lambda () - (with-exception-handler - (lambda (exn) - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception when printing backtrace: ~A\n" - exn) - (raise-exception exn)) - (lambda () - (backtrace) - (simple-format #t "\nfinished printing backtrace\n") - (force-output)) - #:unwind? #t) - (raise-exception exn)) + (with-throw-handler #t (lambda () (with-timeout (* 1000 60 10) ; 10 minutes (raise-exception (make-exception-with-message "timeout allocating builds")) (allocate-builds build-coordinator)) - (metric-increment success-counter-metric)))) + (metric-increment success-counter-metric)) + (lambda (key . args) + (backtrace)))) #:unwind? #t)) #:buckets ((@@ (prometheus) exponential-histogram-buckets) ; TODO #:start 1 diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index fdcefb6..4d98575 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -646,15 +646,14 @@ References: ~a~%" ;; Add the job back to the queue so that it's tried again (apply process-job job-args)) (lambda () - (with-exception-handler - (lambda (exn) - (simple-format (current-error-port) - "exception when handling job: ~A\n" - exn) - (backtrace) - (raise-exception exn)) + (with-throw-handler #t (lambda () - (apply proc job-args)))) + (apply proc job-args)) + (lambda (key . args) + (simple-format (current-error-port) + "exception when handling job: ~A ~A\n" + key args) + (backtrace)))) #:unwind? #t) (with-mutex queue-mutex (hash-set! running-job-args diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index 2dfb087..f6dba70 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -41,18 +41,17 @@ arguments of the worker thread procedure." (lambda (exn) (cons 'worker-thread-error exn)) (lambda () - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "worker-thread: exception: ~A\n" exn) - (backtrace) - (raise-exception exn)) + (with-throw-handler #t (lambda () (call-with-values (lambda () (apply proc args)) - (lambda vals vals))))) + (lambda vals vals))) + (lambda (key . args) + (simple-format + (current-error-port) + "worker-thread: exception: ~A ~A\n" key args) + (backtrace)))) #:unwind? #t))))) (loop))))))) (iota parallelism)) |