aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-05-10 10:50:51 +0100
committerChristopher Baines <mail@cbaines.net>2023-05-10 10:50:51 +0100
commit3f6473c0d296ed6efab1feebcacd76fc597bb6ef (patch)
treeda7217ef31c485d8e11db168f8d0bf50e60f029a /guix-build-coordinator
parent930e1d5b489797666602674247efe82756ca4082 (diff)
downloadbuild-coordinator-3f6473c0d296ed6efab1feebcacd76fc597bb6ef.tar
build-coordinator-3f6473c0d296ed6efab1feebcacd76fc597bb6ef.tar.gz
Move output hash related operations in to the dedicated thread
So in case of connection loss, this still happens and the work to compute the hash isn't wasted.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/agent-messaging/http/server.scm110
1 files changed, 51 insertions, 59 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 7fe3dd4..389277f 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -280,7 +280,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
(define logger
(build-coordinator-logger build-coordinator))
- (define (compute-hash-of-uploaded-output channel filename)
+ (define (compute-hash-of-uploaded-output channel filename output-filename)
(with-exception-handler
(lambda (exn)
(log-msg logger
@@ -307,22 +307,36 @@ port. Also, the port used can be changed by passing the --port option.\n"
exn)
(lambda ()
- (bytevector->nix-base32-string
- (call-with-input-file filename
- (lambda (compressed-port)
- (call-with-lzip-input-port
- compressed-port
- (lambda (port)
- (port-hash* (hash-algorithm sha256)
- port
- #:reporter
- (progress-reporter/hash
- (stat:size (stat filename))
- (lambda (processed-bytes)
- (put-message
- channel
- `(update ,filename ,processed-bytes))))))))
- #:binary #t)))
+ (let ((hash
+ (bytevector->nix-base32-string
+ (call-with-input-file filename
+ (lambda (compressed-port)
+ (call-with-lzip-input-port
+ compressed-port
+ (lambda (port)
+ (port-hash* (hash-algorithm sha256)
+ port
+ #:reporter
+ (progress-reporter/hash
+ (stat:size (stat filename))
+ (lambda (processed-bytes)
+ (put-message
+ channel
+ `(update ,filename ,processed-bytes))))))))
+ #:binary #t))))
+
+ (log-msg logger
+ 'DEBUG
+ "computed the hash of " filename ", renaming")
+
+ (call-with-output-file (string-append output-filename ".hash")
+ (lambda (port)
+ (simple-format port "~A\n" hash)))
+
+ (rename-file filename
+ output-filename)
+
+ hash))
#:unwind? #t))
(let ((channel (make-channel))
@@ -336,7 +350,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
(log-msg 'ERROR "exception in output hash thread: " exn))
(lambda ()
(match (get-message channel)
- (('request build-uuid filename update-channel)
+ (('request build-uuid filename output-filename update-channel)
(or (and=>
(hash-ref update-channels-by-filename
filename)
@@ -360,7 +374,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
(list 'result
filename
(compute-hash-of-uploaded-output channel
- filename))))))))
+ filename
+ output-filename))))))))
(('update filename bytes-processed)
(for-each
(lambda (update-channel)
@@ -394,7 +409,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
request
response-port
build-uuid
- tmp-output-file-name)
+ tmp-output-file-name
+ output-file-name)
(let ((channel (make-channel)))
(define (write-to-response-port response)
(display response response-port)
@@ -416,7 +432,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
(const 'timeout)))))
(put-message output-hash-channel
- (list 'request build-uuid tmp-output-file-name channel))
+ (list 'request build-uuid tmp-output-file-name output-file-name channel))
(let loop ((previous-bytes-processed 0)
(message (get-message* channel)))
@@ -770,25 +786,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
;; Make sure NGinx gets the response headers
(force-output (request-port request))
- (let ((result (compute-output-hash-via-channel
- output-hash-channel
- request
- response-port
- uuid
- tmp-output-file-name)))
- ;; TODO: Maybe do something different here to
- ;; indicate the issue to the agent?
- (unless (exception? result)
- (log-msg logger
- 'DEBUG
- "computed the hash of " tmp-output-file-name ", renaming")
-
- (call-with-output-file (string-append output-file-name ".hash")
- (lambda (port)
- (simple-format port "~A\n" result)))
-
- (rename-file tmp-output-file-name
- output-file-name))))))
+ (compute-output-hash-via-channel
+ output-hash-channel
+ request
+ response-port
+ uuid
+ tmp-output-file-name
+ output-file-name))))
(render-json
'(("error" . "access denied"))
#:code 403))))
@@ -851,25 +855,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
;; Make sure NGinx gets the response headers
(force-output (request-port request))
- (let ((result (compute-output-hash-via-channel
- output-hash-channel
- request
- response-port
- uuid
- tmp-output-file-name)))
- ;; TODO: Maybe do something different here to
- ;; indicate the issue to the agent?
- (unless (exception? result)
- (log-msg logger
- 'DEBUG
- "computed the hash of " tmp-output-file-name ", renaming")
-
- (call-with-output-file (string-append output-file-name ".hash")
- (lambda (port)
- (simple-format port "~A\n" result)))
-
- (rename-file tmp-output-file-name
- output-file-name))))))
+ (compute-output-hash-via-channel
+ output-hash-channel
+ request
+ response-port
+ uuid
+ tmp-output-file-name
+ output-file-name))))
(render-json
'(("error" . "access denied"))
#:code 403))))