From 2926604aa05db459e93dae5687c32d75d4efd04e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 9 May 2023 21:43:31 +0100 Subject: Separate read and write timeout exceptions So it's clearer what has occurred. --- guix-build-coordinator/utils.scm | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) (limited to 'guix-build-coordinator/utils.scm') diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 71a9540..00774c8 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -49,6 +49,14 @@ make-base64-output-port + &port-timeout + &port-read-timeout + &port-write-timeout + + port-timeout-error? + port-read-timeout-error? + port-write-timeout-error? + with-port-timeouts set-store-connection-timeout @@ -225,7 +233,7 @@ (define &port-timeout (make-exception-type '&port-timeout &external-error - '())) + '(port))) (define make-port-timeout-error (record-constructor &port-timeout)) @@ -233,6 +241,28 @@ (define port-timeout-error? (record-predicate &port-timeout)) +(define &port-read-timeout + (make-exception-type '&port-read-timeout + &port-timeout + '())) + +(define make-port-read-timeout-error + (record-constructor &port-read-timeout)) + +(define port-read-timeout-error? + (record-predicate &port-read-timeout)) + +(define &port-write-timeout + (make-exception-type '&port-write-timeout + &port-timeout + '())) + +(define make-port-write-timeout-error + (record-constructor &port-write-timeout)) + +(define port-write-timeout-error? + (record-predicate &port-write-timeout)) + (define* (with-port-timeouts thunk #:key (timeout (* 120 1000))) ;; When the GC runs, it restarts the poll syscall, but the timeout remains @@ -253,7 +283,9 @@ (if (> (get-internal-real-time) timeout-internal) (raise-exception - (make-port-timeout-error)) + (if (string=? mode "r") + (make-port-read-timeout-error) + (make-port-write-timeout-error))) (loop (port-poll port mode poll-timeout-ms))) poll-value)))) -- cgit v1.2.3