aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/agent-messaging/http/server.scm41
1 files changed, 23 insertions, 18 deletions
diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 5e8467f..c101853 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -291,12 +291,20 @@ port. Also, the port used can be changed by passing the --port option.\n"
(define logger
(build-coordinator-logger build-coordinator))
+ (define (log-msg/safe . args)
+ (with-exception-handler
+ (const #t)
+ (lambda ()
+ (apply log-msg args))
+ #:unwind? #t))
+
(define (compute-hash-of-uploaded-output channel filename output-filename)
(with-exception-handler
(lambda (exn)
- (log-msg logger
- 'WARN
- "error computing hash: " exn)
+ (log-msg/safe
+ logger
+ 'WARN
+ "error computing hash: " exn)
(when (file-exists? filename)
(let ((md5-hash
@@ -306,7 +314,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
(stat:size (stat filename))))
;; I've seen exceptions happen here from lzip, so try
;; deleting the tmp file so that it's re-uploaded.
- (log-msg logger 'WARN "deleting " filename)
+ (log-msg/safe logger 'WARN "deleting " filename)
(delete-file filename)
(raise-exception
@@ -336,9 +344,10 @@ port. Also, the port used can be changed by passing the --port option.\n"
`(update ,filename ,processed-bytes))))))))
#:binary #t))))
- (log-msg logger
- 'DEBUG
- "computed the hash of " filename ", renaming")
+ (log-msg/safe
+ logger
+ 'DEBUG
+ "computed the hash of " filename ", renaming")
(call-with-output-file (string-append output-filename ".hash")
(lambda (port)
@@ -382,12 +391,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
(while #t
(with-exception-handler
(lambda (exn)
- (with-exception-handler
- ;; Don't stop the thread, even if the logging fails
- (const #t)
- (lambda ()
- (log-msg logger 'ERROR "exception in output hash thread: " exn))
- #:unwind? #t))
+ (log-msg/safe logger 'ERROR "exception in output hash thread: " exn))
(lambda ()
(display-info)
@@ -397,15 +401,15 @@ port. Also, the port used can be changed by passing the --port option.\n"
(hash-ref update-channels-by-filename
filename)
(lambda (existing-channels)
- (log-msg logger 'DEBUG build-uuid
- ": adding channel to list for " filename)
+ (log-msg/safe logger 'DEBUG build-uuid
+ ": adding channel to list for " filename)
(hash-set! update-channels-by-filename
filename
(cons update-channel
existing-channels))))
(begin
- (log-msg logger 'DEBUG build-uuid
- ": starting thread to compute hash for " filename)
+ (log-msg/safe logger 'DEBUG build-uuid
+ ": starting thread to compute hash for " filename)
(hash-set! update-channels-by-filename
filename
@@ -429,7 +433,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
exn)))
(lambda ()
(set-thread-name "hash output")
- (log-msg logger 'DEBUG build-uuid ": computing hash of " filename)
+ (log-msg/safe logger 'DEBUG build-uuid
+ ": computing hash of " filename)
(put-message
channel