diff options
-rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 2 | ||||
-rw-r--r-- | guix-build-coordinator/utils.scm | 34 |
2 files changed, 23 insertions, 13 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 04f4ea4..66045b4 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -199,7 +199,7 @@ (with-port-timeouts make-request)) #:times retry-times #:delay 10 - #:ignore agent-error-from-coordinator?)) + #:no-retry agent-error-from-coordinator?)) (define* (fetch-session-credentials coordinator name diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 81d0899..6139835 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -634,21 +634,31 @@ References: ~a~%" compressed-size))) compressed-files)))) -(define* (retry-on-error f #:key times delay ignore error-hook) +(define* (retry-on-error f #:key times delay ignore no-retry error-hook) (let loop ((attempt 1)) (match (with-exception-handler (lambda (exn) - (when (cond - ((list? ignore) - (any (lambda (test) - (test exn)) - ignore)) - ((procedure? ignore) - (ignore exn)) - (else #f)) - (raise-exception exn)) - - (cons #f exn)) + (if (cond + ((list? ignore) + (any (lambda (test) + (test exn)) + ignore)) + ((procedure? ignore) + (ignore exn)) + (else #f)) + `(#t . (,exn)) + (begin + (when (cond + ((list? no-retry) + (any (lambda (test) + (test exn)) + no-retry)) + ((procedure? no-retry) + (no-retry exn)) + (else #f)) + (raise-exception exn)) + + (cons #f exn)))) (lambda () (call-with-values f (lambda vals |