diff options
author | Christopher Baines <mail@cbaines.net> | 2022-04-09 22:37:19 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2022-04-09 22:37:19 +0100 |
commit | 7c9c1b200032fe3f7187749c376a8c911cd98b72 (patch) | |
tree | 2838c2d0ba36b889c851d7e481efa98c71c89102 | |
parent | de4a303beedc3414d7ca9a8ad948d0fc676e7e77 (diff) | |
download | build-coordinator-7c9c1b200032fe3f7187749c376a8c911cd98b72.tar build-coordinator-7c9c1b200032fe3f7187749c376a8c911cd98b72.tar.gz |
Move retry in submit-output
-rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 94 |
1 files changed, 46 insertions, 48 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 2c07336..dae94b5 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -318,56 +318,54 @@ (if resume? "/partial" "")))) (define (perform-upload) - (retry-on-error - (lambda () - (let* ((partial-upload-bytes (get-partial-upload-bytes)) - (completed-upload-bytes (get-completed-upload-bytes)) - (bytes (or partial-upload-bytes - completed-upload-bytes))) - ;; Check if the server has all the bytes - (unless (and bytes - (eq? bytes file-size)) - (when bytes - (log 'DEBUG "still more to send (bytes: " file-size - ", partial upload bytes: " partial-upload-bytes - ", completed upload bytes: " completed-upload-bytes ")")) - - ;; Still more to send - (call-with-input-file file - (lambda (file-port) - (when bytes - (seek file-port bytes SEEK_SET) - (log 'INFO "resuming upload from byte " bytes)) - - (with-timeout (* 20 60) ; 20 minutes - (raise-exception - (make-exception-with-message "timeout submitting output")) - (let-values (((response body) - (call-with-streaming-http-request - (uri #:resume? (integer? bytes)) - (lambda (port) - (with-time-logging - (simple-format #f "sending ~A" file) - (dump-port file-port port - #:buffer-size 65536))) - #:headers `((Authorization . ,auth-value)) - #:method (if bytes 'POST 'PUT) - #:report-bytes-sent report-bytes-sent))) - (when (>= (response-code response) 400) - (raise-exception - (make-exception-with-message - (coordinator-handle-failed-request - log - 'PUT - (uri-path - (uri #:resume? (integer? bytes))) - response - body))))))))))) - #:times 100 - #:delay (random 15))) + (let* ((partial-upload-bytes (get-partial-upload-bytes)) + (completed-upload-bytes (get-completed-upload-bytes)) + (bytes (or partial-upload-bytes + completed-upload-bytes))) + ;; Check if the server has all the bytes + (unless (and bytes + (eq? bytes file-size)) + (when bytes + (log 'DEBUG "still more to send (bytes: " file-size + ", partial upload bytes: " partial-upload-bytes + ", completed upload bytes: " completed-upload-bytes ")")) + + ;; Still more to send + (call-with-input-file file + (lambda (file-port) + (when bytes + (seek file-port bytes SEEK_SET) + (log 'INFO "resuming upload from byte " bytes)) + + (with-timeout (* 20 60) ; 20 minutes + (raise-exception + (make-exception-with-message "timeout submitting output")) + (let-values (((response body) + (call-with-streaming-http-request + (uri #:resume? (integer? bytes)) + (lambda (port) + (with-time-logging + (simple-format #f "sending ~A" file) + (dump-port file-port port + #:buffer-size 65536))) + #:headers `((Authorization . ,auth-value)) + #:method (if bytes 'POST 'PUT) + #:report-bytes-sent report-bytes-sent))) + (when (>= (response-code response) 400) + (raise-exception + (make-exception-with-message + (coordinator-handle-failed-request + log + 'PUT + (uri-path + (uri #:resume? (integer? bytes))) + response + body))))))))))) (unless (get-completed-upload-bytes) - (perform-upload))) + (retry-on-error perform-upload + #:times 100 + #:delay (random 15)))) args)) (define-method (submit-log-file |