Ensure shutdown of websocket connection on exn

This commit is contained in:
Tony Garnock-Jones 2013-10-30 14:25:48 +00:00
parent 9242d264b3
commit cb4746033d
1 changed files with 30 additions and 27 deletions

View File

@ -66,15 +66,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Connection
(struct connection-state (seen-peer? local-id port c shutdown-procedure) #:transparent)
(struct connection-state (seen-peer? local-id port c [shutdown-procedure #:mutable])
#:transparent)
(define (shutdown-connection state)
(if (connection-state-shutdown-procedure state)
(begin ((connection-state-shutdown-procedure state))
(transition (struct-copy connection-state state [shutdown-procedure #f]) (quit)))
state))
(when (connection-state-shutdown-procedure state)
((connection-state-shutdown-procedure state))
(set-connection-state-shutdown-procedure! state #f))
(transition state (quit)))
(define (websocket-connection e state)
(with-handlers [((lambda (exn) #t)
(lambda (exn) (shutdown-connection state)))]
(match e
[(message (event _ _) 1 #f)
(match-define (connection-state seen-peer? local-id port c _) state)
@ -96,7 +99,7 @@
(transition (struct-copy connection-state state [seen-peer? #t]) '())]
[else
#f])]
[#f #f]))
[#f #f])))
(define (spawn-connection port c shutdown-procedure)
(define local-id (websocket-remote-client (gensym 'ws)))