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