[Gd-chatter] r11470 - trunk/libraries/network/koala/sources/koala
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Tue Oct 23 06:45:40 CEST 2007
Author: cgay
Date: Tue Oct 23 06:45:39 2007
New Revision: 11470
Modified:
trunk/libraries/network/koala/sources/koala/dsp.dylan
trunk/libraries/network/koala/sources/koala/koala-main.dylan
trunk/libraries/network/koala/sources/koala/library-unix.dylan
trunk/libraries/network/koala/sources/koala/library.dylan
trunk/libraries/network/koala/sources/koala/log.dylan
trunk/libraries/network/koala/sources/koala/responders.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
trunk/libraries/network/koala/sources/koala/urls.dylan
trunk/libraries/network/koala/sources/koala/utils.dylan
trunk/libraries/network/koala/sources/koala/vhost.dylan
trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan
Log:
job: koala
Fixed some formatting, added comments, minor stuff.
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 Tue Oct 23 06:45:39 2007
@@ -73,11 +73,6 @@
define open primary class <page> (<object>)
end;
-define method print-object
- (page :: <page>, stream)
- format(stream, "%s", page-url(page));
-end;
-
// The protocol every page needs to support.
define open generic respond-to-get (page :: <page>, request :: <request>, response :: <response>);
define open generic respond-to-post (page :: <page>, request :: <request>, response :: <response>);
@@ -124,6 +119,8 @@
respond-to-head(page, request, response);
end;
+// What do these two methods buy us? It's hard to find callers
+// of such short method names too. --cgay
define method post (page :: <page>)
respond-to(#"post", page, current-request(), current-response());
end;
@@ -689,7 +686,6 @@
=> { page-aux(?name; ?superclasses; ?make-args; ?slot-specs);
has-url?(?make-args) & register-page-urls("*" ## ?name ## "*", ?make-args, prefix?: #t)
}
-
end;
define macro page-aux
@@ -699,7 +695,9 @@
end;
define function has-url? (#key url :: false-or(<string>), #all-keys)
=> (url-provided? :: <boolean>);
- url ~= #f
+ if (url)
+ #t
+ end;
end;
define function register-page-urls
Modified: trunk/libraries/network/koala/sources/koala/koala-main.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/koala-main.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/koala-main.dylan Tue Oct 23 06:45:39 2007
@@ -57,7 +57,6 @@
*standard-output*,
usage: "koala [options]",
description: desc);
- exit-application(0);
else
if (option-value-by-long-name(parser, "debug"))
*debugging-server* := #t;
Modified: trunk/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library-unix.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library-unix.dylan Tue Oct 23 06:45:39 2007
@@ -272,7 +272,7 @@
create
print-object;
- // files
+ // Files
create
static-file-responder;
@@ -390,11 +390,12 @@
<static-page>,
register-page, // Register a page for a given URL
url-to-page,
- respond-to-get, // outdated
- respond-to-post, // outdated
- respond-to-head, // outdated
- respond-to, // Implement this for you page to handle a request
- get, post, // convenience
+ respond-to-get, // Implement this for your page to handle GET requests
+ respond-to-post, // Implement this for your page to handle POST requests
+ respond-to-head, // Implement this for your page to handle HEAD requests
+ respond-to, // Implement this for other request methods
+ get, // convenience
+ post, // convenience
page-source,
page-source-setter,
@@ -428,7 +429,8 @@
/*
// Persistence layer maps database records <-> web pages.
export
- note-field-error, // for errors related to processing a specific form field with-database-connection,
+ note-field-error, // for errors related to processing a specific form field
+ with-database-connection,
<database-record>,
<modifiable-record>,
initialize-record,
Modified: trunk/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/library.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/library.dylan Tue Oct 23 06:45:39 2007
@@ -65,7 +65,6 @@
wrapping-inc!,
file-contents,
pset, // multiple-value-setq
- ignore-errors,
path-element-equal?,
parent-directory,
date-to-stream,
Modified: trunk/libraries/network/koala/sources/koala/log.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/log.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/log.dylan Tue Oct 23 06:45:39 2007
@@ -73,7 +73,7 @@
// backend targets such as streams, files, databases, etc.
//
define abstract class <log-target> (<closable-object>)
- slot log-level :: <log-level> = $log-info,
+ slot log-level :: <log-level> = $log-verbose,
init-keyword: #"log-level";
end;
Modified: trunk/libraries/network/koala/sources/koala/responders.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/responders.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/responders.dylan Tue Oct 23 06:45:39 2007
@@ -46,20 +46,6 @@
format-arguments: vector(code-string)));
end;
-// Shutdown the server. You definately don't want this active in a
-// production setting.
-//
-/*
-define responder shutdown-responder ("/koala/shutdown")
- (request, response)
- let stream = output-stream(response);
- let server = request.request-server;
- format(stream, "<html><body>Shutting down...</body></html>");
- force-output(stream);
- stop-server(abort: #t);
-end;
-*/
-
// Load a module
//
define responder load-module-responder ("/koala/load-module")
@@ -75,7 +61,7 @@
end;
define function load/unload-module
- (request, response, op :: one-of(#"load", #"unload"))
+ (request :: <request>, response :: <response>, op :: one-of(#"load", #"unload"))
let stream = output-stream(response);
let server = request.request-server;
let module-name = get-query-value("name");
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 Tue Oct 23 06:45:39 2007
@@ -62,6 +62,7 @@
//slot pathname-translations :: <sequence> = #();
//// Statistics
+ // todo -- move these elsewhere
slot connections-accepted :: <integer> = 0; // Connections accepted
constant slot user-agent-stats :: <string-table> = make(<string-table>);
@@ -433,7 +434,7 @@
// so that it will return from 'accept' with some error, which we should
// catch gracefully..
//---TODO: need to handle errors.
-// Listen and spawn handlers until listener socket gets broken.
+// Listen and spawn handlers until listener socket breaks.
//
define function do-http-listen (listener :: <listener>)
let server = listener.listener-server;
@@ -1085,11 +1086,12 @@
//disposition = "multipart/form-data" => ...
if (disposition = "form-data")
let content = substring(second(part), 0, size(second(part)) - 1);
- request.request-query-values[name] := if (filename & type)
- make(<http-file>, filename: filename, content: content, mime-type: type);
- else
- content;
- end if;
+ request.request-query-values[name]
+ := if (filename & type)
+ make(<http-file>, filename: filename, content: content, mime-type: type);
+ else
+ content;
+ end if;
end if;
end if;
log-debug("multipart/form-data for %=: %=, %=, %=", name, disposition, type, filename);
Modified: trunk/libraries/network/koala/sources/koala/urls.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/urls.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/urls.dylan Tue Oct 23 06:45:39 2007
@@ -125,15 +125,19 @@
define function current-url (#key escaped?)
=> (uri :: <string>);
- let request = current-request();
- concatenate(if (escaped?)
- encode-url(request.request-url, reserved?: #t)
- else
- current-request().request-url
- end if, if (~empty?(request.request-query-string))
- concatenate("?", request.request-query-string)
- else "" end if);
-end;
+ let request = current-request();
+ let path = if (escaped?)
+ encode-url(request.request-url, reserved?: #t)
+ else
+ current-request().request-url
+ end if;
+ let query-string = if (~empty?(request.request-query-string))
+ concatenate("?", request.request-query-string)
+ else
+ ""
+ end if;
+ concatenate(path, query-string)
+end current-url;
define function parse-http-server (str :: <byte-string>,
net-beg :: <integer>,
Modified: trunk/libraries/network/koala/sources/koala/utils.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/utils.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/utils.dylan Tue Oct 23 06:45:39 2007
@@ -40,17 +40,22 @@
define function file-contents
- (filename :: <pathname>) => (contents :: false-or(<string>))
+ (filename :: <pathname>, #key error? :: <boolean>)
+ => (contents :: false-or(<string>))
// In FD 2.0 SP1 if-does-not-exist: #f still signals an error if the file doesn't exist.
// Remove this block when fixed. (Reported to Fun-O August 2001.)
block ()
with-open-file(input-stream = filename,
direction: #"input",
- if-does-not-exist: #f)
+ if-does-not-exist: if (error?) #"error" else #f end)
read-to-end(input-stream)
end
- exception (<file-does-not-exist-error>)
- #f
+ exception (ex :: <file-does-not-exist-error>)
+ if (error?)
+ signal(ex)
+ else
+ #f
+ end
end
end file-contents;
@@ -200,8 +205,9 @@
if (trie.trie-object = #f | replace?)
trie.trie-object := object;
else
- signal(make(<trie-error>,
- format-string: format-to-string("Trie already contains an object for the given path (%=).", path)))
+ let fmt = format-to-string("Trie already contains an object for the "
+ "given path (%=).", path);
+ signal(make(<trie-error>, format-string: fmt))
end;
else
let first-path = rest-path[0];
Modified: trunk/libraries/network/koala/sources/koala/vhost.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/vhost.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/vhost.dylan Tue Oct 23 06:45:39 2007
@@ -9,22 +9,28 @@
// Some methods to make logging slightly more convenient by not having
// to always pass log-target(*virtual-host*).
define method log-copious (format-string, #rest format-args)
- apply(%log-copious, *temp-log-target* | debug-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-copious, *temp-log-target* | debug-log-target(*virtual-host*),
+ format-string, format-args);
end;
define method log-verbose (format-string, #rest format-args)
- apply(%log-verbose, *temp-log-target* | debug-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-verbose, *temp-log-target* | debug-log-target(*virtual-host*),
+ format-string, format-args);
end;
define method log-debug (format-string, #rest format-args)
- apply(%log-debug, *temp-log-target* | debug-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-debug, *temp-log-target* | debug-log-target(*virtual-host*),
+ format-string, format-args);
end;
define method log-info (format-string, #rest format-args)
- apply(%log-info, *temp-log-target* | debug-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-info, *temp-log-target* | debug-log-target(*virtual-host*),
+ format-string, format-args);
end;
define method log-warning (format-string, #rest format-args)
- apply(%log-warning, *temp-log-target* | error-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-warning, *temp-log-target* | error-log-target(*virtual-host*),
+ format-string, format-args);
end;
define method log-error (format-string, #rest format-args)
- apply(%log-error, *temp-log-target* | error-log-target(*virtual-host*), format-string, format-args);
+ apply(%log-error, *temp-log-target* | error-log-target(*virtual-host*),
+ format-string, format-args);
end;
@@ -92,6 +98,8 @@
// port.
slot vhost-port :: <integer> = 80;
+ // I'd like to rename this to vhost-bind-address or maybe vhost-listen-ip-address,
+ // and probably use a constant for INADDR_ANY. --cgay
slot vhost-ip :: <string> = "0.0.0.0";
// List of <directory-spec> objects that determine how documents in
Modified: trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/xml-rpc-server.dylan Tue Oct 23 06:45:39 2007
@@ -66,6 +66,7 @@
define method lookup-xml-rpc-method
(method-name :: <string>)
=> (f :: false-or(<function>))
+ // todo -- Implement namespaces (methods named x.y.z)
element($xml-rpc-methods, method-name, default: #f)
end;
@@ -104,7 +105,6 @@
*debugging-xml-rpc*
& log-debug("Sending XML: %=", xml);
write(stream, xml);
- //to-xml(result, stream);
write(stream, "</value></param></params></methodResponse>\r\n");
end;
More information about the chatter
mailing list