aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/agent.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-05-11 17:30:04 +0100
committerChristopher Baines <mail@cbaines.net>2023-05-11 17:30:04 +0100
commitb2989d107ea87f36bc4684cadc0f416bc251d6cb (patch)
treef21e7ad6c5f65e3068e1c1838a1e23daefa5e893 /guix-build-coordinator/agent.scm
parent64202d823d5a07537d791baf7eb0feafa854d429 (diff)
downloadbuild-coordinator-b2989d107ea87f36bc4684cadc0f416bc251d6cb.tar
build-coordinator-b2989d107ea87f36bc4684cadc0f416bc251d6cb.tar.gz
Clean up some handling of uploads for agents
This commit should correct the progress reporting on partial uploads.
Diffstat (limited to 'guix-build-coordinator/agent.scm')
-rw-r--r--guix-build-coordinator/agent.scm53
1 files changed, 28 insertions, 25 deletions
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