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