Clearer presentation of error logging for distributed/tcp

This commit is contained in:
Tony Garnock-Jones 2024-05-17 20:38:37 +02:00
parent 54a83b8998
commit 1f978aade4
1 changed files with 10 additions and 4 deletions

View File

@ -6,6 +6,7 @@
run-tcp-server-relay)
(require (only-in file/sha1 bytes->hex-string))
(require (only-in racket/string string-split))
(require syndicate/distributed/gatekeeper)
(require syndicate/drivers/tcp)
(require syndicate/relay)
@ -20,9 +21,14 @@
#:name [name (list 'tcp-client hostname port)]
#:import import-handler)
(define (on-error message)
(define ((on-error context) message)
(define first-line
(match (string-split message "\n")
[(cons s _) s]
['() ""]))
(stop-current-facet
(log-syndicate/distributed/tcp-error "~a" message)))
(log-syndicate/distributed/tcp-error "~a: ~a" context first-line)
(log-syndicate/distributed/tcp-debug "~a: full message: ~a" context message)))
(define active-source #f)
(define relay #f)
@ -39,11 +45,11 @@
#:assert (lambda (a _h) (import-handler a))))
#:name (list name 'relay)
#:initial-oid 0))
#:on-rejected on-error
#:on-rejected (on-error 'rejected)
#:on-disconnect (lambda ()
(stop-current-facet
(log-syndicate/distributed/tcp-info "Disconnected")))
#:on-error on-error
#:on-error (on-error 'error)
#:on-data (lambda (data _mode)
(send-bytes-credit active-source (bytes-length data))
(accept-bytes relay data))))