diff options
author | Christopher Baines <mail@cbaines.net> | 2022-10-21 12:17:31 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2022-10-21 12:17:31 +0100 |
commit | a410ff43bc2668ae2b8d669ea50ffb9571198f2b (patch) | |
tree | f42406a003070cc64d3a73003f8886c18ee24a17 | |
parent | 5412d515e3b0b4585ae1faf5cf3eb0a5e63a7b22 (diff) | |
download | build-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.scm | 143 |
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) |