diff options
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 8 | ||||
| -rw-r--r-- | guix-build-coordinator/agent.scm | 53 |
2 files changed, 34 insertions, 27 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 01a2c15..d2e0e0e 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -281,6 +281,7 @@ (lambda* (build-id output-name file #:key (log default-log) + reporter-set-bytes-already-sent reporter report-bytes-hashed) (define file-size @@ -352,8 +353,11 @@ ", partial upload bytes: " bytes ")") (begin (log 'DEBUG "starting sending file from start") - (set! %force-full-upload #f) - (progress-reporter-report! reporter 'reset)))) + + ;; Set this to enable partial uploads when retrying + (set! %force-full-upload #f)))) + + (reporter-set-bytes-already-sent (or bytes 0)) (let* ((bytes-to-send (if bytes diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 2779063..30af393 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -131,6 +131,8 @@ (define upload-progress-record (make-upload-progress file 0 0 total-bytes)) + (define bytes-already-sent 0) + (define last-progress-update-bytes-sent 0) (define last-progress-update-bytes-hashed 0) (define last-progress-update-time 0) @@ -151,8 +153,9 @@ (let ((total-bytes (upload-progress-total-bytes upload-progress)) (bytes-sent - (upload-progress-bytes-sent - upload-progress)) + (+ bytes-already-sent + (upload-progress-bytes-sent + upload-progress))) (bytes-hashed (upload-progress-bytes-hashed upload-progress))) @@ -171,31 +174,28 @@ upload-slots))) (define (report-bytes-sent bytes-now-sent) - (if (eq? bytes-now-sent 'reset) - (begin - (set-upload-progress-bytes-sent! upload-progress-record - 0) - (set! last-progress-update-bytes-sent 0)) - (begin - (set-upload-progress-bytes-sent! - upload-progress-record - bytes-now-sent) - - (when (or (> bytes-now-sent - (+ last-progress-update-bytes-sent 10000000)) - (and (> (- (time-second (current-time))) - (+ last-progress-update-time 15)))) - (set! last-progress-update-bytes-sent - bytes-now-sent) - (set! last-progress-update-time - (time-second (current-time))) - - (display-update))))) + (set-upload-progress-bytes-sent! + upload-progress-record + bytes-now-sent) + + (when (or (> bytes-now-sent + (+ last-progress-update-bytes-sent 10000000)) + (and (> (- (time-second (current-time))) + (+ last-progress-update-time 15)))) + (set! last-progress-update-bytes-sent + bytes-now-sent) + (set! last-progress-update-time + (time-second (current-time))) + + (display-update))) + + (define (reporter-set-bytes-already-sent bytes) + (set! bytes-already-sent bytes)) (define reporter (make-progress-reporter (lambda () - (report-bytes-sent 'reset)) + (report-bytes-sent 0)) report-bytes-sent (lambda () (report-bytes-sent total-bytes)))) @@ -250,7 +250,8 @@ (raise-exception exn)) (lambda () - (p reporter + (p reporter-set-bytes-already-sent + reporter report-bytes-hashed)) #:unwind? #t)) (lambda vals @@ -1120,7 +1121,7 @@ but the guix-daemon claims it's unavailable" lgr (derivation-output-path output) bytes - (lambda (reporter report-bytes-hashed) + (lambda (reporter-set-bytes-already-sent reporter report-bytes-hashed) (log-msg lgr 'INFO build-id ": submitting output " (derivation-output-path output)) @@ -1128,6 +1129,8 @@ but the guix-daemon claims it's unavailable" build-id output-name compressed-file #:log (build-log-procedure lgr build-id) + #:reporter-set-bytes-already-sent + reporter-set-bytes-already-sent #:reporter reporter #:report-bytes-hashed report-bytes-hashed) (log-msg lgr 'INFO |