[racket] web-server and comet-like requests?
>>> The Web Server will kill connections after a relatively short timeout.
>>> You'll get an exception when you finally try to use the connection.
>>> This isn't very nice for COMET. You'll have to reset the timeout on
>>> the connection manually.
Alternatively, I can well force timeouts to work on my own terms. Ok,
I have a solution that seems to be working a bit better, with some
sample code below. If you run it, it opens up a browser. Calling
send-to-client with values should show on the browser immediately.
Controlled timeouts will add horizontal lines to visually show when
the comet connection's being re-established.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#lang racket
;; Comet demonstration
(require web-server/servlet-env
web-server/http/bindings
web-server/http/response-structs)
(define ch (make-channel))
(void
(thread (lambda ()
(define (start req)
(cond [(exists-binding? 'comet (request-bindings req))
(handle-comet req)]
[else
(handle-default req)]))
(serve/servlet start
#:servlet-path "/comet"
#:banner? #f
#:launch-browser? #t
#:port 8080))))
;; How long will we wait until we ask the client to try again?
;; 30 second timeout for the moment.
(define *alarm-timeout* 30000)
;; handle-comet: request -> response
(define (handle-comet req)
(let* ([an-alarm (alarm-evt (+ (current-inexact-milliseconds)
*alarm-timeout*))]
[v (sync ch an-alarm)])
(cond
[(eq? v an-alarm)
;; Cause the client to see that they need to try reconnecting
(response/full 200 #"Try again"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" #""))]
[else
(response/full 200 #"Okay"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" (string->bytes/utf-8 (format "~s" v))))])))
;; handle-default: request -> response
(define (handle-default req)
(let ([default-page
(format
#<<EOF
<html>
<head>
<script>
var startComet = function() {
// http://www.quirksmode.org/js/xmlhttp.html
//
// XMLHttpRequest wrapper. Transparently restarts the request
// if a timeout occurs.
var sendRequest = function(url,callback,postData) {
var req = createXMLHTTPObject(), method, TIMEOUT = ~s;
if (!req) return;
method = (postData) ? "POST" : "GET";
req.open(method,url,true);
if (postData) {
req.setRequestHeader('Content-type','application/x-www-form-urlencoded');
}
req.onreadystatechange = function () {
if (req.readyState !== 4) return;
if (req.status === 200 && req.statusText === 'Try again') {
req.abort();
document.body.appendChild(document.createElement("hr"));
setTimeout(function() { sendRequest(url, callback,
postData); }, 0);
return;
}
if (req.status !== 200 && req.status !== 304) {
return;
}
callback(req);
}
if (req.readyState === 4) return;
req.send(postData);
}
var XMLHttpFactories = [
function () {return new XMLHttpRequest()},
function () {return new ActiveXObject("Msxml2.XMLHTTP")},
function () {return new ActiveXObject("Msxml3.XMLHTTP")},
function () {return new ActiveXObject("Microsoft.XMLHTTP")}
];
var createXMLHTTPObject = function() {
var xmlhttp = false;
for (var i=0;i<XMLHttpFactories.length;i++) {
try {
xmlhttp = XMLHttpFactories[i]();
}
catch (e) {
continue;
}
break;
}
return xmlhttp;
}
sendRequest("/comet",
function(req) {
document.body.appendChild(document.createTextNode(req.responseText));
document.body.appendChild(document.createElement("br"));
setTimeout(startComet, 0);
},
"comet=t");
};
var whenLoaded = function() {
setTimeout(startComet, 0);
};
</script>
</head>
<body onLoad="whenLoaded()">
</body>
</html>
EOF
*alarm-timeout*)])
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" (string->bytes/utf-8 default-page)))))
;; send-to-client: any -> void
;; Sends a message to the client.
(define (send-to-client v)
(channel-put ch v))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;