diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-07-21 11:30:53 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-07-21 11:30:53 +0100 |
| commit | 53682fac7e00cd2801406edbd014922c1720c347 (patch) | |
| tree | dc5230af4d456fd17d9853163afb928d9d998632 | |
| parent | 9956ad2e0c9fb09c0724edb94e4fddb1f2df8adb (diff) | |
| download | nar-herder-53682fac7e00cd2801406edbd014922c1720c347.tar nar-herder-53682fac7e00cd2801406edbd014922c1720c347.tar.gz | |
Add better exception handling and retrying when mirroring nars
| -rw-r--r-- | nar-herder/storage.scm | 64 |
1 files changed, 40 insertions, 24 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index be52cbf..560eadd 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -388,28 +388,36 @@ (when (file-exists? tmp-file-name) (delete-file tmp-file-name)) - (with-port-timeouts - (lambda () - (call-with-values - (lambda () - (let ((port - socket - (open-socket-for-uri* uri))) - (set-socket-timeout socket #:seconds 30) - - (http-get uri - #:port port - #:decode-body? #f - #:streaming? #t))) - (lambda (response body) - (unless (= (response-code response) - 200) - (error "unknown response code" - (response-code response))) - - (call-with-output-file tmp-file-name - (lambda (output-port) - (dump-port body output-port))))))) + (with-exception-handler + (lambda (exn) + (when (file-exists? tmp-file-name) + (delete-file tmp-file-name)) + + (raise-exception exn)) + (lambda () + (with-port-timeouts + (lambda () + (call-with-values + (lambda () + (let ((port + socket + (open-socket-for-uri* uri))) + (set-socket-timeout socket #:seconds 30) + + (http-get uri + #:port port + #:decode-body? #f + #:streaming? #t))) + (lambda (response body) + (unless (= (response-code response) + 200) + (error "unknown response code" + (response-code response))) + + (call-with-output-file tmp-file-name + (lambda (output-port) + (dump-port body output-port)))))))) + #:unwind? #t) (rename-file tmp-file-name destination-file-name) @@ -444,7 +452,11 @@ ": " exn) #f) (lambda () - (fetch-file (assq-ref file 'url)) + (retry-on-error + (lambda () + (fetch-file (assq-ref file 'url))) + #:times 3 + #:delay 5) #t) #:unwind? #t))) (loop (if success? @@ -476,7 +488,11 @@ ": " exn) #f) (lambda () - (fetch-file (assq-ref file 'url)) + (retry-on-error + (lambda () + (fetch-file (assq-ref file 'url))) + #:times 3 + #:delay 5) #t) #:unwind? #t)) missing-nar-files)))) |