|
|
@ -488,7 +488,8 @@
|
|
|
|
(begin
|
|
|
|
(begin
|
|
|
|
(send-frame ws 'connection-close
|
|
|
|
(send-frame ws 'connection-close
|
|
|
|
(u8vector 3 (close-reason->close-code close-reason))
|
|
|
|
(u8vector 3 (close-reason->close-code close-reason))
|
|
|
|
#t)))))))
|
|
|
|
#t))))
|
|
|
|
|
|
|
|
"close timeout thread")))
|
|
|
|
(thread-start! close-thread)
|
|
|
|
(thread-start! close-thread)
|
|
|
|
(if (> (close-timeout) 0)
|
|
|
|
(if (> (close-timeout) 0)
|
|
|
|
(unless (thread-join! close-thread (close-timeout) #f)
|
|
|
|
(unless (thread-join! close-thread (close-timeout) #f)
|
|
|
@ -540,8 +541,10 @@
|
|
|
|
(lambda ()
|
|
|
|
(lambda ()
|
|
|
|
(let loop ()
|
|
|
|
(let loop ()
|
|
|
|
(thread-sleep! (ping-interval))
|
|
|
|
(thread-sleep! (ping-interval))
|
|
|
|
|
|
|
|
(when (eq? (websocket-state ws) 'open)
|
|
|
|
(send-message "" 'ping ws)
|
|
|
|
(send-message "" 'ping ws)
|
|
|
|
(loop))))))
|
|
|
|
(loop))))
|
|
|
|
|
|
|
|
"ping thread")))
|
|
|
|
|
|
|
|
|
|
|
|
; make sure the request meets the spec for websockets
|
|
|
|
; make sure the request meets the spec for websockets
|
|
|
|
(cond ((not (and (eq? (header-value 'connection headers #f) 'upgrade)
|
|
|
|
(cond ((not (and (eq? (header-value 'connection headers #f) 'upgrade)
|
|
|
@ -572,14 +575,16 @@
|
|
|
|
; Add one to attempt to alleviate checking the timestamp
|
|
|
|
; Add one to attempt to alleviate checking the timestamp
|
|
|
|
; right before when the timeout should happen.
|
|
|
|
; right before when the timeout should happen.
|
|
|
|
(thread-sleep! (+ 1 (connection-timeout)))
|
|
|
|
(thread-sleep! (+ 1 (connection-timeout)))
|
|
|
|
|
|
|
|
(when (eq? (websocket-state ws) 'open)
|
|
|
|
(if (< (- (time->seconds (current-time))
|
|
|
|
(if (< (- (time->seconds (current-time))
|
|
|
|
(time->seconds (websocket-last-message-timestamp ws)))
|
|
|
|
(time->seconds (websocket-last-message-timestamp ws)))
|
|
|
|
(connection-timeout))
|
|
|
|
(connection-timeout))
|
|
|
|
(loop)
|
|
|
|
(loop)
|
|
|
|
(begin (thread-signal! (websocket-user-thread ws)
|
|
|
|
(begin (thread-signal!
|
|
|
|
|
|
|
|
(websocket-user-thread ws)
|
|
|
|
(make-websocket-exception
|
|
|
|
(make-websocket-exception
|
|
|
|
(make-property-condition 'connection-timeout)))
|
|
|
|
(make-property-condition 'connection-timeout)))
|
|
|
|
(close-websocket ws close-reason: 'going-away))))))))
|
|
|
|
(close-websocket ws close-reason: 'going-away)))))))))
|
|
|
|
|
|
|
|
|
|
|
|
(when (> (ping-interval) 0)
|
|
|
|
(when (> (ping-interval) 0)
|
|
|
|
(thread-start! ping-thread))
|
|
|
|
(thread-start! ping-thread))
|
|
|
|