diff options
Diffstat (limited to 'guix-build-coordinator/agent-messaging/http.scm')
| -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) |