diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-10-14 17:48:18 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-10-14 17:48:18 +0100 |
| commit | 8c6e2a6a7c158610da676c49c00d54c7c5d71f1d (patch) | |
| tree | 76a0b8281ca8c6084067bf2992f4c9c75812725d /guix-build-coordinator/agent.scm | |
| parent | 91089b5dd0f2d6a802fc4f329f19f012bb7fb2c2 (diff) | |
| download | build-coordinator-8c6e2a6a7c158610da676c49c00d54c7c5d71f1d.tar build-coordinator-8c6e2a6a7c158610da676c49c00d54c7c5d71f1d.tar.gz | |
Reset the upload progress when appropriate
Diffstat (limited to 'guix-build-coordinator/agent.scm')
| -rw-r--r-- | guix-build-coordinator/agent.scm | 83 |
1 files changed, 44 insertions, 39 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index 4041ab7..c06987a 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -130,45 +130,50 @@ (define last-progress-update-time 0) (define (report-bytes-sent bytes) - (let ((bytes-now-sent - (+ (upload-progress-bytes-sent upload-progress-record) - bytes))) - - (set-upload-progress-bytes-sent! - upload-progress-record - bytes-now-sent) - (let ((uploads-count - (vector-count (lambda (_ slot) - (not (eq? #f slot))) - upload-slots))) - - (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))) - - (log-msg lgr 'INFO uploads-count " uploads in progress") - - (vector-for-each - (lambda (_ upload-progress) - (when upload-progress - (log-msg lgr 'INFO - (upload-progress-file upload-progress) - ": " - (format - #f - "~2,2f/~2,2f" - (/ (upload-progress-bytes-sent - upload-progress) - 1000000) - (/ (upload-progress-total-bytes upload-progress) - 1000000)) - "MB sent"))) - upload-slots))))) + (if (eq? bytes 'reset) + (begin + (set-upload-progress-bytes-sent! upload-progress-record + 0) + (set! last-progress-update-bytes-sent 0)) + (let ((bytes-now-sent + (+ (upload-progress-bytes-sent upload-progress-record) + bytes))) + + (set-upload-progress-bytes-sent! + upload-progress-record + bytes-now-sent) + (let ((uploads-count + (vector-count (lambda (_ slot) + (not (eq? #f slot))) + upload-slots))) + + (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))) + + (log-msg lgr 'INFO uploads-count " uploads in progress") + + (vector-for-each + (lambda (_ upload-progress) + (when upload-progress + (log-msg lgr 'INFO + (upload-progress-file upload-progress) + ": " + (format + #f + "~2,2f/~2,2f" + (/ (upload-progress-bytes-sent + upload-progress) + 1000000) + (/ (upload-progress-total-bytes upload-progress) + 1000000)) + "MB sent"))) + upload-slots)))))) (define (free-slot index) (with-mutex uploads-mutex |