Clearer presentation of error logging for distributed/tcp
This commit is contained in:
parent
54a83b8998
commit
1f978aade4
|
@ -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))))
|
||||
|
|
Loading…
Reference in New Issue