diff options
| -rw-r--r-- | web/socket/server.scm | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/web/socket/server.scm b/web/socket/server.scm index 66b8cc1..04ab5d4 100644 --- a/web/socket/server.scm +++ b/web/socket/server.scm @@ -26,6 +26,7 @@ (define-module (web socket server) #:use-module (ice-9 match) #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) #:use-module (web request) #:use-module (web response) #:use-module (web uri) @@ -95,6 +96,10 @@ called for each complete message that is received." (when response (write-frame response client-socket)))) + (define (read-frame-maybe) + (and (not (port-eof? client-socket)) + (read-frame client-socket))) + ;; Perform the HTTP handshake and upgrade to WebSocket protocol. (let* ((request (read-handshake-request client-socket)) (client-key (assoc-ref (request-headers request) 'sec-websocket-key)) @@ -102,14 +107,19 @@ called for each complete message that is received." (write-response response client-socket) (let loop ((fragments '()) (type #f)) - (let ((frame (read-frame client-socket))) + (let ((frame (read-frame-maybe))) (cond + ;; EOF - port is closed. + ((not frame) + (close-port client-socket)) ;; Per section 5.4, control frames may appear interspersed ;; along with a fragmented message. ((close-frame? frame) ;; Per section 5.5.1, echo the close frame back to the - ;; client before closing the socket. - (write-frame (make-close-frame (frame-data frame)) client-socket) + ;; client before closing the socket. The client may no + ;; longer be listening. + (false-if-exception + (write-frame (make-close-frame (frame-data frame)) client-socket)) (close-port client-socket)) ((ping-frame? frame) ;; Per section 5.5.3, a pong frame must include the exact @@ -140,6 +150,7 @@ client in response to their message, and #f indicates that nothing should be sent back." ;; TODO: Handle multiple simultaneous clients. (listen server-socket 1) + (sigaction SIGPIPE SIG_IGN) (let loop () (serve-client (accept-new-client server-socket) handler) (loop))) |