aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2021-08-07 14:30:55 +0100
committerChristopher Baines <mail@cbaines.net>2021-08-07 14:30:55 +0100
commit6ce3efba65577f3cdc919c5520cc23ecb3e648fa (patch)
tree413b63c6661116a204c9657ffba6fc5f03489ab4
parentc2f0c5b36f8294bb4c699806f9e8c576ae9b9f90 (diff)
downloadbuild-coordinator-6ce3efba65577f3cdc919c5520cc23ecb3e648fa.tar
build-coordinator-6ce3efba65577f3cdc919c5520cc23ecb3e648fa.tar.gz
Report on uploads regularly
If there's a queue.
-rw-r--r--guix-build-coordinator/agent.scm29
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, "