Drain ws-ch in an additional, previously-overlooked case

This commit is contained in:
Tony Garnock-Jones 2019-05-16 12:39:16 +01:00
parent 12c255bb40
commit eafd5771b5
1 changed files with 7 additions and 4 deletions

View File

@ -275,7 +275,8 @@
(list))) (list)))
(output-response/method conn (output-response/method conn
resp resp
(request-method req))))) (request-method req))
(drain-ws-ch! ws-ch))))
((make-general-websockets-dispatcher ((make-general-websockets-dispatcher
(websocket-connection-main id ws-ch) (websocket-connection-main id ws-ch)
(lambda _args (values reply-headers (void)))) (lambda _args (values reply-headers (void))))
@ -317,9 +318,11 @@
(loop)])))) (loop)]))))
(ws-close! wsc)) (ws-close! wsc))
(when (not quit-seen?) (when (not quit-seen?)
(let loop () (drain-ws-ch! ws-ch)))
(when (not (equal? (channel-get ws-ch) 'quit))
(loop))))) (define (drain-ws-ch! ws-ch)
(when (not (equal? (channel-get ws-ch) 'quit))
(drain-ws-ch! ws-ch)))
;; D-: uck barf ;; D-: uck barf
;; TODO: something to fix this :-/ ;; TODO: something to fix this :-/