diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-10-21 11:43:39 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-10-21 11:43:39 +0100 |
| commit | b782e752205422054c932bd3a8196dcfdc33b346 (patch) | |
| tree | 32f3ed75fedca97ea3468f5a831dcc81a2cbbfff | |
| parent | 5156d4d354fd7d7c5986d36180dd8dcfd639d90a (diff) | |
| download | build-coordinator-b782e752205422054c932bd3a8196dcfdc33b346.tar build-coordinator-b782e752205422054c932bd3a8196dcfdc33b346.tar.gz | |
Log the file size and md5 hash on the agent side
When errors occur during upload.
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 16 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 6 |
2 files changed, 20 insertions, 2 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 217b2c1..c4cf59b 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -37,6 +37,8 @@ #:use-module (web request) #:use-module (web response) #:use-module (web uri) + #:use-module (gcrypt base16) + #:use-module (gcrypt hash) #:use-module (lzlib) #:use-module ((gnutls) #:select (gnutls-version)) #:use-module ((guix config) #:select (%guix-version)) @@ -277,6 +279,11 @@ (define file-size (stat:size (stat file))) + (define file-md5-hash-promise + (delay + (bytevector->base16-string + (file-hash (hash-algorithm md5) file)))) + (define (get-partial-upload-bytes) (let-values (((body response) (coordinator-http-request @@ -389,7 +396,14 @@ (eq? uploaded-bytes file-size))) (retry-on-error perform-upload #:times 100 - #:delay 40))) + #:delay 40 + #:error-hook + (lambda _ + (log 'DEBUG + "perform-upload " file + " (bytes: " file-size ", " + "md5: " (force file-md5-hash-promise) + ")"))))) args)) (define-method (submit-log-file diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 67ebf72..961e225 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -732,7 +732,7 @@ References: ~a~%" (canonical-sexp->string (signed-string info))))) (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature))) -(define* (retry-on-error f #:key times delay ignore) +(define* (retry-on-error f #:key times delay ignore error-hook) (let loop ((attempt 1)) (match (with-exception-handler (lambda (exn) @@ -773,6 +773,8 @@ References: ~a~%" attempt times delay) + (when error-hook + (error-hook attempt exn)) (sleep delay) (simple-format (current-error-port) @@ -789,6 +791,8 @@ References: ~a~%" attempt times delay) + (when error-hook + (error-hook attempt exn)) (sleep delay) (loop (+ 1 attempt)))))))) |