From 221d2d0e6eb4b093d6eb98e5ffcd91cec157a9fc Mon Sep 17 00:00:00 2001 From: Thomas Hintz Date: Sat, 18 Oct 2014 10:59:34 -0700 Subject: [PATCH] Failing connection on invalid UTF8 in close reason. --- websockets.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/websockets.scm b/websockets.scm index 9f39779..1960482 100644 --- a/websockets.scm +++ b/websockets.scm @@ -451,8 +451,13 @@ (define (process-fragments fragments optype #!optional (ws (current-websocket))) (let ((message-body (string-concatenate/shared (reverse (map unmask fragments))))) - (when (and (eq? optype 'text) - (not (valid-utf8? message-body))) + (when (and (or (eq? optype 'text) (eq? optype 'connection-close)) + (not (valid-utf8? + (if (eq? optype 'text) + message-body + (if (> (string-length message-body) 2) + (substring message-body 2) + ""))))) (set-websocket-state! ws 'error) (signal (make-websocket-exception (make-property-condition @@ -497,7 +502,10 @@ #t) (let loop () (receive (data type) (receive-message ws) - (unless (eq? type 'connection-close) (loop))))) + (if (eq? type 'connection-close) + (unless (valid-utf8? data) + (set! close-reason 'invalid-data)) + (loop))))) (begin (send-frame ws 'connection-close (u8vector 3 (close-reason->close-code close-reason))