[Gd-chatter] r11608 - in trunk/libraries/network/koala: . config sources/examples/koala-basics sources/koala
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Sun Jan 6 15:44:02 CET 2008
Author: cgay
Date: Sun Jan 6 15:44:01 2008
New Revision: 11608
Modified:
trunk/libraries/network/koala/config/koala-config.xml
trunk/libraries/network/koala/sources/examples/koala-basics/main.dylan
trunk/libraries/network/koala/sources/koala/config.dylan
trunk/libraries/network/koala/sources/koala/dsp.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
trunk/libraries/network/koala/sources/koala/session.dylan
trunk/libraries/network/koala/to-do.txt
Log:
Job: koala
* Fix the Koala demo project to match new APIs.
* Fix default koala-config.xml (comments can't contain --)
Modified: trunk/libraries/network/koala/config/koala-config.xml
==============================================================================
Binary files. No diff available.
Modified: trunk/libraries/network/koala/sources/examples/koala-basics/main.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/examples/koala-basics/main.dylan (original)
+++ trunk/libraries/network/koala/sources/examples/koala-basics/main.dylan Sun Jan 6 15:44:01 2008
@@ -34,11 +34,9 @@
// Responds to a single URL.
define responder responder1 ("/responder1")
- (request :: <request>,
- response :: <response>)
- select (request-method(request))
+ select (request-method(current-request()))
#"get", #"post"
- => format(output-stream(response),
+ => format(output-stream(current-response()),
"<html><body>This is the output of a 'define responder' form."
"<p>Use your browser's Back button to return to the example."
"</body></html>");
@@ -47,11 +45,10 @@
// Responds to a single directory (i.e., prefix) URL.
define directory responder dir1 ("/dir1")
- (request :: <request>,
- response :: <response>)
- select (request-method(request))
+ let request = current-request();
+ select (request.request-method)
#"get", #"post"
- => format(output-stream(response),
+ => format(output-stream(current-response()),
"<html><body>This is a directory responder. The part of the url after "
"the directory was %s."
"<p>Use your browser's Back button to return to the example."
@@ -67,9 +64,9 @@
// Slightly higher level than responders. Gives you the convenience of not
// having to figure out whether it's a GET, POST, HEAD, request, and the ability
// to dispatch on your own page classes. Just define methods for
-// respond-to-get, respond-to-post, and/or respond-to-head that dispatch on your
-// page class. Note that the default methods for GET and HEAD do nothing and
-// the default method for POST calls the method for GET.
+// respond-to that dispatch on your page class. Note that the default methods
+// for GET and HEAD do nothing and the default method for POST calls the method
+// for GET.
// This defines a <hello-world-page> class which is a subclass of <page>, and a
// variable called *hello-world-page* which is an instance of
@@ -85,13 +82,14 @@
// find all the values passed in the URL (e.g., /hello?foo=1&bar=2). You can
// also use get-query-value to get a specific query value, and
// count-query-values can be used to find out how many there are. Note that
-// respond-to-post automatically calls respond-to-get, unless you override it.
+// respond-to(#"post", ...) automatically calls respond-to(#"get", unless you
+// override it.
//
-define method respond-to-get (page :: <hello-world-page>,
- request :: <request>,
- response :: <response>)
- let stream :: <stream> = output-stream(response);
- format(stream, "<html>\n<head><title>Hello World</title></head>\n<body>Hello there.<p>");
+define method respond-to
+ (request-method == #"get", page :: <hello-world-page>)
+ let stream :: <stream> = output-stream(current-response());
+ format(stream, "<html>\n<head><title>Hello World</title></head>\n"
+ "<body>Hello there.<p>");
format(stream, "%s<br>", if (count-query-values() > 0)
"Query values are:"
else
@@ -108,7 +106,7 @@
// Dylan Server Pages are also defined with the "define page" macro, but you
// also specify the source: argument which is a file that contains normal
-// HTML plus DSP tags. The default method for respond-to-get parses the DSP
+// HTML plus DSP tags. The default method for respond-to GET parses the DSP
// source file and displays it. Any HTML is output directly to the output
// stream, and tags invoke the corresponding tag definition code.
@@ -144,9 +142,9 @@
// Defines a tag that looks like <demo:hello/> in the DSP source file. i.e.,
// it has no body.
define tag hello in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
- format(output-stream(response), "Hello, world!");
+ format(output-stream(current-response()), "Hello, world!");
end;
define page args-page (<demo-page>)
@@ -161,17 +159,17 @@
// parse-tag-arg generic.
//
define tag show-keys in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
(arg1 :: <integer>, arg2)
- format(output-stream(response),
+ format(output-stream(current-response()),
"The value of arg1 + 1 is %=. The value of arg2 is %=.",
arg1 + 1, arg2);
end;
define named-method logged-in? in demo
- (page, request)
- let session = get-session(request);
+ (page :: <demo-page>)
+ let session = get-session(current-request());
session & get-attribute(session, #"username");
end;
@@ -185,10 +183,9 @@
source: "demo/logout.dsp")
end;
-define method respond-to-get (page :: <example-logout-page>,
- request :: <request>,
- response :: <response>)
- let session = get-session(request);
+define method respond-to
+ (request-method == #"get", page :: <example-logout-page>)
+ let session = get-session(current-request());
remove-attribute(session, #"username");
remove-attribute(session, #"password");
next-method(); // Must call this if you want the DSP template to be processed.
@@ -201,33 +198,33 @@
end;
// ...so handle the POST by storing the form values in the session.
-define method respond-to-post (page :: <example-welcome-page>,
- request :: <request>,
- response :: <response>)
+define method respond-to
+ (request-method == #"post", page :: <example-welcome-page>)
let username = get-query-value("username");
let password = get-query-value("password");
let username-supplied? = username & username ~= "";
let password-supplied? = password & password ~= "";
if (username-supplied? & password-supplied?)
- let session = get-session(request);
+ let session = get-session(current-request());
set-attribute(session, #"username", username);
set-attribute(session, #"password", password);
next-method(); // process the DSP template for the welcome page.
else
note-form-error("You must supply <b>both</b> a username and password.");
- // ---*** TODO: Calling respond-to-get probably isn't quite right.
+ // ---*** TODO: Calling respond-to(#"get", ...) probably isn't quite right.
// If we're redirecting to another page should the query/form values
// be cleared first? Probably want to call process-page instead,
// but with the existing request?
- respond-to-get(*example-login-page*, request, response);
+ respond-to(#"get", *example-login-page*);
end;
end;
// Note this tag is defined on <demo-page> so it can be accessed from any
// page in this example web application.
define tag current-username in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
+ let response = current-response();
let username
= get-form-value("username")
| get-attribute(get-session(get-request(response)), #"username");
@@ -254,7 +251,7 @@
// See iterator.dsp for how this tag is invoked.
//
define body tag repeat in demo
- (page :: <demo-page>, response :: <response>, do-body :: <function>)
+ (page :: <demo-page>, do-body :: <function>)
()
let n-str = get-query-value("n");
let n = (n-str & string-to-integer(n-str)) | 5;
@@ -266,9 +263,9 @@
end;
define tag display-iteration-number in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
- format(output-stream(response), "%d", *repetition-number*);
+ format(output-stream(current-response()), "%d", *repetition-number*);
end;
@@ -295,30 +292,30 @@
end;
define tag english-word in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
let row = current-row();
- format(output-stream(response), "%s", row[0]);
+ format(output-stream(current-response()), "%s", row[0]);
end;
define tag spanish-word in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
let row = current-row();
- format(output-stream(response), "%s", row[1]);
+ format(output-stream(current-response()), "%s", row[1]);
end;
define tag pinyin-word in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
let row = current-row();
- format(output-stream(response), "%s", row[2]);
+ format(output-stream(current-response()), "%s", row[2]);
end;
define tag row-bgcolor in demo
- (page :: <demo-page>, response :: <response>)
+ (page :: <demo-page>)
()
- write(output-stream(response),
+ write(output-stream(current-response()),
if(even?(current-row-number())) "#EEEEEE" else "#FFFFFF" end);
end;
@@ -348,21 +345,10 @@
/// Main
-// Starts up the web server.
-define function main () => ()
- let config-file =
- if(application-arguments().size > 0)
- application-arguments()[0]
- end;
- // This is only necessary when running this example in FunDev/Linux
- // because it doesn't have load-library. In Windows the koala-basics
- // library can be loaded at startup time by putting a
- // <module name="koala-basics"/>
- // directive in the config file and commenting out this call to start-server.
- start-server(config-file: config-file);
-end;
-
begin
- main();
+ // If you don't need to add any new command-line arguments you can just
+ // call koala-main directly. It requires that you pass --config <filename>
+ // on the command line.
+ koala-main();
end;
Modified: trunk/libraries/network/koala/sources/koala/config.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/config.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/config.dylan Sun Jan 6 15:44:01 2008
@@ -58,11 +58,18 @@
return();
end;
end method;
- log-info("Loading server configuration from %s.", config-loc);
let text = file-contents(config-loc);
if (text)
- let xml :: xml$<document> = xml$parse-document(text);
- process-config-node(xml);
+ log-info("Loading server configuration from %s.", config-loc);
+ // --todo: Fix parse-document to give a reasonable error message
+ // instead of just returning #f.
+ let xml :: false-or(xml$<document>) = xml$parse-document(text);
+ if (xml)
+ process-config-node(xml);
+ else
+ log-error("Unable to parse config file!");
+ *abort-startup?* := #t;
+ end
else
log-error("Server configuration file (%s) not found.", config-loc);
*abort-startup?* := #t;
@@ -104,6 +111,7 @@
end;
define method process-config-node (node :: xml$<element>) => ()
+ log-debug("Processing config element %=", xml$name(node));
process-config-element(node, xml$name(node));
end;
@@ -295,22 +303,22 @@
else
let location = get-attr(node, #"location");
let max-size = get-attr(node, #"max-size");
+ let default-size = 20 * 1024 * 1024;
block ()
max-size := string-to-integer(max-size);
- exception (e :: <error>)
+ exception (ex :: <error>)
warn("<LOG> element has invalid max-size attribute (%s). "
- "The default (%d) will be used.", max-size);
+ "The default (%d) will be used.", max-size, default-size);
end;
let log = iff(location,
make(<rolling-file-log-target>,
file: merge-locators(as(<file-locator>, location),
*server-root*),
- max-size: max-size | 20000000),
+ max-size: max-size | default-size),
make(<stream-log-target>,
stream: iff(string-equal?(type, "error"),
*standard-error*,
*standard-output*)));
-
select (type by string-equal?)
"error", "errors"
=> %error-log-target(active-vhost()) := log;
Modified: trunk/libraries/network/koala/sources/koala/dsp.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/dsp.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/dsp.dylan Sun Jan 6 15:44:01 2008
@@ -101,12 +101,6 @@
(url :: <string>, page :: <page>, #key replace?, prefix?)
=> (responder :: <function>)
bind (responder = curry(process-page, page))
- let source = source-location(page);
- log-debug("Registering URL %s (%s)",
- url,
- iff(source,
- sformat("source: %s", as(<string>, source)),
- "dynamic"));
register-url(url, responder, replace?: replace?, prefix?: prefix?);
*page-to-url-map*[page] := url;
responder
@@ -681,8 +675,8 @@
end;
-// define tag foo in tlib (page, response) () do-stuff end
-// define body tag foo in tlib (page, response, do-body) (foo, bar :: <integer>) do-stuff end
+// define tag foo in tlib (page) () do-stuff end
+// define body tag foo in tlib (page, do-body) (foo, bar :: <integer>) do-stuff end
//
define macro tag-definer
// There are two syntaxes (one with the "body" modifier and one without) so that
Modified: trunk/libraries/network/koala/sources/koala/server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/server.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/server.dylan Sun Jan 6 15:44:01 2008
@@ -945,7 +945,6 @@
end;
// define responder test ("/test" /* , secure?: #t */ )
-// (request, response)
// format(output-stream(response), "<html><body>test</body></html>");
// end;
define macro responder-definer
Modified: trunk/libraries/network/koala/sources/koala/session.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/session.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/session.dylan Sun Jan 6 15:44:01 2008
@@ -13,6 +13,8 @@
// #f means no max-age is transmitted, which means "until the user agent exits".
define variable *session-max-age* :: false-or(<integer>) = #f;
+define constant $koala-session-id :: <byte-string> = "koala_session_id";
+
// API
// This doesn't affect any cookies set previously.
define method set-session-max-age
@@ -72,7 +74,7 @@
if (session)
remove-key!(*sessions*, session.session-id);
request.request-session := #f;
- add-cookie(*response*, "koala_session_id", -1,
+ add-cookie(*response*, $koala-session-id, -1,
max-age: *session-max-age*,
path: "/",
// domain: ??? ---TODO
@@ -85,22 +87,23 @@
define method current-session
(request :: <request>) => (session :: false-or(<session>))
let cookies = request-header-value(request, #"cookie");
- when (cookies)
- block (return)
- for (cookie in cookies)
- when (cookie-name(cookie) = "koala_session_id")
- let session-id = string-to-integer(cookie-value(cookie));
- return(element(*sessions*, session-id, default: #f));
- end;
- end;
- end;
- end;
-end;
+ let cookie =
+ cookies & find-element(cookies,
+ method (cookie)
+ cookie-name(cookie) = $koala-session-id
+ end);
+ if (cookie)
+ let session-id = string-to-integer(cookie-value(cookie));
+ element(*sessions*, session-id, default: #f) | new-session(request)
+ else
+ new-session(request)
+ end
+end method current-session;
define method new-session
(request :: <request>) => (session :: <session>)
let id = next-session-id();
- add-cookie(*response*, "koala_session_id", id,
+ add-cookie(*response*, $koala-session-id, id,
max-age: *session-max-age*,
path: "/",
// domain: ??? ---TODO
Modified: trunk/libraries/network/koala/to-do.txt
==============================================================================
--- trunk/libraries/network/koala/to-do.txt (original)
+++ trunk/libraries/network/koala/to-do.txt Sun Jan 6 15:44:01 2008
@@ -1,9 +1,16 @@
Koala To-Do List
----------------
+* Make koala as easy to use as an HTTP server in Python. Something like this:
+ use koala;
+ let config = make(<config>, locator: "/tmp/koala-config.xml"); // optional
+ let server = make(<http-server>, config: config);
+ register-url("/foo", method (request, response) ... end;
+ start-server(server, in-new-thread?: #f);
+
* Ability to bind to a specific IP address.
-* Thread pool. Can be expensive to allocate/deallocate a threads.
+* Thread pool. Can be expensive to allocate/deallocate threads.
* Fix security issues...
More information about the chatter
mailing list