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

Improvements in error-handling for websocket connections re: deadlock, closed ports etc.

This commit is contained in:
Tony Garnock-Jones 2016-12-06 05:55:00 +13:00
parent 64cfce2472
commit c019a61c18
1 changed files with 35 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
racket/syndicate/drivers/web.rkt
View File

@ -462,31 +462,41 @@
(regexp-match #px"port is closed" (exn-message e))))
(define ((websocket-connection-main id ws-ch) wsc _ws-connection-state)
(let loop ()
(sync (handle-evt wsc
(lambda _args
(define msg
(with-handlers ([exn:fail:network? (lambda (e) eof)]
[exn:fail:port-is-closed? (lambda (e) eof)]
[exn:fail? (lambda (e)
(log-syndicate/drivers/web-error
"Unexpected ws-recv error: ~a"
(exn->string e))
eof)])
(ws-recv wsc #:payload-type 'text)))
(send-ground-message (web-incoming-message id msg))
(loop)))
(handle-evt ws-ch
(match-lambda
['quit
(void)]
[(list 'send m)
(with-handlers [(exn:fail:port-is-closed?
(lambda (e)
(ws-close! wsc)))]
(ws-send! wsc m))
(loop)]))))
(ws-close! wsc))
(define quit-seen? #f)
(define (shutdown!)
(send-ground-message (web-incoming-message id eof))
(with-handlers ([(lambda (e) #t)
(lambda (e)
(log-syndicate/drivers/web-info
"Unexpected ws-close! error: ~a"
(if (exn? e)
(exn->string e)
(format "~v" e))))])
(ws-close! wsc)))
(with-handlers [(exn:fail:network? (lambda (e) (shutdown!)))
(exn:fail:port-is-closed? (lambda (e) (shutdown!)))
(exn:fail? (lambda (e)
(log-syndicate/drivers/web-error
"Unexpected websocket error: ~a"
(exn->string e))
(shutdown!)))]
(let loop ()
(sync (handle-evt wsc (lambda _args
(define msg (ws-recv wsc #:payload-type 'text))
(send-ground-message (web-incoming-message id msg))
(loop)))
(handle-evt ws-ch (match-lambda
['quit
(set! quit-seen? #t)
(void)]
[(list 'send m)
(ws-send! wsc m)
(loop)]))))
(ws-close! wsc))
(when (not quit-seen?)
(let loop ()
(when (not (equal? (channel-get ws-ch) 'quit))
(loop)))))
(define (bad-request conn req)
(output-response/method conn