From bb002f95851befc2d5830294685b526703923e99 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 25 Mar 2016 09:11:21 -0400
Subject: server: Handle client disconnects in a more robust manner.

* web/socket/server.scm (serve-client): Handle EOF object and client
sockets that have closed while trying to echo the close frame.
(run-server): Ignore SIGPIPE to prevent server crashes.
---
 web/socket/server.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

(limited to 'web/socket/server.scm')

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)))
-- 
cgit v1.2.3