[Gd-chatter] r11193 - in branches/koala-config-cleanup/libraries/network: koala/config koala/sources/examples/koala-basics koala/sources/koala wiki
cgay at gwydiondylan.org
cgay at gwydiondylan.org
Tue Feb 20 06:48:30 CET 2007
Author: cgay
Date: Tue Feb 20 06:48:24 2007
New Revision: 11193
Added:
branches/koala-config-cleanup/libraries/network/koala/sources/koala/variables.dylan (contents, props changed)
Removed:
branches/koala-config-cleanup/libraries/network/koala/sources/koala/dsp-main.dylan
Modified:
branches/koala-config-cleanup/libraries/network/koala/config/koala-config.xml
branches/koala-config-cleanup/libraries/network/koala/config/mime-type-map.xml
branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/library.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/main.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/config.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/dsp.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-main.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-unix.lid
branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala.lid
branches/koala-config-cleanup/libraries/network/koala/sources/koala/library-unix.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/library.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/log.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/server.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/static-files.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/utils.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/vhost.dylan
branches/koala-config-cleanup/libraries/network/koala/sources/koala/xml-rpc-server.dylan
branches/koala-config-cleanup/libraries/network/wiki/classes.dylan
Log:
job: koala
Checkpoint a few more config-related changes:
* Removed broken auto-responder code. This should be replaced by
register-responder-for-filename-extension(#"dsp", fn), probably per directory spec.
* Give most of the vhost slots init-keyword arguments, in case someone wants to
cons up a vhost without a config file.
* Removed brain-dead fall-back-to-default-virtual-host in favor of just letting
the configuration's default-virtual-host be #f.
* XML RPC code cleaned up to allow any number of XML RPC URLs per <http-server>.
* Got rid of abort-startup?. Just signal. Duh.
* Moved default mime-type-map into code. mime-type config file can now override
or augment it with <mime-type-map location="..." clear="true"/>, but we need a
reasonable default if no config file is used.
Modified: branches/koala-config-cleanup/libraries/network/koala/config/koala-config.xml
==============================================================================
Binary files. No diff available.
Modified: branches/koala-config-cleanup/libraries/network/koala/config/mime-type-map.xml
==============================================================================
Binary files. No diff available.
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/library.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/library.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/library.dylan Tue Feb 20 06:48:24 2007
@@ -20,7 +20,7 @@
use threads;
use common-extensions,
exclude: { format-to-string, split };
- use locators;
+ use locators, rename: { <http-server> => <http-server-url> };
use format;
use streams;
use dsp;
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/main.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/main.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/examples/koala-basics/main.dylan Tue Feb 20 06:48:24 2007
@@ -30,10 +30,13 @@
*/
+define constant $http-config :: <http-server-configuration>
+ = make(<http-server-configuration>);
+
//// Responders -- the lowest level API for responding to a URL
// Responds to a single URL.
-define responder responder1 ("/responder1")
+define responder responder1 ($http-config, "/responder1")
(request :: <request>,
response :: <response>)
select (request-method(request))
@@ -46,7 +49,7 @@
end;
// Responds to a single directory (i.e., prefix) URL.
-define directory responder dir1 ("/dir1")
+define directory responder dir1 ($http-config, "/dir1")
(request :: <request>,
response :: <response>)
select (request-method(request))
@@ -77,7 +80,8 @@
// *hello-world-page* instance.
//
define page hello-world-page (<page>)
- (url: "/hello-world",
+ (config: $http-config,
+ url: "/hello-world",
alias: "/hello")
end;
@@ -132,12 +136,14 @@
end;
define page home-page (<demo-page>)
- (url: "/demo/home.dsp",
+ (config: $http-config,
+ url: "/demo/home.dsp",
source: "demo/home.dsp")
end;
define page hello-page (<demo-page>)
- (url: "/demo/hello.dsp",
+ (config: $http-config,
+ url: "/demo/hello.dsp",
source: "demo/hello.dsp")
end;
@@ -150,7 +156,8 @@
end;
define page args-page (<demo-page>)
- (url: "/demo/args.dsp",
+ (config: $http-config,
+ url: "/demo/args.dsp",
source: "demo/args.dsp")
end;
@@ -176,12 +183,14 @@
end;
define page example-login-page (<demo-page>)
- (url: "/demo/login.dsp",
+ (config: $http-config,
+ url: "/demo/login.dsp",
source: "demo/login.dsp")
end;
define page example-logout-page (<demo-page>)
- (url: "/demo/logout.dsp",
+ (config: $http-config,
+ url: "/demo/logout.dsp",
source: "demo/logout.dsp")
end;
@@ -196,7 +205,8 @@
// The login page POSTs to the welcome page...
define page example-welcome-page (<demo-page>)
- (url: "/demo/welcome.dsp",
+ (config: $http-config,
+ url: "/demo/welcome.dsp",
source: "demo/welcome.dsp")
end;
@@ -238,7 +248,8 @@
//// iterator
define page iterator-page (<demo-page>)
- (url: "/demo/iterator.dsp",
+ (config: $http-config,
+ url: "/demo/iterator.dsp",
source: "demo/iterator.dsp")
end;
@@ -275,7 +286,8 @@
//// table generation
define page table-page (<demo-page>)
- (url: "/demo/table.dsp",
+ (config: $http-config,
+ url: "/demo/table.dsp",
source: "demo/table.dsp")
end;
@@ -324,43 +336,31 @@
/// XML-RPC (use any XML-RPC client to call these)
-
-begin
- register-xml-rpc-method("test.zero",
- method () end);
- register-xml-rpc-method("test.one",
- method () 1 end);
- register-xml-rpc-method("test.two",
- method () "two" end);
- register-xml-rpc-method("test.three",
- method () vector(1, "two", 3.0) end);
- register-xml-rpc-method("test.four",
- method ()
- let result = make(<table>);
- result["x"] := vector(vector(7), 8);
- result["y"] := "my <dog> has fleas";
- result
- end);
+define function configure-xml-rpc-server ()
+ let xml-rpc-config = make(<xml-rpc-configuration>, debug?: #t);
+ register-method(xml-rpc-config, "test.zero", method () end);
+ register-method(xml-rpc-config, "test.one", method () 1 end);
+ register-method(xml-rpc-config, "test.two", method () "two" end);
+ register-method(xml-rpc-config, "test.three", method () vector(1, "two", 3.0) end);
+ register-method(xml-rpc-config, "test.four",
+ method ()
+ let result = make(<table>);
+ result["x"] := vector(vector(7), 8);
+ result["y"] := "my <dog> has fleas";
+ result
+ end);
+ register-url($http-config, "/RPC2", xml-rpc-config);
end;
-
-
-
/// 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;
+define function main
+ () => ()
+ configure-xml-rpc-server();
+ let server = make(<http-server>, configuration: $http-config);
+ start-server(server, wait?: #t)
+end function main;
begin
main();
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/config.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/config.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/config.dylan Tue Feb 20 06:48:24 2007
@@ -7,8 +7,12 @@
define constant $config-directory-name :: <string> = "conf";
-define constant $log-directory-name :: <string> = "logs";
-define constant $document-directory-name :: <string> = "www";
+
+// For any time the user specifies something that would cause an invalid
+// server configuration.
+//
+define class <configuration-error> (<koala-error>)
+end;
// This class holds all information that is configurable in a given Koala
// <http-server> instance.
@@ -22,7 +26,7 @@
// debug Dylan Server Pages. Can be enabled via the --debug
// command-line option.
slot debugging-enabled? :: <boolean> = #f,
- init-keyword: #"debug?";
+ init-keyword: debug?:;
// Map from URL string to a response function. The leading slash is removed
// from URLs because it's easier to use merge-locators that way.
@@ -32,116 +36,103 @@
// works we use <module foo> inside <virtual-host> in the config
// and bind *virtual-host* while the library is loading?
- constant slot url-map :: <string-trie> = make(<string-trie>, object: #f);
+ slot url-map :: <string-trie> = make(<string-trie>, object: #f),
+ init-keyword: url-map:;
// The top of the directory tree under which the server's
// configuration, error, and log files are kept. Other pathnames are
// merged against this one, so if they're relative they will be
// relative to this. The server-root pathname is relative to the
// current working directory, unless changed in the config file.
- slot server-root :: <directory-locator> = as(<file-locator>, "."),
- init-keyword: #"server-root";
+ slot server-root :: <directory-locator> = as(<directory-locator>, "."),
+ init-keyword: server-root:;
- constant slot mime-type-map :: <table> = make(<table>);
-
- // This is the "master switch" for auto-registration of URLs. If #f
- // then URLs will never be automatically registered based on their
- // file types. It defaults to #f to be safe.
- // @see auto-register-map
- slot auto-register-pages? :: <boolean> = #f,
- init-keyword: #"auto-register-pages?";
-
- // Maps from file extensions (e.g., "dsp") to functions that will
- // register a URL responder for a URL. If a URL matching the file
- // extension is requested, and the URL isn't registered yet, then the
- // function for the URL's file type extension will be called to
- // register the URL and then the URL will be processed normally. This
- // mechanism is used, for example, to automatically export .dsp URLs
- // as Dylan Server Pages so that it's not necessary to have a "define
- // page" form for every page in a DSP application.
- constant slot auto-register-map :: <string-table> = make(<string-table>);
+ slot mime-type-map :: <table> = shallow-copy(*default-mime-type-map*),
+ init-keyword: mime-type-map:;
// The vhost used if the request host doesn't match any other virtual host.
- // Note that the document root may be changed when the config file is
- // processed, so don't use it except during request processing.
- constant slot default-virtual-host :: <virtual-host>
- = begin
- let stdout-log = make(<stream-log-target>, stream: *standard-output*);
- make(<virtual-host>,
- name: "default",
- activity-log: stdout-log,
- debug-log: stdout-log,
- error-log: make(<stream-log-target>, stream: *standard-error*))
- end;
-
- // If this is true, then requests directed at hosts that don't match any
- // explicitly named virtual host (i.e., something created with <virtual-host>
- // in the config file) will use the default vhost. If this is #f when such a
- // request is received, a Bad Request (400) response will be returned.
- slot fall-back-to-default-virtual-host? :: <boolean> = #t;
+ slot default-virtual-host :: false-or(<virtual-host>),
+ init-keyword: default-virtual-host:;
// Maps host names to virtual hosts. Any host name not found in this
- // table maps to default-virtual-host (contingent on the value of
- // fall-back-to-default-virtual-host?).
- constant slot virtual-hosts :: <string-table> = make(<string-table>);
-
- // Since logging is done on a per-vhost basis, this hack is needed
- // to make logging work before vhosts are initialized.
- constant slot temp-log-target :: <log-target>
- = make(<stream-log-target>, stream: *standard-output*);
-
- // This may be set true by config file loading code, in which case
- // start-server will abort startup.
- slot abort-startup? :: <boolean> = #f;
+ // table maps to default-virtual-host.
+ slot virtual-hosts :: <string-table> = make(<string-table>),
+ init-keyword: virtual-hosts:;
end class <http-server-configuration>;
-define method get-virtual-host
- (config :: <http-server-configuration>, vhost-name :: <string>)
- => (vhost :: false-or(<virtual-host>))
- element(config.virtual-hosts, vhost-name, default: #f)
-end;
-
// We want the config file values to override the slot default values and the
-// "make" keyword arguments to override the config file values. To accomplish
-// this, the config file parsing builds up a set of init arguments which are
-// appended to the make args.
+// "make" keyword arguments to override the config file values, so we need to
+// know how to set the slot corresponding to each make keyword argument.
+//
+// Yes, this is hacky because you need to specify the slot init-keywords in
+// two places, but it'll do until I get time to write a "define reflective-class"
+// macro or something similar, which allows asking what the slot setters and
+// init-keywords are. It would be nice if it were possible to simply use a
+// "reflection" module and all this info were available that way.
//
define table *init-keyword-to-setter-map* = {
- #"debug?" => debugging-enabled?-setter,
- #"server-root" => server-root-setter,
- #"auto-register-pages?" => auto-register-pages?-setter
+ debug?: => debugging-enabled?-setter,
+ url-map: => url-map-setter,
+ server-root: => server-root-setter,
+ mime-type-map: => mime-type-map-setter,
+ default-virtual-host: => default-virtual-host-setter,
+ virtual-hosts: => virtual-hosts-setter
};
define method initialize
- (config :: <http-server-configuration>, #rest args, #key config-file)
+ (config :: <http-server-configuration>,
+ #rest args,
+ #key config-file,
+ log-level :: subclass(<log-level>) = <log-verbose>,
+ #all-keys)
next-method();
+ if (~slot-initialized?(config, default-virtual-host))
+ // Note that if the user wants to do something more complicated than specify
+ // a single log level for everything then they'll have to create the default
+ // virtual host themselves and pass it in.
+ config.default-virtual-host := make-default-virtual-host(make(log-level));
+ end;
// Config file overrides default slot values.
// Then init keywords override config file values.
if (config-file)
load-configuration-file(config, config-file);
// Now override config file settings with init-args again.
- // Is there a better way?
- local method argument-value (init-keyword)
- block (return)
- for (i from 0 by 2, while: i < args.size - 1)
- if (args[i] == init-keyword)
- return(args[i + 1]);
- end if;
- end for;
- end block;
- end method argument-value;
- for (setter keyed-by init-keyword in *init-keyword-to-setter-map*)
- setter(argument-value(init-keyword), config);
+ for (i from 0 by 2,
+ while: i < args.size - 1)
+ let keyword = args[i];
+ let setter = element(*init-keyword-to-setter-map*, keyword, default: #f);
+ if (setter)
+ setter(args[i + 1], config);
+ end;
end for;
end if;
end method initialize;
-//// CONFIG FILE PROCESSING
+define function make-default-virtual-host
+ (log-level :: <log-level>) => (vhost :: <virtual-host>)
+ let stdout-log = make(<stream-log-target>,
+ stream: *standard-output*,
+ log-level: log-level);
+ make(<virtual-host>,
+ name: "default",
+ activity-log: stdout-log,
+ debug-log: stdout-log,
+ error-log: make(<stream-log-target>,
+ stream: *standard-error*,
+ log-level: log-level));
+end;
+define method get-virtual-host
+ (config :: <http-server-configuration>, vhost-name :: <string>)
+ => (vhost :: false-or(<virtual-host>))
+ element(config.virtual-hosts, vhost-name, default: #f)
+end;
+//// CONFIG FILE PROCESSING
+
// Some variables for use during config file processing.
define thread variable *config* = #f;
define thread variable *vhost* = #f;
@@ -176,8 +167,8 @@
process-config-node(xml);
end;
else
- log-error("Server configuration file (%s) not found.", filename);
- config.abort-startup? := #t;
+ raise(<configuration-error>,
+ "Server configuration file (%s) not found.", filename);
end if;
end block;
end method load-configuration-file;
@@ -265,7 +256,7 @@
if (get-virtual-host(*config*, name))
warn("Ignoring duplicate virtual host %=", name);
else
- let vhost = make(<virtual-host>, name: name);
+ let vhost = make(<virtual-host>, name: name, server-configuration: *config*);
*config*.virtual-hosts[name] := vhost;
dynamic-bind(*vhost* = vhost)
for (child in xml$node-children(node))
@@ -291,7 +282,7 @@
*config*.virtual-hosts[name] := *vhost*;
end;
else
- warn("Invalid <ALIAS> element. The 'name' attribute must be specified.");
+ warn("Invalid <alias> element. The 'name' attribute must be specified.");
end;
end;
@@ -300,7 +291,9 @@
let attr = get-attr(node, #"enabled");
when (attr)
let enabled? = true-value?(attr);
- *config*.fall-back-to-default-virtual-host? := enabled?;
+ if (~enabled?)
+ *config*.default-virtual-host := #f;
+ end;
log-info("Fallback to the default virtual host is %s.",
if (enabled?) "enabled" else "disabled" end);
end;
@@ -339,19 +332,6 @@
end;
define method process-config-element
- (node :: xml$<element>, name == #"auto-register")
- let attr = get-attr(node, #"enabled");
- if (attr)
- let enabled? = true-value?(attr);
- auto-register-pages?(*vhost*) := enabled?;
- log-info("Virtual host %s: documents will be auto-registered", vhost-name(*vhost*));
- else
- warn("Invalid <auto-register> spec. "
- "The 'enabled' attribute must be specified as true or false.");
- end;
-end;
-
-define method process-config-element
(node :: xml$<element>, name == #"server-root")
let filename = get-attr(node, #"location");
if (filename)
@@ -359,9 +339,8 @@
server-root(*vhost*) := as(<file-locator>, loc);
log-info("Server root set to %s", loc);
else
- warn("Invalid <server-root> spec. "
- "The 'location' attribute must be specified.");
- *config*.abort-startup? := #t;
+ raise(<configuration-error>,
+ "Invalid <server-root> spec. The 'location' attribute must be specified.");
end;
end;
@@ -451,11 +430,12 @@
end;
end;
-define class <mime-type> (xml$<printing>)
-end class <mime-type>;
-
-define constant $mime-type = make(<mime-type>);
+define class <mime-type-state> (xml$<xform-state>)
+ constant slot mime-type-map :: <table> = make(<table>);
+end class <mime-type-state>;
+// <mime-type-map location = "config/mime-type-map.xml" clear = "true" />
+//
define method process-config-element
(node :: xml$<element>, name == #"mime-type-map")
let filename = get-attr(node, #"location");
@@ -463,32 +443,53 @@
warn("<mime-type-map> element missing 'location' attribute. Element ignored.");
else
let map-loc = merge-locators(as(<file-locator>, filename),
- subdirectory-locator(server-root(*vhost*),
+ subdirectory-locator(*vhost*.server-root,
$config-directory-name));
- let mime-text = file-contents(map-loc);
- if (mime-text)
- block ()
- let mime-xml :: xml$<document> = xml$parse-document(mime-text);
- log-info("Loading mime-type map from %s.", as(<string>, map-loc));
- log-info("%s",
- with-output-to-string (stream)
- xml$transform-document(mime-xml, state: $mime-type, stream: stream);
- end);
- exception (ex :: <error>)
- warn("Error parsing mime-type map %s: %s", filename, ex)
+ block ()
+ let new-map = load-mime-type-file(map-loc);
+ // Only clear the default map if the mime-type file loads.
+ let clear? = get-attr(node, #"clear");
+ if (clear? & true-value?(clear?))
+ remove-all-keys!(*vhost*.mime-type-map)
end;
- else
- warn("mime-type map %s not found", map-loc);
- end if;
- end if;
-end method;
+ let vhost-map = *vhost*.mime-type-map;
+ for (value keyed-by type in new-map)
+ vhost-map[type] := value;
+ end;
+ exception (ex :: <error>)
+ warn("Error parsing mime-type map %s: %s", filename, ex);
+ end;
+ end;
+end method process-config-element;
-define method xml$transform (node :: xml$<element>, name == #"mime-type",
- state :: <mime-type>, stream :: <stream>)
+define function load-mime-type-file
+ (file :: <locator>) => (mime-type-map :: <table>)
+ let mime-text = file-contents(file, error?: #t);
+ let mime-xml :: xml$<document> = xml$parse-document(mime-text);
+ log-info("Loading mime-type map from %s.", as(<string>, file));
+ let state = make(<mime-type-state>);
+ log-info("%s",
+ with-output-to-string (stream)
+ xml$transform-document(mime-xml, state: state, stream: stream);
+ end);
+ state.mime-type-map
+end function load-mime-type-file;
+
+/* Example document format...
+ <mime-type-map>
+ <mime-type id="application/x-gzip">
+ <extension>gz</extension>
+ <extension>tgz</extension>
+ </mime-type>
+ ...
+*/
+define method xml$transform
+ (node :: xml$<element>, name == #"mime-type",
+ state :: <mime-type-state>, stream :: <stream>)
let mime-type = get-attr(node, #"id");
for (child in xml$node-children(node))
if (xml$name(child) = #"extension")
- let tmap = mime-type-map(*vhost*);
+ let tmap = state.mime-type-map;
tmap[as(<symbol>, xml$text(child))] := mime-type;
else
warn("Skipping: %s %s %s: not an extension node!",
@@ -545,32 +546,18 @@
#key replace?, prefix?)
let (bpos, epos) = trim-whitespace(url, 0, size(url));
if (bpos = epos)
- error(make(<koala-api-error>,
- format-string: "You cannot register an empty URL: %=",
- format-arguments: list(substring(url, bpos, epos))));
+ raise(<koala-api-error>,
+ "You cannot register an empty URL: %=", substring(url, bpos, epos));
else
add-object(config.url-map, url, pair(target, prefix?), replace?: replace?);
+ log-info("Registered URL %s", url);
end;
- log-info("URL %s registered", url);
end method register-url;
// Find a responder function, if any.
define method find-responder
(config :: <http-server-configuration>, url :: <string>)
=> (responder :: false-or(<function>), #rest more)
- local method maybe-auto-register (url)
- when (config.auto-register-pages?)
- // could use safe-locator-from-url, but it's relatively expensive
- let len = size(url);
- let slash = char-position-from-end('/', url, 0, len);
- let dot = char-position-from-end('.', url, slash | 0, len);
- when (dot & dot < len - 1)
- let ext = substring(url, dot + 1, len);
- let reg-fun = element(config.auto-register-map, ext, default: #f);
- reg-fun & reg-fun(url)
- end
- end
- end;
let url = decode-url(url, 0, size(url));
let path = split(url, separator: "/");
let trie = *server*.configuration.url-map;
@@ -579,26 +566,9 @@
let fun = head(responder);
let prefix? = tail(responder);
values(fun, prefix?, unmatched-part-of-url)
- else
- maybe-auto-register(url)
end
end find-responder;
-// Register a function that will attempt to register a responder for a URL
-// if the URL matches the file extension. The function should normally call
-// register-url (or register-page for DSPs) and should return a responder.
-//
-define function register-auto-responder
- (config :: <http-server-configuration>, file-extension :: <string>, fn :: <function>,
- #key replace? :: <boolean>)
- if (~replace? & element(config.auto-register-map, file-extension, default: #f))
- cerror("Replace the old auto-responder with the new one and continue.",
- "An auto-responder is already defined for file extension %=.",
- file-extension);
- end;
- config.auto-register-map[file-extension] := fn;
-end;
-
// define responder test (config, "/test" /* , secure?: #t */ )
// (request, response)
// format(output-stream(response), "<html><body>test</body></html>");
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/dsp.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/dsp.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/dsp.dylan Tue Feb 20 06:48:24 2007
@@ -17,8 +17,6 @@
// See .../koala/sources/examples/koala-basics/ for example DSP usage.
-define variable *debugging-dsp* :: <boolean> = #f;
-
define class <dsp-error> (<simple-error>) end;
define class <dsp-parse-error> (<dsp-error>) end;
@@ -120,12 +118,6 @@
#key replace?)
=> (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(config, url, responder, replace?: replace?);
*page-to-url-map*[page] := url;
responder
@@ -144,7 +136,9 @@
// Register URLs for all files matching the given pathname spec as instances
// of the given page class.
define method register-pages-as
- (path :: <locator>, page-class :: subclass(<file-page-mixin>),
+ (config :: <http-server-configuration>,
+ path :: <locator>,
+ page-class :: subclass(<file-page-mixin>),
#key descend? = #t, file-type)
// url-dir always ends in '/'
local method doer (url-dir, directory, name, type)
@@ -152,9 +146,9 @@
#"file" =>
let file = merge-locators(as(<file-locator>, name),
as(<directory-locator>, directory));
- register-page(name, make(page-class,
- source: file,
- url: concatenate(url-dir, name)));
+ register-page(config, name, make(page-class,
+ source: file,
+ url: concatenate(url-dir, name)));
#"directory" =>
let dir = subdirectory-locator(as(<directory-locator>, directory), name);
when (descend?)
@@ -654,20 +648,37 @@
slot page-template :: <dsp-template>;
end;
-// define page my-dsp (<dylan-server-page>) (url: "/hello", source: make-locator(...), ...)
+// define page my-dsp (<dylan-server-page>)
+// (config: my-http-server-config, url: "/hello", source: make-locator(...), ...)
// slot foo :: <integer> = bar;
// ...
// end;
+// todo -- This whole macro is hideous, especially since the addition of the config:
+// option, but I wanted to get something working quickly. --cgay
define macro page-definer
{ define page ?:name (?superclasses:*) (?make-args:*)
?slot-specs:*
end }
=> { define class "<" ## ?name ## ">" (?superclasses) ?slot-specs end;
define variable "*" ## ?name ## "*" = make("<" ## ?name ## ">", ?make-args);
- has-url?(?make-args) & register-page-urls("*" ## ?name ## "*", ?make-args);
+ // yes yes, this is crufty
+ if (has-url?(?make-args))
+ register-page-urls(config-argument(?make-args), "*" ## ?name ## "*", ?make-args);
+ end;
}
end;
+define function config-argument
+ (#key config :: false-or(<http-server-configuration>), #all-keys)
+ => (config)
+ if (~config)
+ signal(make(<koala-api-error>,
+ format-string: "You must supply a config: keyword argument to \"define page\"."));
+ else
+ config
+ end
+end;
+
define function has-url? (#key url :: false-or(<string>), #all-keys)
=> (url-provided? :: <boolean>);
if (url)
@@ -679,7 +690,7 @@
(config :: <http-server-configuration>, page :: <page>, #key url :: <string>, alias,
#all-keys)
=> (responder :: <function>)
- let responder = register-page(url, page);
+ let responder = register-page(config, url, page);
when (alias)
for (alias in iff(instance?(alias, <string>),
list(alias),
@@ -1233,14 +1244,3 @@
//---*** TODO
end;
-
-//// Configuration
-
-define function auto-register-dylan-server-page
- (url :: <string>) => (responder :: <function>)
- // ---TODO: what if document-location returns #f here?
- register-page(url, make(<dylan-server-page>,
- source: document-location(url)))
-end;
-
-
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-main.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-main.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-main.dylan Tue Feb 20 06:48:24 2007
@@ -19,8 +19,7 @@
short: "h",
long: "help";
option debug-koala?,
- "", "Enabled debugging. Causes Koala to not handle most errors during "
- "request handling.",
+ "", "Enables debugging. Causes Koala to not handle most errors during request handling.",
long: "debug";
option listen-port,
"", "Port on which to listen for HTTP requests.",
@@ -56,7 +55,7 @@
port: listen-port(parser),
debug?: debug-koala?(parser));
let server = make(<http-server>, configuration: config);
- start-server(server, config, wait?: #t);
+ start-server(server, wait?: #t);
end;
end function koala-main;
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-unix.lid
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-unix.lid (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala-unix.lid Tue Feb 20 06:48:24 2007
@@ -1,27 +1,25 @@
library: koala
-files: library-unix
- log
- utils
- resources
- variables
- timer
- substring
- avalue
- string-utils
- errors
- header-values
- headers
- urls
- vhost
- response
- session
- static-files
- server
- dsp
- dsp-taglib
- xml-rpc-server
- config
- responders
- utils-main
- koala-main
- dsp-main
+files: library-unix
+ log
+ utils
+ resources
+ variables
+ substring
+ avalue
+ string-utils
+ errors
+ header-values
+ headers
+ urls
+ vhost
+ response
+ session
+ static-files
+ server
+ dsp
+ dsp-taglib
+ xml-rpc-server
+ config
+ responders
+ utils-main
+ koala-main
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala.lid
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala.lid (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/koala.lid Tue Feb 20 06:48:24 2007
@@ -1,30 +1,28 @@
library: koala
-files: library
- log
- utils
- resources
- variables
- timer
- substring
- avalue
- string-utils
- errors
- header-values
- headers
- urls
- vhost
- response
- session
- static-files
- server
- dsp
- dsp-taglib
- database
- records
- pages
- xml-rpc-server
- config
- responders
- utils-main
- koala-main
- dsp-main
+files: library
+ log
+ utils
+ resources
+ variables
+ substring
+ avalue
+ string-utils
+ errors
+ header-values
+ headers
+ urls
+ vhost
+ response
+ session
+ static-files
+ server
+ dsp
+ dsp-taglib
+ database
+ records
+ pages
+ xml-rpc-server
+ config
+ responders
+ utils-main
+ koala-main
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/library-unix.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/library-unix.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/library-unix.dylan Tue Feb 20 06:48:24 2007
@@ -13,7 +13,7 @@
use common-dylan,
import: { dylan, common-extensions, threads, simple-random };
use io,
- import: { format, standard-io, streams };
+ import: { format, standard-io, streams, print };
use network,
import: { sockets };
use system,
@@ -148,6 +148,8 @@
// Basic server stuff
create
+ <http-server>,
+ <http-server-configuration>,
start-server,
stop-server,
register-url,
@@ -234,10 +236,11 @@
// XML-RPC
create
<xml-rpc-configuration>,
- register-xml-rpc-server-url,
- register-xml-rpc-method,
- register-xml-rpc-test-methods,
- register-xml-rpc-introspection-methods;
+ // register-url (already exported from koala)
+ register-method,
+ register-test-methods,
+ register-introspection-methods,
+ internal-error-fault-code;
// Documents
create
@@ -261,12 +264,10 @@
unimplemented-error,
internal-server-error,
request-url,
- request-url-tail,
- register-auto-responder;
+ request-url-tail;
// Debugging
create
- print-object,
http-error-responder,
load-module-responder,
unload-module-responder;
@@ -326,6 +327,7 @@
// case-insensitive-string-hash
};
use format;
+ use print, import: { print-object };
use standard-io;
use streams;
use sockets,
@@ -377,6 +379,7 @@
<page>, // Subclass this using the "define page" macro
<static-page>,
register-page, // Register a page for a given URL
+ register-pages-as,
url-to-page,
respond-to-get, // Implement this for your page to handle GET requests
respond-to-post, // Implement this for your page to handle POST requests
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/library.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/library.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/library.dylan Tue Feb 20 06:48:24 2007
@@ -13,7 +13,7 @@
use common-dylan,
import: { dylan, common-extensions, threads, simple-random };
use io,
- import: { format, standard-io, streams };
+ import: { format, standard-io, streams, print };
use network,
import: { sockets };
use system,
@@ -148,6 +148,8 @@
// Basic server stuff
create
+ <http-server>,
+ <http-server-configuration>,
start-server,
stop-server,
register-url,
@@ -234,10 +236,11 @@
// XML-RPC
create
<xml-rpc-configuration>,
- register-xml-rpc-server-url,
- register-xml-rpc-method,
- register-xml-rpc-test-methods,
- register-xml-rpc-introspection-methods;
+ // register-url (already exported from koala)
+ register-method,
+ register-test-methods,
+ register-introspection-methods,
+ internal-error-fault-code;
// Documents
create
@@ -261,12 +264,10 @@
unimplemented-error,
internal-server-error,
request-url,
- request-url-tail,
- register-auto-responder;
+ request-url-tail;
// Debugging
create
- print-object,
http-error-responder,
load-module-responder,
unload-module-responder;
@@ -326,6 +327,7 @@
// case-insensitive-string-hash
};
use format;
+ use print, import: { print-object };
use standard-io;
use streams;
use sockets,
@@ -378,6 +380,7 @@
<page>, // Subclass this using the "define page" macro
<static-page>,
register-page, // Register a page for a given URL
+ register-pages-as,
url-to-page,
respond-to-get, // Implement this for your page to handle GET requests
respond-to-post, // Implement this for your page to handle POST requests
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/log.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/log.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/log.dylan Tue Feb 20 06:48:24 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: branches/koala-config-cleanup/libraries/network/koala/sources/koala/server.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/server.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/server.dylan Tue Feb 20 06:48:24 2007
@@ -197,47 +197,40 @@
// This is what client libraries call to start a server.
//
define function start-server
- (server :: <http-server>, config :: <http-server-configuration>,
+ (server :: <http-server>,
#key wait? :: <boolean> = #t,
// todo -- move these into config
max-listeners :: <integer> = 1,
request-class :: subclass(<basic-request>) = *default-request-class*)
=> (started? :: <boolean>)
+ let config :: <http-server-configuration> = server.configuration;
log-info("%s HTTP Server starting up", $server-name);
ensure-sockets-started();
server.max-listeners := max-listeners;
server.request-class := request-class;
log-info("Server root directory is %s", config.server-root);
- when (config.auto-register-pages?)
- log-info("Auto-register enabled");
- end;
run-init-functions();
let server-started? :: <boolean> = #f;
- if (config.abort-startup?)
- log-error("Server startup aborted due to the previous errors");
+ let ports = #();
+ for (vhost keyed-by name in config.virtual-hosts)
+ ports := add!(ports, vhost.vhost-port)
+ end;
+ if (config.default-virtual-host)
+ ports := add!(ports, config.default-virtual-host.vhost-port);
+ end;
+ if (empty?(ports))
+ log-error("No ports to listen on! No virtual hosts were specified "
+ "in the config file and there is no default virtual host.");
else
- let ports = #();
- for (vhost keyed-by name in config.virtual-hosts)
- ports := add!(ports, vhost.vhost-port)
- end;
- if (config.fall-back-to-default-virtual-host?)
- ports := add!(ports, config.default-virtual-host.vhost-port);
- end;
- if (empty?(ports))
- log-error("No ports to listen on! No virtual hosts were specified "
- "in the config file and fallback to the default vhost is "
- "disabled.");
- else
- // temporary code...
- let port = ports[0];
- while (start-http-listener(server, port))
- server-started? := #t;
- end;
- if (wait?)
- // Don't exit until all listener threads die.
- join-listeners(server);
- end;
- end if;
+ // todo -- fix this. start listeners on all ports.
+ let port = ports[0];
+ while (start-http-listener(server, port))
+ server-started? := #t;
+ end;
+ if (wait?)
+ // Don't exit until all listener threads die.
+ join-listeners(server);
+ end;
end if;
server-started?
end function start-server;
@@ -544,7 +537,7 @@
dynamic-bind (*request-query-values* = query-values,
*virtual-host* = virtual-host(config, request))
log-debug("Virtual host for request is '%s'",
- vhost-name(*virtual-host*));
+ *virtual-host* & *virtual-host*.vhost-name);
invoke-handler(request);
end;
force-output(request.request-socket);
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/static-files.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/static-files.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/static-files.dylan Tue Feb 20 06:48:24 2007
@@ -46,8 +46,7 @@
(request :: <request>, response :: <response>)
=> ()
let url :: <string> = request-url(request);
- let document :: false-or(<physical-locator>)
- = static-file-locator-from-url(url);
+ let document :: false-or(<physical-locator>) = static-file-locator-from-url(url);
log-debug("Requested document is %s", document);
if (~document)
log-info("%s not found", url);
@@ -337,10 +336,6 @@
end;
define open method display-image-link
- (stream :: <stream>, file-type :: <symbol>, locator :: <directory-locator>)
-end;
-
-define open method display-image-link
(stream :: <stream>, file-type :: <symbol>, locator :: <file-locator>)
//---TODO: Somehow display the icon that the Windows explorer displays
// next to each file. (On Windows only, of course.)
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/utils.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/utils.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/utils.dylan Tue Feb 20 06:48:24 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;
Added: branches/koala-config-cleanup/libraries/network/koala/sources/koala/variables.dylan
==============================================================================
--- (empty file)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/variables.dylan Tue Feb 20 06:48:24 2007
@@ -0,0 +1,188 @@
+Module: httpi
+Synopsis: Some globals that don't belong anywhere else in particular.
+Author: Carl Gay
+Copyright: Copyright (c) 2001 Carl L. Gay. All rights reserved.
+License: Functional Objects Library Public License Version 1.0
+Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
+
+// Entries in this table may be overridden by entries in the mime-type-map
+// file specified in the Koala config file, if any.
+//
+define table *default-mime-type-map* = {
+ #"ez" => "application/andrew-inset",
+ #"bz2" => "application/x-bzip2",
+ #"tar" => "application/tar",
+ #"rpm" => "application/x-rpm",
+ #"deb" => "application/x-deb",
+ #"gz" => "application/x-gzip",
+ #"tgz" => "application/x-gzip",
+ #"hqx" => "application/mac-binhex40",
+ #"cpt" => "application/mac-compactpro",
+ #"mathml" => "application/mathml+xml",
+ #"doc" => "application/msword",
+ #"bin" => "application/octet-stream",
+ #"dms" => "application/octet-stream",
+ #"lha" => "application/octet-stream",
+ #"lzh" => "application/octet-stream",
+ #"exe" => "application/octet-stream",
+ #"class" => "application/octet-stream",
+ #"so" => "application/octet-stream",
+ #"dll" => "application/octet-stream",
+ #"dmg" => "application/octet-stream",
+ #"oda" => "application/oda",
+ #"ogg" => "application/ogg",
+ #"pdf" => "application/pdf",
+ #"ai" => "application/postscript",
+ #"eps" => "application/postscript",
+ #"ps" => "application/postscript",
+ #"rdf" => "application/rdf+xml",
+ #"rtf" => "application/rtf",
+ #"smi" => "application/smil",
+ #"smil" => "application/smil",
+ #"gram" => "application/srgs",
+ #"grxml" => "application/srgs+xml",
+ #"mif" => "application/vnd.mif",
+ #"xls" => "application/vnd.ms-excel",
+ #"ppt" => "application/vnd.ms-powerpoint",
+ #"wbxml" => "application/vnd.wap.wbxml",
+ #"wmlc" => "application/vnd.wap.wmlc",
+ #"wmlsc" => "application/vnd.wap.wmlscriptc",
+ #"vxml" => "application/voicexml+xml",
+ #"bcpio" => "application/x-bcpio",
+ #"vcd" => "application/x-cdlink",
+ #"pgn" => "application/x-chess-pgn",
+ #"cpio" => "application/x-cpio",
+ #"csh" => "application/x-csh",
+ #"dcr" => "application/x-director",
+ #"dir" => "application/x-director",
+ #"dxr" => "application/x-director",
+ #"dvi" => "application/x-dvi",
+ #"spl" => "application/x-futuresplash",
+ #"gtar" => "application/x-gtar",
+ #"hdf" => "application/x-hdf",
+ #"js" => "application/x-javascript",
+ #"jnlp" => "application/x-java-jnlp-file",
+ #"skp" => "application/x-koan",
+ #"skd" => "application/x-koan",
+ #"skt" => "application/x-koan",
+ #"skm" => "application/x-koan",
+ #"latex" => "application/x-latex",
+ #"nc" => "application/x-netcdf",
+ #"cdf" => "application/x-netcdf",
+ #"sh" => "application/x-sh",
+ #"shar" => "application/x-shar",
+ #"swf" => "application/x-shockwave-flash",
+ #"sit" => "application/x-stuffit",
+ #"sv4cpio" => "application/x-sv4cpio",
+ #"sv4crc" => "application/x-sv4crc",
+ #"tar" => "application/x-tar",
+ #"tcl" => "application/x-tcl",
+ #"tex" => "application/x-tex",
+ #"texinfo" => "application/x-texinfo",
+ #"texi" => "application/x-texinfo",
+ #"t" => "application/x-troff",
+ #"tr" => "application/x-troff",
+ #"roff" => "application/x-troff",
+ #"man" => "application/x-troff-man",
+ #"me" => "application/x-troff-me",
+ #"ms" => "application/x-troff-ms",
+ #"ustar" => "application/x-ustar",
+ #"src" => "application/x-wais-source",
+ #"xhtml" => "application/xhtml+xml",
+ #"xht" => "application/xhtml+xml",
+ #"xslt" => "application/xslt+xml",
+ #"xml" => "application/xml",
+ #"xsl" => "application/xml",
+ #"dtd" => "application/xml-dtd",
+ #"zip" => "application/zip",
+ #"au" => "audio/basic",
+ #"snd" => "audio/basic",
+ #"mid" => "audio/midi",
+ #"midi" => "audio/midi",
+ #"kar" => "audio/midi",
+ #"mpga" => "audio/mpeg",
+ #"mp2" => "audio/mpeg",
+ #"mp3" => "audio/mpeg",
+ #"aif" => "audio/x-aiff",
+ #"aiff" => "audio/x-aiff",
+ #"aifc" => "audio/x-aiff",
+ #"m3u" => "audio/x-mpegurl",
+ #"ram" => "audio/x-pn-realaudio",
+ #"rm" => "audio/x-pn-realaudio",
+ #"rpm" => "audio/x-pn-realaudio-plugin",
+ #"ra" => "audio/x-realaudio",
+ #"wav" => "audio/x-wav",
+ #"pdb" => "chemical/x-pdb",
+ #"xyz" => "chemical/x-xyz",
+ #"bmp" => "image/bmp",
+ #"cgm" => "image/cgm",
+ #"gif" => "image/gif",
+ #"ief" => "image/ief",
+ #"jpeg" => "image/jpeg",
+ #"jpg" => "image/jpeg",
+ #"jpe" => "image/jpeg",
+ #"jp2" => "image/jp2",
+ #"pict" => "image/pict",
+ #"pic" => "image/pict",
+ #"pct" => "image/pict",
+ #"png" => "image/png",
+ #"tga" => "image/targa",
+ #"jng" => "image/x-jng",
+ #"svg" => "image/svg+xml",
+ #"tiff" => "image/tiff",
+ #"tif" => "image/tiff",
+ #"djvu" => "image/vnd.djvu",
+ #"djv" => "image/vnd.djvu",
+ #"wbmp" => "image/vnd.wap.wbmp",
+ #"ras" => "image/x-cmu-raster",
+ #"pntg" => "image/x-macpaint",
+ #"pnt" => "image/x-macpaint",
+ #"mac" => "image/x-macpaint",
+ #"ico" => "image/x-icon",
+ #"pnm" => "image/x-portable-anymap",
+ #"pbm" => "image/x-portable-bitmap",
+ #"pgm" => "image/x-portable-graymap",
+ #"ppm" => "image/x-portable-pixmap",
+ #"qtif" => "image/x-quicktime",
+ #"qti" => "image/x-quicktime",
+ #"rgb" => "image/x-rgb",
+ #"xbm" => "image/x-xbitmap",
+ #"xpm" => "image/x-xpixmap",
+ #"xwd" => "image/x-xwindowdump",
+ #"igs" => "model/iges",
+ #"iges" => "model/iges",
+ #"msh" => "model/mesh",
+ #"mesh" => "model/mesh",
+ #"silo" => "model/mesh",
+ #"wrl" => "model/vrml",
+ #"vrml" => "model/vrml",
+ #"ics" => "text/calendar",
+ #"ifb" => "text/calendar",
+ #"css" => "text/css",
+ #"html" => "text/html; charset=utf-8",
+ #"htm" => "text/html; charset=utf-8",
+ #"asc" => "text/plain",
+ #"txt" => "text/plain",
+ #"rtx" => "text/richtext",
+ #"rtf" => "text/rtf",
+ #"sgml" => "text/sgml",
+ #"sgm" => "text/sgml",
+ #"tsv" => "text/tab-separated-values",
+ #"wml" => "text/vnd.wap.wml",
+ #"wmls" => "text/vnd.wap.wmlscript",
+ #"etx" => "text/x-setext",
+ #"mp4" => "video/mp4",
+ #"mpeg" => "video/mpeg",
+ #"mpg" => "video/mpeg",
+ #"mpe" => "video/mpeg",
+ #"mng" => "video/x-mng",
+ #"qt" => "video/quicktime",
+ #"mov" => "video/quicktime",
+ #"mp4" => "video/mp4",
+ #"mxu" => "video/vnd.mpegurl",
+ #"dv" => "video/x-dv",
+ #"dif" => "video/x-dv",
+ #"avi" => "video/x-msvideo",
+ #"movie" => "video/x-sgi-movie",
+ #"ice" => "x-conference/x-cooltalk"
+ };
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/vhost.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/vhost.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/vhost.dylan Tue Feb 20 06:48:24 2007
@@ -83,26 +83,26 @@
// Most slots are set when the config file is processed. A valiant attempt
// should be made to use good defaults, in case the config file doesn't specify
-// a value.
+// a value. Init args passed to make(<http-server-configuration>) are passed
+// through to this class when making the default-virtual-host, for user convenience.
define class <virtual-host> (<object>)
constant slot vhost-name :: <string>,
required-init-keyword: name:;
- constant slot http-server-configuration :: <http-server-configuration>,
- required-init-keyword: configuration:;
-
- // The root of the web document hierarchy. By default, this will be
- // {config}.server-root/www/<vhost-name>/. If name is the empty string then
- // just {config}.server-root/www/.
- slot document-root :: <directory-locator>;
+ // The root of the web document hierarchy. The config file loader may set this
+ // to {server-root}/www/<vhost-name>/. The default value is set in initialize.
+ slot document-root :: <directory-locator>,
+ init-keyword: document-root:;
// TODO: no need for this here. Even though ports can be specified inside
// the virtual host definition in the config file, we just need a
// list of virtual hosts per port. Start up one listener per port
// and serve requests only for the vhosts that are registered on that
// port.
- slot vhost-port :: <integer> = 80;
+ slot vhost-port :: <integer>,
+ init-value: 80,
+ init-keyword: port:;
// List of <directory-spec> objects that determine how documents in
// different directories are treated. These are searched in order,
@@ -112,59 +112,51 @@
// precedence. I think this will match the natural usage, where people
// will put more general specs first in the file and more specific ones
// later, but we might want to revisit this decision.
- slot directory-specs :: <list>
- = list();
+ slot directory-specs :: <list>,
+ init-value: list(),
+ init-keyword: directory-specs:;
// Each vhost gets an implicitly defined spec for the vhost root directory.
// It must, of course, match all documents under the vhost document root.
// It should always be the last element in directory-specs(vhost).
// See initialize(<virtual-host>).
- constant slot root-directory-spec :: <directory-spec>
- = make(<directory-spec>,
- parent: #f,
- pattern: "/*");
+ constant slot root-directory-spec :: <directory-spec>,
+ init-value: make(<directory-spec>,
+ parent: #f,
+ pattern: "/*"),
+ init-keyword: root-directory-spec:;
// Whether or not to include a Server: header in all responses. Most people
// won't care either way, but some might want to hide the server type so as
// to prevent cracking or to hide the fact that they're not using one of the
// Chosen Few accepted technologies. Wimps. ;-)
- slot generate-server-header? :: <boolean> = #t;
+ slot generate-server-header? :: <boolean>,
+ init-value: #t,
+ init-keyword: generate-server-header?:;
// TODO: this should be per-dirspec. no reason some subtree on the same
- // vhost shouldn't have a different set of default docs.
+ // vhost shouldn't have a different set of default docs. CFT.
// The set of file names that are searched for when a directory URL is
// requested. They are searched in order, and the first match is chosen.
- slot default-documents :: <list>
- = list(as(<file-locator>, "index.html"),
- as(<file-locator>, "index.htm"));
+ slot default-documents :: <list>,
+ init-value: list(as(<file-locator>, "index.html"),
+ as(<file-locator>, "index.htm")),
+ init-keyword: default-documents:;
// The value sent in the "Content-Type" header for static file responses if
- // no other value is set. See *mime-type-map*.
- slot default-static-content-type :: <string> = "application/octet-stream";
+ // no other value is set. See *default-mime-type-map*.
+ slot default-static-content-type :: <string>,
+ init-value: "application/octet-stream",
+ init-keyword: default-static-content-type:;
// The value sent in the "Content-Type" header for dynamic responses if no
// other value is set.
- slot default-dynamic-content-type :: <string> = "text/html; charset=utf-8";
-
- // This is the "master switch" for auto-registration of URLs. If #f then
- // URLs will never be automatically registered based on their file types. It
- // defaults to #f to be safe. See auto-register-map
- slot auto-register-pages? :: <boolean> = #f;
-
- // Maps from file extensions (e.g., "dsp") to functions that will register a
- // URL responder for a URL. If a URL matching the file extension is
- // requested, and the URL isn't registered yet, then the function for the
- // URL's file type extension will be called to register the URL and then the
- // URL will be processed normally. This mechanism is used, for example, to
- // automatically export .dsp URLs as Dylan Server Pages so that it's not
- // necessary to have a "define page" form for every page in a DSP
- // application.
- // TODO: x-platform: this should be a case-sensitive string table for
- // unix variants and insensitive for Windows.
- constant slot auto-register-map :: <table> = make(<string-table>);
+ slot default-dynamic-content-type :: <string>,
+ init-value: "text/html; charset=utf-8",
+ init-keyword: default-dynamic-content-type:;
// Log targets. If these are #f then the default virtual host's
- // log target is used. They are never #f in $default-virtual-host.
+ // log target is used. They are never #f for the default-virtual-host.
slot activity-log-target :: false-or(<log-target>) = #f,
init-keyword: #"activity-log";
slot error-log-target :: false-or(<log-target>) = #f,
@@ -176,20 +168,42 @@
define method initialize
- (vhost :: <virtual-host>, #key)
+ (vhost :: <virtual-host>,
+ #key server-configuration :: false-or(<http-server-configuration>))
next-method();
- // This may be overridden by a <document-root> spec in the config file.
- let name = vhost.vhost-name;
- let config = vhost.http-server-configuration;
- vhost.document-root := subdirectory-locator(config.server-root, name);
+ if (~slot-initialized?(vhost, document-root))
+ // Set the document root here because we need access to the vhost name.
+ // This value is only used if no config file is loaded and no initial value
+ // is passed to make since the config file loader always sets the document
+ // root based on the config's server root.
+ // todo -- Should have different default for Windows and unix and I'm not
+ // even sure this value is reasonable for unix.
+ vhost.document-root := make(<directory-locator>,
+ path: vector("var", "www", vhost.vhost-name));
+ end if;
// Add a spec that matches all urls.
add-directory-spec(vhost, vhost.root-directory-spec);
- vhost.activity-log-target
- := vhost.activity-log-target | vhost.http-server-configuration.default-virtual-host.activity-log-target;
- vhost.error-log-target
- := vhost.error-log-target | vhost.http-server-configuration.default-virtual-host.error-log-target;
- vhost.debug-log-target
- := vhost.debug-log-target | vhost.http-server-configuration.default-virtual-host.debug-log-target;
+ // If server-configuration was supplied this isn't the default virtual host.
+ if (server-configuration)
+ // This may be overridden by a <document-root> spec in the config file.
+ vhost.document-root
+ := subdirectory-locator(server-configuration.server-root, vhost.vhost-name);
+ vhost.activity-log-target
+ := vhost.activity-log-target
+ | server-configuration.default-virtual-host.activity-log-target;
+ vhost.error-log-target
+ := vhost.error-log-target
+ | server-configuration.default-virtual-host.error-log-target;
+ vhost.debug-log-target
+ := vhost.debug-log-target
+ | server-configuration.default-virtual-host.debug-log-target;
+ end if;
+end;
+
+define method print-object
+ (vhost :: <virtual-host>, stream :: <stream>)
+ => ()
+ format(stream, "{<virtual-host>: name: %=}", vhost.vhost-name);
end;
define method add-directory-spec
@@ -203,8 +217,10 @@
//// VIRTUAL HOST ACCESS
-define thread variable *virtual-host* :: <virtual-host>
- = make(<virtual-host>, configuration: make(<http-server-configuration>));
+// The initial value here is never used; it's just there so this doesn't
+// have to be typed as false-or(<virtual-host>).
+//
+define thread variable *virtual-host* :: false-or(<virtual-host>) = #f;
define method virtual-host
(config :: <http-server-configuration>, name :: <string>)
@@ -230,9 +246,7 @@
log-debug("error parsing port in host spec");
die();
end;
- let vhost = (virtual-host(config, host)
- | (config.fall-back-to-default-virtual-host?
- & config.default-virtual-host));
+ let vhost = (virtual-host(config, host) | config.default-virtual-host);
// TODO: If this is an HTTPS request and no port is specified, make sure
// vhost-port(vhost) == 443
if (vhost & ((~port & vhost-port(vhost) == 80)
@@ -242,9 +256,7 @@
die()
end
else
- iff (config.fall-back-to-default-virtual-host?,
- config.default-virtual-host,
- die())
+ config.default-virtual-host | die()
end
end;
Modified: branches/koala-config-cleanup/libraries/network/koala/sources/koala/xml-rpc-server.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/koala/sources/koala/xml-rpc-server.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/koala/sources/koala/xml-rpc-server.dylan Tue Feb 20 06:48:24 2007
@@ -15,7 +15,7 @@
// that's received. If users want to return a fault code they
// should use the xml-rpc-fault method.
// Exported
- slot xml-rpc-internal-error-fault-code :: <integer> = 0,
+ slot internal-error-fault-code :: <integer> = 0,
init-keyword: internal-error-fault-code:;
// Maps method names to response functions. If namespaces are used then
@@ -50,7 +50,7 @@
let (method-name, args) = parse-xml-rpc-call(doc);
log-debug("XML-RPC: method-name = %=, args = %=", method-name, args);
let fun = lookup-xml-rpc-method(xml-rpc-config, method-name)
- | xml-rpc-fault(xml-rpc-config.xml-rpc-internal-error-fault-code,
+ | xml-rpc-fault(xml-rpc-config.internal-error-fault-code,
"Method not found: %=",
method-name);
send-xml-rpc-result(xml-rpc-config, response, apply(fun, args));
@@ -58,7 +58,7 @@
send-xml-rpc-fault-response(xml-rpc-config, response, err);
exception (err :: <error>)
let fault = make(<xml-rpc-fault>,
- fault-code: xml-rpc-config.xml-rpc-internal-error-fault-code,
+ fault-code: xml-rpc-config.internal-error-fault-code,
format-string: condition-format-string(err),
format-arguments: condition-format-arguments(err));
send-xml-rpc-fault-response(xml-rpc-config, response, fault);
@@ -75,7 +75,7 @@
// todo -- xml-rpc-method-definer
//
// Exported
-define method register-xml-rpc-method
+define method register-method
(xml-rpc-config :: <xml-rpc-configuration>, name :: <string>, f :: <function>,
#key replace? :: <boolean>)
if (~replace? & lookup-xml-rpc-method(xml-rpc-config, name))
@@ -136,24 +136,25 @@
end;
// Exported
-define method register-xml-rpc-server-url
+define method register-url
(config :: <http-server-configuration>,
url :: <string>,
xml-rpc-config :: <xml-rpc-configuration>,
#key replace?)
register-url(config, url, curry(respond-to-xml-rpc-request, xml-rpc-config),
replace?: replace?, prefix?: #f);
+ log-info("URL %s is an XML-RPC server.", url);
end;
// Exported
-define method register-xml-rpc-test-methods
+define method register-test-methods
(xml-rpc-config :: <xml-rpc-configuration>)
- register-xml-rpc-method(xml-rpc-config, "ping", method () #t end, replace?: #t);
- register-xml-rpc-method(xml-rpc-config, "echo", method (#rest args) args end, replace?: #t);
+ register-method(xml-rpc-config, "ping", method () #t end, replace?: #t);
+ register-method(xml-rpc-config, "echo", method (#rest args) args end, replace?: #t);
end;
// Exported
-define method register-xml-rpc-introspection-methods
+define method register-introspection-methods
(xml-rpc-config :: <xml-rpc-configuration>)
// todo --
signal(make(<xml-rpc-error>,
Modified: branches/koala-config-cleanup/libraries/network/wiki/classes.dylan
==============================================================================
--- branches/koala-config-cleanup/libraries/network/wiki/classes.dylan (original)
+++ branches/koala-config-cleanup/libraries/network/wiki/classes.dylan Tue Feb 20 06:48:24 2007
@@ -99,7 +99,7 @@
end;
begin
- add-option-parser-by-type(*argument-list-parser*,
+ add-option-parser-by-type(*command-line-parser*,
<simple-option-parser>,
description: "Whether to enable the XMPP bot",
long-options: #("xmpp"));
More information about the chatter
mailing list