diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-12-27 22:17:09 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-01-13 09:32:38 +0000 |
| commit | 1d5ac358b03a4fe577cef5928958aa1bcc2e6010 (patch) | |
| tree | d697d49b16340d53c33c25c596ce757bb63235b9 /guix-build-coordinator/utils.scm | |
| parent | 037eac0357baa448afe6aeeaf82d8f2e2665bbcb (diff) | |
| download | build-coordinator-1d5ac358b03a4fe577cef5928958aa1bcc2e6010.tar build-coordinator-1d5ac358b03a4fe577cef5928958aa1bcc2e6010.tar.gz | |
Use Guile Knots
Diffstat (limited to 'guix-build-coordinator/utils.scm')
| -rw-r--r-- | guix-build-coordinator/utils.scm | 80 |
1 files changed, 1 insertions, 79 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index d747962..fe8c453 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -14,8 +14,6 @@ #:use-module (ice-9 textual-ports) #:use-module (ice-9 rdelim) #:use-module (ice-9 binary-ports) - #:use-module (ice-9 suspendable-ports) - #:use-module ((ice-9 ports internal) #:select (port-poll)) #:use-module (ice-9 exceptions) #:use-module (rnrs bytevectors) #:use-module (web uri) @@ -42,18 +40,9 @@ #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (guix scripts substitute) + #:use-module (guix-build-coordinator utils timeout) #:export (random-v4-uuid - &port-timeout - &port-read-timeout - &port-write-timeout - - port-timeout-error? - port-read-timeout-error? - port-write-timeout-error? - - with-port-timeouts - request-query-parameters call-with-streaming-http-request @@ -182,73 +171,6 @@ (parse-query-string query)) '()))) -(define &port-timeout - (make-exception-type '&port-timeout - &external-error - '(port))) - -(define make-port-timeout-error - (record-constructor &port-timeout)) - -(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)) - - ;; When the GC runs, it restarts the poll syscall, but the timeout remains - ;; unchanged! When the timeout is longer than the time between the syscall - ;; restarting, I think this renders the timeout useless. Therefore, this - ;; code uses a short timeout, and repeatedly calls poll while watching the - ;; clock to see if it has timed out overall. - (define poll-timeout-ms 200) - - (define (wait port mode) - (let ((timeout-internal - (+ (get-internal-real-time) - (* internal-time-units-per-second timeout)))) - (let loop ((poll-value - (port-poll port mode poll-timeout-ms))) - (if (= poll-value 0) - (if (> (get-internal-real-time) - timeout-internal) - (raise-exception - (if (string=? mode "r") - (make-port-read-timeout-error port) - (make-port-write-timeout-error port))) - (loop (port-poll port mode poll-timeout-ms))) - poll-value)))) - - (parameterize - ((current-read-waiter - (lambda (port) - (wait port "r"))) - (current-write-waiter - (lambda (port) - (wait port "w")))) - (thunk))) - (define* (call-with-streaming-http-request uri content-length callback |