aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2022-10-21 12:17:31 +0100
committerChristopher Baines <mail@cbaines.net>2022-10-21 12:17:31 +0100
commita410ff43bc2668ae2b8d669ea50ffb9571198f2b (patch)
treef42406a003070cc64d3a73003f8886c18ee24a17
parent5412d515e3b0b4585ae1faf5cf3eb0a5e63a7b22 (diff)
downloadbuild-coordinator-a410ff43bc2668ae2b8d669ea50ffb9571198f2b.tar
build-coordinator-a410ff43bc2668ae2b8d669ea50ffb9571198f2b.tar.gz
Tweak upload handling again
This partially reverts some recent changes. There should now be better handling of when all the bytes have been sent, but the hash hasn't yet been computed.
-rw-r--r--guix-build-coordinator/agent-messaging/http.scm143
1 files changed, 84 insertions, 59 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index c4cf59b..45711de 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -329,66 +329,91 @@
(lambda ()
(reset-timeout (* 5 60)))))
- (unless (and=>
- (get-completed-upload-bytes)
- (lambda (uploaded-bytes)
- (eq? uploaded-bytes file-size)))
-
- (let* ((partial-upload-bytes (if %force-full-upload
- #f
- (get-partial-upload-bytes))))
- (if partial-upload-bytes
- (log 'DEBUG "still more to send (bytes: " file-size
- ", partial upload bytes: " partial-upload-bytes ")")
- (begin
- (log 'DEBUG "starting sending file from start")
- (set! %force-full-upload #f)
- (report-bytes-sent 'reset)))
-
- ;; Still more to send
- (call-with-input-file file
- (lambda (file-port)
- (when partial-upload-bytes
- (seek file-port partial-upload-bytes SEEK_SET)
- (log 'INFO "resuming upload from byte " partial-upload-bytes))
-
- (let ((upload-uri
- (coordinator-uri-for-path
- (slot-ref interface 'coordinator-uri)
- (string-append "/build/" build-id "/output/" output-name
- (if (integer? partial-upload-bytes)
- "/partial"
- "")))))
-
- (with-timeout (* 5 60) ; 5 minutes
- (raise-exception
- (make-exception-with-message "timeout submitting output"))
- (let-values (((response body)
- (call-with-streaming-http-request
- upload-uri
- (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 partial-upload-bytes 'POST 'PUT)
- #:report-bytes-sent
- (lambda args
- (reset-timeout/throttled)
- (apply report-bytes-sent args)))))
- (log 'DEBUG "perform upload " file ", response code: "
- (response-code response))
-
- (when (>= (response-code response) 400)
+ (let* ((partial-upload-bytes (get-partial-upload-bytes))
+ (completed-upload-bytes (get-completed-upload-bytes))
+ (bytes (if %force-full-upload
+ #f
+ (or partial-upload-bytes
+ completed-upload-bytes))))
+ ;; Check if the server has all the bytes
+ (if (and bytes
+ (eq? bytes file-size))
+ (begin
+ (log 'DEBUG "perform upload: server has all the bytes"
+ " (partial-upload-bytes: " partial-upload-bytes
+ ",completed-upload-bytes: " completed-upload-bytes ")")
+
+ (unless completed-upload-bytes
+ (let loop ((retry 1))
+ (sleep 30)
+
+ (if (get-completed-upload-bytes)
+ (log 'DEBUG "upload completed")
+ (if (< retry 30)
+ (begin
+ (log 'DEBUG "upload not yet completed, "
+ "rechecking in 30 seconds")
+
+ (loop (+ 1 retry)))
+ (begin
+ (log 'DEBUG "upload not yet completed, giving up waiting")
+
+ (raise-exception
+ (make-exception-with-message "upload not completed"))))))))
+
+ (begin
+ (if bytes
+ (log 'DEBUG "still more to send (bytes: " file-size
+ ", partial upload bytes: " bytes ")")
+ (begin
+ (log 'DEBUG "starting sending file from start")
+ (set! %force-full-upload #f)
+ (report-bytes-sent 'reset)))
+
+ ;; 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))
+
+ (let ((upload-uri
+ (coordinator-uri-for-path
+ (slot-ref interface 'coordinator-uri)
+ (string-append "/build/" build-id "/output/" output-name
+ (if (integer? bytes)
+ "/partial"
+ "")))))
+
+ (with-timeout (* 5 60) ; 5 minutes
(raise-exception
- (make-exception-with-message
- (coordinator-handle-failed-request
- log
- 'PUT
- (uri-path upload-uri)
- response
- body))))))))))))
+ (make-exception-with-message "timeout submitting output"))
+ (let-values (((response body)
+ (call-with-streaming-http-request
+ upload-uri
+ (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
+ (lambda args
+ (reset-timeout/throttled)
+ (apply report-bytes-sent args)))))
+ (log 'DEBUG "perform upload " file ", response code: "
+ (response-code response))
+
+ (when (>= (response-code response) 400)
+ (raise-exception
+ (make-exception-with-message
+ (coordinator-handle-failed-request
+ log
+ 'PUT
+ (uri-path upload-uri)
+ response
+ body)))))))))))))
(unless (and=>
(get-completed-upload-bytes)