diff options
author | Christopher Baines <mail@cbaines.net> | 2021-08-07 14:30:55 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-08-07 14:30:55 +0100 |
commit | 6ce3efba65577f3cdc919c5520cc23ecb3e648fa (patch) | |
tree | 413b63c6661116a204c9657ffba6fc5f03489ab4 | |
parent | c2f0c5b36f8294bb4c699806f9e8c576ae9b9f90 (diff) | |
download | build-coordinator-6ce3efba65577f3cdc919c5520cc23ecb3e648fa.tar build-coordinator-6ce3efba65577f3cdc919c5520cc23ecb3e648fa.tar.gz |
Report on uploads regularly
If there's a queue.
-rw-r--r-- | guix-build-coordinator/agent.scm | 29 |
1 files changed, 17 insertions, 12 deletions
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm index a89e5d7..7f6438f 100644 --- a/guix-build-coordinator/agent.scm +++ b/guix-build-coordinator/agent.scm @@ -121,6 +121,7 @@ (make-upload-progress file 0)) (define last-progress-update-bytes-sent 0) + (define last-progress-update-time 0) (define (report-bytes-sent bytes) (let ((bytes-now-sent @@ -130,18 +131,22 @@ (set-upload-progress-bytes-sent! upload-progress-record bytes-now-sent) - - (when (> bytes-now-sent - (+ last-progress-update-bytes-sent 20000000)) - (set! last-progress-update-bytes-sent - bytes-now-sent) - - (let ((uploads-count - (vector-count (lambda (_ slot) - (not (eq? #f slot))) - upload-slots)) - (queued-uploads-count - (length queued-uploads))) + (let ((uploads-count + (vector-count (lambda (_ slot) + (not (eq? #f slot))) + upload-slots)) + (queued-uploads-count + (length queued-uploads))) + + (when (or (> bytes-now-sent + (+ last-progress-update-bytes-sent 20000000)) + (and (> queued-uploads-count 0) + (> (- (time-second (current-time))) + (+ last-progress-update-time 30)))) + (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, " |