syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
minimart/drivers/websocket.rkt
View File

@ -66,37 +66,40 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Connection ;; 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) (define (shutdown-connection state)
(if (connection-state-shutdown-procedure state) (when (connection-state-shutdown-procedure state)
(begin ((connection-state-shutdown-procedure state)) ((connection-state-shutdown-procedure state))
(transition (struct-copy connection-state state [shutdown-procedure #f]) (quit))) (set-connection-state-shutdown-procedure! state #f))
state)) (transition state (quit)))
(define (websocket-connection e state) (define (websocket-connection e state)
(match e (with-handlers [((lambda (exn) #t)
[(message (event _ _) 1 #f) (lambda (exn) (shutdown-connection state)))]
(match-define (connection-state seen-peer? local-id port c _) state) (match e
(and seen-peer? [(message (event _ _) 1 #f)
(let ((m (ws-recv c #:payload-type 'text))) (match-define (connection-state seen-peer? local-id port c _) state)
(if (eof-object? m) (and seen-peer?
(shutdown-connection state) (let ((m (ws-recv c #:payload-type 'text)))
(transition state (send (websocket-message local-id (if (eof-object? m)
(websocket-server port) (shutdown-connection state)
m))))))] (transition state (send (websocket-message local-id
[(message (websocket-message _ _ m) 0 #f) (websocket-server port)
(ws-send! (connection-state-c state) m) m))))))]
#f] [(message (websocket-message _ _ m) 0 #f)
[(routing-update routes) (ws-send! (connection-state-c state) m)
(cond #f]
[(and (connection-state-seen-peer? state) (null? routes)) [(routing-update routes)
(shutdown-connection state)] (cond
[(and (not (connection-state-seen-peer? state)) (pair? routes)) [(and (connection-state-seen-peer? state) (null? routes))
(transition (struct-copy connection-state state [seen-peer? #t]) '())] (shutdown-connection state)]
[else [(and (not (connection-state-seen-peer? state)) (pair? routes))
#f])] (transition (struct-copy connection-state state [seen-peer? #t]) '())]
[#f #f])) [else
#f])]
[#f #f])))
(define (spawn-connection port c shutdown-procedure) (define (spawn-connection port c shutdown-procedure)
(define local-id (websocket-remote-client (gensym 'ws))) (define local-id (websocket-remote-client (gensym 'ws)))