[racket] WebSocket server dropping connections
I am using the WebSocket server and having problems with connections
dropping unexpectedly. I am connecting from Chrome 10 (dev channel).
In the connection handler I register callbacks (which get asynchronously
called in other threads) and use ws-send! in them.
The callback looks like this:
#v+
(define ((event-sender name [ws (current-websocket)]) obj key old new)
(if (ws-conn-closed? ws)
(begin
(eprintf "~a.~a: conn closed\n" (object-name obj) key)
(remove-current-observer))
(parameterize ([current-websocket ws])
(try
(send-json! (list "changed" (symbol->string name)
(symbol->string key)
(if (void? old) #\null old) new))
(eprintf "send failed for websocket: ~a\n" (debug-ws ws))))))
(define (debug-ws ws)
(append (for/list ([i (in-range 5)]) (unsafe-vector-ref ws i))
(list (port-closed? (unsafe-vector-ref ws 3))
(port-closed? (unsafe-vector-ref ws 4)))))
#v-
The ws-conn-closed? returns #f. The debug-ws uses unsafe ops to extract
tcp ports. Both report closed at this point.
I pasted my server initialization code below. None of the logging
statements get executed in the dropped connection case.
My only guess is that the connection threads get garbage collected while
waiting on the tcp input-port.
#v+
(define (handle-handshake bs hs)
(define origin
(header-value (headers-assq* #"Origin" hs)))
(values
(list (make-header #"Sec-WebSocket-Origin" origin)
(make-header #"Sec-WebSocket-Location"
#"ws://localhost:8080/"))
#f))
(define (handle-connection sock state)
(parameterize ([current-websocket sock])
(log-info (format "client connected: ~s" (debug-ws
(current-websocket))))
(with-handlers ([exn:fail:network? (exn-handler (λ (msg) (log-debug
msg)))]
[exn:fail? (exn-handler (λ (msg) (log-error msg)))]
[(λ (exn) #t) (λ (exn) (log-error (format "WTF?:
~s" exn)) (raise exn))])
(let loop ()
(let ([m (ws-recv (current-websocket))])
(cond
[(eof-object? m)
(log-info (format "client disconnected: ~s" (debug-ws
(current-websocket))))]
[else
(log-debug (format "message received: ~a" m))
(let ([msg (try (json->jsexpr m)
(raise-proto-error "malformed ws message:
~s" m))])
(handle-request msg)
(loop))]))))
(log-info "exiting from handle-client")
(remove-observers!)))
(define (start-server)
(ws-serve handle-connection
#:port 8080
#:conn-headers handle-handshake))
#v-
--
regards,
Jakub Piotr Cłapa