diff options
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 60 |
1 files changed, 25 insertions, 35 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index adc8102..9d73119 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -326,12 +326,6 @@ (define %force-full-upload #t) (define (perform-upload) - (define reset-timeout/throttled - (throttle - 120 - (lambda () - (reset-timeout (* 5 60))))) - (let* ((partial-upload-bytes (get-partial-upload-bytes)) (completed-upload-bytes (get-completed-upload-bytes)) (bytes (if %force-full-upload @@ -387,35 +381,31 @@ "/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 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))))))))))))) + (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 + (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) |