Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 65e965e9d9
Fetching contributors…

Cannot retrieve contributors at this time

459 lines (391 sloc) 14.237 kb
#lang racket/base
(require racket/list
web-server/servlet
web-server/servlet-env)
;; Evaluate JavaScript expressions in the browser and get their results.
;;
;; Sets up a web server and opens a browser window.
;; The page on screen periodically polls the server to see if a program has
;; come in to be evaluated. Whenever code does come in, evaluates and returns the
;; value to the user, along with the time it took to evaluate.
(provide make-evaluate
simple-js-evaluate
js-evaluate
(struct-out error-happened)
(struct-out evaluated))
(define-struct (error-happened exn:fail) (t) #:transparent)
(define-struct evaluated (stdout value t
browser) #:transparent)
(define ch
(let ()
(define port (+ 8000 (random 8000)))
;; This channel's meant to serialize use of the web server.
(define ch (make-channel))
;; start up the web server
;; The web server responds to two types of requests
;; ?comet Starting up the comet request path.
;; ?v Getting a value back from evaluation.
;; ?e Got an error.
(void
(thread (lambda ()
(define (start req)
(cond
;; Server-side sync for a program
[(exists-binding? 'comet (request-bindings req))
(handle-comet ch req)]
;; Normal result came back
[(exists-binding? 'v (request-bindings req))
(handle-normal-response req)]
;; Error occurred
[(exists-binding? 'e (request-bindings req))
(handle-error-response req)]
[else
(make-on-first-load-response)]))
(serve/servlet start
#:banner? #f
#:launch-browser? #t
#:quit? #f
#:port port
#:servlet-path "/eval"))))
ch))
(define *alarm-timeout* 30000)
(define (handle-comet ch req)
(let/ec return
(let* ([alarm (alarm-evt (+ (current-inexact-milliseconds) *alarm-timeout*))]
[javascript-compiler+program (sync ch alarm)]
[op (open-output-bytes)])
(cond
[(eq? javascript-compiler+program alarm)
(try-again-response)]
[else
(let ([javascript-compiler (first javascript-compiler+program)]
[program (second javascript-compiler+program)])
(with-handlers ([exn:fail? (lambda (exn)
(displayln exn)
(let ([sentinel
(format
#<<EOF
(function () {
return function(success, fail, params) {
fail(~s);
}
});
EOF
(exn-message exn))])
(return
(response/full 200 #"Okay"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" (string->bytes/utf-8 sentinel))))))])
(javascript-compiler program op))
(response/full 200 #"Okay"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" (get-output-bytes op))))]))))
(define (try-again-response)
(response/full 200 #"Try again"
(current-seconds)
#"text/plain; charset=utf-8"
empty
(list #"" #"")))
(define (ok-response)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" #"<html><head></head><body><p>ok</p></body></html>")))
(define (handle-normal-response req)
(channel-put ch (make-evaluated (extract-binding/single 'o (request-bindings req))
(extract-binding/single 'v (request-bindings req))
(string->number
(extract-binding/single 't (request-bindings req)))
(extract-binding/single 'b (request-bindings req))))
(ok-response))
(define (handle-error-response req)
(channel-put ch (make-error-happened
(extract-binding/single 'e (request-bindings req))
(current-continuation-marks)
(string->number
(extract-binding/single 't (request-bindings req)))))
(ok-response))
(define (make-on-first-load-response)
(let ([op (open-output-bytes)])
(fprintf op #<<EOF
<html>
<head>
<script>
// http://www.quirksmode.org/js/xmlhttp.html
//
// XMLHttpRequest wrapper. Transparently restarts the request
// if a timeout occurs.
function sendRequest(url,callback,postData) {
var req = createXMLHTTPObject(), method;
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.status !== 304) {
return;
}
if (req.status === 200 && req.statusText === 'Try again') {
delete req.onreadystateschange;
setTimeout(function() { sendRequest(url, callback, postData); }, 0);
return;
}
delete req.onreadystateschange;
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")}
];
function createXMLHTTPObject() {
var xmlhttp = false;
for (var i=0;i<XMLHttpFactories.length;i++) {
try {
xmlhttp = XMLHttpFactories[i]();
}
catch (e) {
continue;
}
break;
}
return xmlhttp;
}
var comet = function() {
sendRequest("/eval",
function(req) {
// debug:
//if (window.console && typeof(console.log) === 'function') {
// console.log(req.responseText);
//}
try {
var invoke = eval(req.responseText)();
} catch (e) {
if (window.console && window.console.log && e.stack) { window.console.log(e.stack); }
throw e;
}
var output = [];
var startTime, endTime;
var params = { currentDisplayer: function(v) {
document.body.appendChild(v);
output.push(v.textContent); } };
var successCalled = false;
var onSuccess = function(v) {
if (successCalled) { return; }
successCalled = true;
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"v=" + encodeURIComponent(String(v)) +
"&o=" + encodeURIComponent(output.join('')) +
"&t=" + encodeURIComponent(String(endTime - startTime)) +
"&b=" + encodeURIComponent(String(BrowserDetect.browser + ' ' + BrowserDetect.version + '/' + BrowserDetect.OS)));
};
var failCalled = false;
var onFail = function(e) {
if (failCalled) { return; }
failCalled = true;
endTime = new Date();
sendRequest("/eval", function(req) { setTimeout(comet, 0); },
"e=" + encodeURIComponent(String(e.stack || e)) +
"&t=" + encodeURIComponent(String(endTime - startTime)));
};
startTime = new Date();
try {
invoke(onSuccess, onFail, params);
} catch(e) {
onFail(e);
}
},
"comet=t");
};
var BrowserDetect = {
init: function () {
this.browser = this.searchString(this.dataBrowser) || "An unknown browser";
this.version = this.searchVersion(navigator.userAgent)
|| this.searchVersion(navigator.appVersion)
|| "an unknown version";
this.OS = this.searchString(this.dataOS) || "an unknown OS";
},
searchString: function (data) {
for (var i=0;i<data.length;i++) {
var dataString = data[i].string;
var dataProp = data[i].prop;
this.versionSearchString = data[i].versionSearch || data[i].identity;
if (dataString) {
if (dataString.indexOf(data[i].subString) != -1)
return data[i].identity;
}
else if (dataProp)
return data[i].identity;
}
},
searchVersion: function (dataString) {
var index = dataString.indexOf(this.versionSearchString);
if (index == -1) return;
return parseFloat(dataString.substring(index+this.versionSearchString.length+1));
},
dataBrowser: [
{
string: navigator.userAgent,
subString: "Chrome",
identity: "Chrome"
},
{ string: navigator.userAgent,
subString: "OmniWeb",
versionSearch: "OmniWeb/",
identity: "OmniWeb"
},
{
string: navigator.vendor,
subString: "Apple",
identity: "Safari",
versionSearch: "Version"
},
{
prop: window.opera,
identity: "Opera"
},
{
string: navigator.vendor,
subString: "iCab",
identity: "iCab"
},
{
string: navigator.vendor,
subString: "KDE",
identity: "Konqueror"
},
{
string: navigator.userAgent,
subString: "Firefox",
identity: "Firefox"
},
{
string: navigator.vendor,
subString: "Camino",
identity: "Camino"
},
{ // for newer Netscapes (6+)
string: navigator.userAgent,
subString: "Netscape",
identity: "Netscape"
},
{
string: navigator.userAgent,
subString: "MSIE",
identity: "Explorer",
versionSearch: "MSIE"
},
{
string: navigator.userAgent,
subString: "Gecko",
identity: "Mozilla",
versionSearch: "rv"
},
{ // for older Netscapes (4-)
string: navigator.userAgent,
subString: "Mozilla",
identity: "Netscape",
versionSearch: "Mozilla"
}
],
dataOS : [
{
string: navigator.platform,
subString: "Win",
identity: "Windows"
},
{
string: navigator.platform,
subString: "Mac",
identity: "Mac"
},
{
string: navigator.userAgent,
subString: "iPhone",
identity: "iPhone/iPod"
},
{
string: navigator.platform,
subString: "Linux",
identity: "Linux"
}
]
};
BrowserDetect.init();
var whenLoaded = function() {
setTimeout(comet, 0);
};
</script>
</head>
<body onload="whenLoaded()">
<p>Harness loaded. Do not close this window.</p>
</body>
</html>
EOF
)
(response/full 200 #"Okay"
(current-seconds)
TEXT/HTML-MIME-TYPE
empty
(list #"" (get-output-bytes op)))))
;; make-evaluate: (Any output-port) -> (sexp -> (values string number))
;; Produce a JavaScript evaluator that cooperates with a browser.
;; The JavaScript-compiler is expected to write out a thunk. When invoked,
;; the thunk should return a function that consumes three values, corresponding
;; to success, failure, and other parameters to evaluation. For example:
;;
;; (make-evaluate (lambda (program op)
;; (fprintf op "(function() {
;; return function(success, fail, params) {
;; success('ok');
;; }})")))
;;
;; is a do-nothing evaluator that will always give back 'ok'.
;;
;; At the moment, the evaluator will pass in a parameter that binds 'currentDisplayer' to a function
;; that captures output.
(define (make-evaluate javascript-compiler)
;; evaluate: sexp -> (values string number)
;; A little driver to test the evalution of expressions, using a browser to help.
;; Returns the captured result of stdout, plus # of milliseconds it took to execute.
(define (evaluate e)
;; Send the program to the web browser, and wait for the thread to send back
(channel-put ch (list javascript-compiler e))
(let ([result (channel-get ch)])
(cond [(error-happened? result)
(let ([marks (current-continuation-marks)])
(raise (update-marks result)))]
[else
result])))
evaluate)
(define (update-marks exn)
(make-error-happened (exn-message exn)
(exn-continuation-marks exn)
(error-happened-t exn)))
(define simple-js-evaluate
(make-evaluate (lambda (p op)
(display "(function() {" op)
(display " return (function($SUCC, $FAIL, $PARAMS) {" op)
(display p op)
(display "\n $SUCC(); });" op)
(display " })" op))))
(define js-evaluate
(make-evaluate (lambda (p op)
(display "(function() {" op)
(display " return (function($SUCC, $FAIL, $PARAMS) {" op)
(display p op)
(display " }); })" op))))
#;(simple-js-evaluate "alert('hello world');")
Jump to Line
Something went wrong with that request. Please try again.