summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThomas Hintz <t@thintz.com>2014-10-17 07:19:34 -0700
committerThomas Hintz <t@thintz.com>2014-10-17 07:19:34 -0700
commit4bb341913fa21b6b994bac41ba56fe214103f461 (patch)
tree3c01d186a214a469f88b2d09df660bf27c533f33
parent3fd9e266a1b09664270a06a400812a8572e93e32 (diff)
downloadwebsockets-4bb341913fa21b6b994bac41ba56fe214103f461.tar.gz
Checking that the websocket is still open before pinging or timeing
out the connection.
-rw-r--r--websockets.scm27
1 files changed, 16 insertions, 11 deletions
diff --git a/websockets.scm b/websockets.scm
index 2830267..119a3b6 100644
--- a/websockets.scm
+++ b/websockets.scm
@@ -488,7 +488,8 @@
(begin
(send-frame ws 'connection-close
(u8vector 3 (close-reason->close-code close-reason))
- #t)))))))
+ #t))))
+ "close timeout thread")))
(thread-start! close-thread)
(if (> (close-timeout) 0)
(unless (thread-join! close-thread (close-timeout) #f)
@@ -540,8 +541,10 @@
(lambda ()
(let loop ()
(thread-sleep! (ping-interval))
- (send-message "" 'ping ws)
- (loop))))))
+ (when (eq? (websocket-state ws) 'open)
+ (send-message "" 'ping ws)
+ (loop))))
+ "ping thread")))
; make sure the request meets the spec for websockets
(cond ((not (and (eq? (header-value 'connection headers #f) 'upgrade)
@@ -572,14 +575,16 @@
; Add one to attempt to alleviate checking the timestamp
; right before when the timeout should happen.
(thread-sleep! (+ 1 (connection-timeout)))
- (if (< (- (time->seconds (current-time))
- (time->seconds (websocket-last-message-timestamp ws)))
- (connection-timeout))
- (loop)
- (begin (thread-signal! (websocket-user-thread ws)
- (make-websocket-exception
- (make-property-condition 'connection-timeout)))
- (close-websocket ws close-reason: 'going-away))))))))
+ (when (eq? (websocket-state ws) 'open)
+ (if (< (- (time->seconds (current-time))
+ (time->seconds (websocket-last-message-timestamp ws)))
+ (connection-timeout))
+ (loop)
+ (begin (thread-signal!
+ (websocket-user-thread ws)
+ (make-websocket-exception
+ (make-property-condition 'connection-timeout)))
+ (close-websocket ws close-reason: 'going-away)))))))))
(when (> (ping-interval) 0)
(thread-start! ping-thread))