aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/agent-messaging/http/server.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix-build-coordinator/agent-messaging/http/server.scm')
-rw-r--r--guix-build-coordinator/agent-messaging/http/server.scm121
1 files changed, 121 insertions, 0 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index a21ae80..1f4bdd5 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -492,6 +492,127 @@ port. Also, the port used can be changed by passing the --port option.\n"
(render-json
'(("error" . "access denied"))
#:code 403))))
+ (('HEAD "build" uuid "output" output-name "partial")
+ (let ((agent-id-for-build
+ (datastore-agent-for-build datastore uuid)))
+ (if (authenticated? agent-id-for-build request)
+ (let* ((output-file-name
+ (build-output-file-location datastore uuid output-name))
+ (tmp-output-file-name
+ (string-append output-file-name ".tmp")))
+ (if (file-exists? tmp-output-file-name)
+ (let ((bytes (stat:size (stat tmp-output-file-name))))
+ (list (build-response
+ #:code 200
+ #:headers `((content-length . ,bytes)))
+ #f))
+ (render-json
+ '((error . "no partial content"))
+ #:code 404)))
+ (render-json
+ '(("error" . "access denied"))
+ #:code 403))))
+ (('POST "build" uuid "output" output-name "partial")
+ (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 ()
+ (let ((output-port (open-file tmp-output-file-name "a")))
+ (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
+ "received ~A
+ took ~A seconds
+ data transfered: ~AMB (~A bytes)
+ speed (MB/s): ~A
+"
+ (basename output-file-name)
+ seconds-elapsed
+ (rationalize (exact->inexact (/ bytes-read 1000000))
+ 0.1)
+ bytes-read
+ (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))))))
+ (close-port output-port))
+
+ ;; Compute the hash of the file
+ (let ((hash (bytevector->nix-base32-string
+ (call-with-input-file tmp-output-file-name
+ (lambda (compressed-port)
+ (call-with-lzip-input-port compressed-port
+ port-sha256))))))
+ (rename-file tmp-output-file-name
+ output-file-name)
+ hash))))
+
+ (if (authenticated? agent-id-for-build request)
+ (let* ((output-file-name
+ (build-output-file-location datastore uuid output-name))
+ (tmp-output-file-name
+ (string-append output-file-name ".tmp")))
+ (let ((hash
+ (if (bytevector? body)
+ (let ((output-port (open-file tmp-output-file-name "a")))
+ (put-bytevector output-port body)
+ (close-port output-port)
+
+ (let ((hash
+ (bytevector->nix-base32-string
+ (call-with-input-file tmp-output-file-name
+ (lambda (compressed-port)
+ (call-with-lzip-input-port compressed-port
+ port-sha256))))))
+ (rename-file tmp-output-file-name
+ output-file-name)
+ hash))
+ (receive-file output-file-name
+ tmp-output-file-name))))
+
+ (call-with-output-file (string-append output-file-name ".hash")
+ (lambda (port)
+ (simple-format port "~A\n" hash)))
+
+ (no-content)))
+ (render-json
+ '(("error" . "access denied"))
+ #:code 403))))
(('GET "metrics")
(update-managed-metrics!)
(list (build-response