Update retry-on-error procedure from the Guix Build Coordinator

1 files changed, 18 insertions, 5 deletions

diff --git a/nar-herder/utils.scm b/nar-herder/utils.scm
index f3bf5d4..e9866aa 100644
--- a/nar-herder/utils.scm
+++ b/nar-herder/utils.scm
@@ -71,7 +71,7 @@
             port-write-timeout-error?
             with-fibers-port-timeouts))
 
-(define* (retry-on-error f #:key times delay ignore)
+(define* (retry-on-error f #:key times delay ignore error-hook)
   (let loop ((attempt 1))
     (match (with-exception-handler
                (lambda (exn)
@@ -101,15 +101,26 @@
           times))
        (apply values return-values))
       ((#f . exn)
-       (if (>= attempt times)
+       (if (>= attempt
+               (- times 1))
            (begin
              (simple-format
               (current-error-port)
-              "error: ~A:\n  ~A,\n  giving up after ~A attempts\n"
+              "error: ~A:\n  ~A,\n  attempt ~A of ~A, last retry in ~A\n"
               f
               exn
-              times)
-             (raise-exception exn))
+              attempt
+              times
+              delay)
+             (when error-hook
+               (error-hook attempt exn))
+             (sleep delay)
+             (simple-format
+              (current-error-port)
+              "running last retry of ~A after ~A failed attempts\n"
+              f
+              attempt)
+             (f))
            (begin
              (simple-format
               (current-error-port)
@@ -119,6 +130,8 @@
               attempt
               times
               delay)
+             (when error-hook
+               (error-hook attempt exn))
              (sleep delay)
              (loop (+ 1 attempt))))))))