aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-10-24 11:16:48 +0100
committerChristopher Baines <mail@cbaines.net>2020-10-24 11:16:48 +0100
commit8d2f91bbb11410e456f0963f7d2e45348693ab90 (patch)
tree0d14345d5964370b6f168461a740811f030ec89a
parent2eee8164ded286f872588771dab3b2b4401adb6d (diff)
downloadbuild-coordinator-8d2f91bbb11410e456f0963f7d2e45348693ab90.tar
build-coordinator-8d2f91bbb11410e456f0963f7d2e45348693ab90.tar.gz
Improve the line length for the receiving outputs code
-rw-r--r--guix-build-coordinator/agent-messaging/http/server.scm108
1 files changed, 61 insertions, 47 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 16f5ba7..c9d70d6 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -366,6 +366,65 @@ port. Also, the port used can be changed by passing the --port option.\n"
(('PUT "build" uuid "output" output-name)
(let ((agent-id-for-build
(datastore-agent-for-build datastore uuid)))
+
+ (define (receive-file output-file-name tmp-output-file-name)
+ (call-with-worker-thread
+ chunked-request-channel
+ (lambda ()
+ (call-with-output-file tmp-output-file-name
+ (lambda (output-port)
+ (let ((start-time (current-time time-utc)))
+ (let loop ((bv (get-bytevector-some body))
+ (bytes-read 0)
+ (last-progress-update-bytes-read 0))
+ (if (eof-object? bv)
+ (let* ((end-time (current-time time-utc))
+ (elapsed (time-difference end-time
+ start-time))
+ (seconds-elapsed
+ (+ (time-second elapsed)
+ (/ (time-nanosecond elapsed) 1e9))))
+ (display
+ (simple-format
+ #f
+ "receiving ~A
+ took ~A seconds
+ data transfered: ~AMB
+ speed (MB/s): ~A
+"
+ (basename output-file-name)
+ seconds-elapsed
+ (rationalize (exact->inexact (/ bytes-read 1000000))
+ 0.1)
+ (rationalize (/ (/ bytes-read 1000000)
+ seconds-elapsed)
+ 0.1))))
+ (begin
+ (put-bytevector output-port bv)
+ (loop (get-bytevector-some body)
+ (+ bytes-read
+ (bytevector-length bv))
+ (if (> (- bytes-read
+ last-progress-update-bytes-read)
+ 50000000) ; ~50MB
+ (begin
+ (display
+ (simple-format
+ #f
+ "receiving ~A
+ ~AMB read so far...
+"
+ (basename output-file-name)
+ (rationalize (exact->inexact
+ (/ bytes-read
+ 1000000))
+ 0.1)))
+ bytes-read)
+ last-progress-update-bytes-read))))))))
+ (rename-file tmp-output-file-name
+ output-file-name)
+ #t)))
+
(if (authenticated? agent-id-for-build request)
(let* ((output-file-name
(build-output-file-location datastore uuid output-name))
@@ -374,53 +433,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
(mkdir-p (dirname output-file-name))
(when (file-exists? tmp-output-file-name)
(delete-file tmp-output-file-name))
- (if (call-with-worker-thread
- chunked-request-channel
- (lambda ()
- (call-with-output-file tmp-output-file-name
- (lambda (output-port)
- (let ((start-time (current-time time-utc)))
- (let loop ((bv (get-bytevector-some body))
- (bytes-read 0)
- (last-progress-update-bytes-read 0))
- (if (eof-object? bv)
- (let* ((end-time (current-time time-utc))
- (elapsed (time-difference end-time
- start-time))
- (seconds-elapsed
- (+ (time-second elapsed)
- (/ (time-nanosecond elapsed) 1e9))))
- (display
- (simple-format
- #f
- "receiving ~A\n took ~A seconds\n data transfered: ~AMB\n speed (MB/s): ~A\n"
- (basename output-file-name)
- seconds-elapsed
- (rationalize (exact->inexact (/ bytes-read 1000000))
- 0.1)
- (rationalize (/ (/ bytes-read 1000000) seconds-elapsed)
- 0.1))))
- (begin
- (put-bytevector output-port bv)
- (loop (get-bytevector-some body)
- (+ bytes-read
- (bytevector-length bv))
- (if (> (- bytes-read
- last-progress-update-bytes-read)
- 50000000) ; ~50MB
- (begin
- (display
- (simple-format
- #f "receiving ~A\n ~AMB read so far...\n"
- (basename output-file-name)
- (rationalize (exact->inexact (/ bytes-read
- 1000000))
- 0.1)))
- bytes-read)
- last-progress-update-bytes-read))))))))
- (rename-file tmp-output-file-name
- output-file-name)
- #t))
+ (if (receive-file output-file-name
+ tmp-output-file-name)
(no-content)
(render-json
"error"