summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThomas Hintz <t@thintz.com>2014-10-18 10:59:34 -0700
committerThomas Hintz <t@thintz.com>2014-10-18 10:59:34 -0700
commit221d2d0e6eb4b093d6eb98e5ffcd91cec157a9fc (patch)
treed42f7c720e1340b70dbd3798f8b89170aaeeef4b
parent3efccc88aaa4d5a9d8840d70cb975b85b7637232 (diff)
downloadwebsockets-221d2d0e6eb4b093d6eb98e5ffcd91cec157a9fc.tar.gz
Failing connection on invalid UTF8 in close reason.
-rw-r--r--websockets.scm14
1 files 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))