aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/agent-messaging/http.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2022-04-09 22:37:19 +0100
committerChristopher Baines <mail@cbaines.net>2022-04-09 22:37:19 +0100
commit7c9c1b200032fe3f7187749c376a8c911cd98b72 (patch)
tree2838c2d0ba36b889c851d7e481efa98c71c89102 /guix-build-coordinator/agent-messaging/http.scm
parentde4a303beedc3414d7ca9a8ad948d0fc676e7e77 (diff)
downloadbuild-coordinator-7c9c1b200032fe3f7187749c376a8c911cd98b72.tar
build-coordinator-7c9c1b200032fe3f7187749c376a8c911cd98b72.tar.gz
Move retry in submit-output
Diffstat (limited to 'guix-build-coordinator/agent-messaging/http.scm')
-rw-r--r--guix-build-coordinator/agent-messaging/http.scm94
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