From ce08a51755914201c3730f5dbceb3c7da771e766 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 15 Mar 2024 23:33:46 +0000 Subject: Add a definition of retry-on-error which uses the fibers sleep --- guix-build-coordinator/utils.scm | 7 ++++--- 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)))) -- cgit v1.2.3