diff options
Diffstat (limited to 'guix-build-coordinator/agent-messaging')
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http/server.scm | 110 |
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)))) |