summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-02-03 12:58:22 +0100
committerChristopher Baines <mail@cbaines.net>2020-02-05 18:12:44 +0000
commitbb225189fd56d89ec8be926dda269295ccbfe918 (patch)
tree37891b04d3e78730e615e20ec71e98af793c17a3
parentb9031db946ff89a39e1507b430f64402b0e9572a (diff)
downloadcuirass-bb225189fd56d89ec8be926dda269295ccbfe918.tar
cuirass-bb225189fd56d89ec8be926dda269295ccbfe918.tar.gz
utils: Handle errors in worker threads.handle-errors-in-worker-threads
Previously, if an error occurred, the worker fiber simply never sends a reply. In the case of HTTP requests to Cuirass, where an exception occurs when performing a database query, the fiber handling the request blocks as it never gets a response. I think that this has the potential to cause the process to hit file descriptor limits, as the connections are never responded to. This is fixed by responding with the details of the exception, and then throwing it within the fiber that made the call. * src/cuirass/utils.scm (make-worker-thread-channel): Catch exceptions when calling proc. (call-with-worker-thread): Handle receiving exceptions from the worker thread.
-rw-r--r--src/cuirass/utils.scm12
1 files changed, 10 insertions, 2 deletions
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index f3ba18d..0bcbb35 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -114,7 +114,12 @@ arguments of the worker thread procedure."
(let loop ()
(match (get-message channel)
(((? channel? reply) . (? procedure? proc))
- (put-message reply (apply proc args))))
+ (put-message reply
+ (catch #t
+ (lambda ()
+ (apply proc args))
+ (lambda (key . args)
+ (cons* 'worker-thread-error key args))))))
(loop)))))))
(iota parallelism))
channel)))
@@ -127,7 +132,10 @@ If already in the worker thread, call PROC immediately."
(apply proc args)
(let ((reply (make-channel)))
(put-message channel (cons reply proc))
- (get-message reply)))))
+ (match (get-message reply)
+ (('worker-thread-error key args ...)
+ (apply throw key args))
+ (result result))))))
(define-syntax-rule (with-worker-thread channel (vars ...) exp ...)
"Evaluate EXP... in the worker thread corresponding to CHANNEL.