From a410ff43bc2668ae2b8d669ea50ffb9571198f2b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 21 Oct 2022 12:17:31 +0100 Subject: 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. --- guix-build-coordinator/agent-messaging/http.scm | 143 ++++++++++++++---------- 1 file 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) -- cgit v1.2.3