diff options
| -rw-r--r-- | guix-build-coordinator/utils.scm | 7 | ||||
| -rw-r--r-- | guix-build-coordinator/utils/fibers.scm | 11 |
2 files changed, 14 insertions, 4 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index bef9937..74b4539 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -632,7 +632,8 @@ References: ~a~%" compressed-size))) compressed-files)))) -(define* (retry-on-error f #:key times delay ignore no-retry error-hook) +(define* (retry-on-error f #:key times delay ignore no-retry error-hook + sleep-impl) (let loop ((attempt 1)) (match (with-exception-handler (lambda (exn) @@ -685,7 +686,7 @@ References: ~a~%" delay) (when error-hook (error-hook attempt exn)) - (sleep delay) + (sleep-impl delay) (simple-format (current-error-port) "running last retry of ~A after ~A failed attempts\n" @@ -703,7 +704,7 @@ References: ~a~%" delay) (when error-hook (error-hook attempt exn)) - (sleep delay) + (sleep-impl delay) (loop (+ 1 attempt)))))))) (define* (s3-list-objects s3-bucket prefix diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index 938d06f..965948a 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -27,7 +27,8 @@ letpar& with-fibers-timeout - with-fibers-port-timeouts)) + with-fibers-port-timeouts) + #:replace (retry-on-error)) (define %worker-thread-args (make-parameter #f)) @@ -524,3 +525,11 @@ If already in the worker thread, call PROC immediately." (make-port-write-timeout-error thunk port)))))) (no-fibers-wait port "w" write-timeout))))) (thunk))) + +;; Use the fibers sleep +(define (retry-on-error . args) + (apply + (@ (guix-build-coordinator utils) retry-on-error) + (append + args + (list #:sleep sleep)))) |