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.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))))