Raise exceptions when port-poll times out

Otherwise port-poll will just be called again.

1 files changed, 21 insertions, 2 deletions

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 9a83358..9877224 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -305,10 +305,29 @@ upcoming chunk."
         gc-enable)
       (thunk)))
 
+(define &port-timeout
+  (make-exception-type '&port-timeout
+                       &external-error
+                       '()))
+
+(define make-port-timeout-error
+  (record-constructor &port-timeout))
+
+(define port-timeout-error?
+  (record-predicate &port-timeout))
+
 (define* (with-port-timeouts thunk #:key (timeout (* 120 1000)))
   (parameterize
-      ((current-read-waiter (lambda (port) (port-poll port "r" timeout)))
-       (current-write-waiter (lambda (port) (port-poll port "w" timeout))))
+      ((current-read-waiter
+        (lambda (port)
+          (when (eq? (port-poll port "r" timeout) 0)
+            (raise-exception
+             (make-port-timeout-error)))))
+       (current-write-waiter
+        (lambda (port)
+          (when (eq? (port-poll port "w" timeout) 0)
+            (raise-exception
+             (make-port-timeout-error))))))
     (thunk)))
 
 (define* (make-chunked-output-port* port #:key (keep-alive? #f)