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

Add support for tracking resource pool checkout timeouts

Browse source
This commit is contained in:
Christopher Baines 2024-04-15 13:53:35 +01:00
parent 88b9d34fb1
commit f1add88867
1 changed files with 9 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

10
guix-data-service/utils.scm
View file

@ -39,6 +39,7 @@
prevent-inlining-for-tests prevent-inlining-for-tests
resource-pool-default-timeout resource-pool-default-timeout
%resource-pool-timeout-handler
make-resource-pool make-resource-pool
destroy-resource-pool destroy-resource-pool
call-with-resource-from-pool call-with-resource-from-pool
@ -341,7 +342,11 @@
(define resource-pool-timeout-error? (define resource-pool-timeout-error?
(record-predicate &resource-pool-timeout)) (record-predicate &resource-pool-timeout))
(define* (call-with-resource-from-pool pool proc #:key (timeout 'default)) (define %resource-pool-timeout-handler
(make-parameter #f))
(define* (call-with-resource-from-pool pool proc #:key (timeout 'default)
(timeout-handler (%resource-pool-timeout-handler)))
"Call PROC with a resource from POOL, blocking until a resource becomes "Call PROC with a resource from POOL, blocking until a resource becomes
available. Return the resource once PROC has returned." available. Return the resource once PROC has returned."
@ -394,6 +399,9 @@ available. Return the resource once PROC has returned."
(when (or (not resource) (when (or (not resource)
(eq? resource 'resource-pool-retry-checkout)) (eq? resource 'resource-pool-retry-checkout))
(when timeout-handler
(timeout-handler pool proc timeout))
(raise-exception (raise-exception
(make-resource-pool-timeout-error))) (make-resource-pool-timeout-error)))