[chatter] r11796 - in trunk/libraries/network: http-client/http-client-test-suite koala/config koala/sources/dylan-basics koala/sources/koala
cgay at mccarthy.opendylan.org
cgay at mccarthy.opendylan.org
Sat May 3 22:07:41 CEST 2008
Author: cgay
Date: Sat May 3 22:07:38 2008
New Revision: 11796
Modified:
trunk/libraries/network/http-client/http-client-test-suite/http-client-test-suite.dylan
trunk/libraries/network/koala/config/koala-config.xml
trunk/libraries/network/koala/sources/dylan-basics/dylan-basics.dylan
trunk/libraries/network/koala/sources/koala/config.dylan
trunk/libraries/network/koala/sources/koala/dsp.dylan
trunk/libraries/network/koala/sources/koala/koala-main.dylan
trunk/libraries/network/koala/sources/koala/responders.dylan
trunk/libraries/network/koala/sources/koala/server.dylan
trunk/libraries/network/koala/sources/koala/static-files.dylan
trunk/libraries/network/koala/sources/koala/variables.dylan
trunk/libraries/network/koala/sources/koala/vhost.dylan
Log:
job: koala
* Removed auto-register stuff. Not really useful. Simplify.
* Moved *debugging-server* to <server>.debugging-enabled?.
* Fixed bug in initialize(<server>) calling next-method. Woops.
* Got rid of *server-running?*. *server* is #f if not running.
Modified: trunk/libraries/network/http-client/http-client-test-suite/http-client-test-suite.dylan
==============================================================================
--- trunk/libraries/network/http-client/http-client-test-suite/http-client-test-suite.dylan (original)
+++ trunk/libraries/network/http-client/http-client-test-suite/http-client-test-suite.dylan Sat May 3 22:07:38 2008
@@ -1,16 +1,33 @@
module: http-client-test-suite
+define variable *http-server-port* :: <integer> = 8080;
+
+define variable *url-prefix* :: <byte-string> = "/http-test";
+
+// Make a full URL for making HTTP requests.
+define function full-url
+ (url :: <string>, #key secure = #f) => (url :: <string>)
+ format-to-string("http://localhost:%d%s",
+ *http-server-port*, short-url(url))
+end;
+
+// Make URLs for registering with the server (i.e., just a path)
+define function short-url
+ (url :: <string>) => (url :: <string>)
+ format-to-string("%s%s", *url-prefix*, url)
+end;
+
define suite http-client-test-suite ()
test test-simple-http-get;
end suite http-client-test-suite;
-define responder hello ("/http-test/hello")
+define responder hello (short-url("/hello"))
output("hello")
end;
define test test-simple-http-get ()
check-equal("GET of /hello returns \"hello\"?",
- simple-http-get("http://localhost:8080/http-test/hello"),
+ simple-http-get(full-url("/hello")),
"hello");
end test test-simple-http-get;
@@ -23,7 +40,7 @@
short-options: #("d"));
add-option-parser-by-type(parser,
<parameter-option-parser>,
- description: "Koala port number to use",
+ description: "Server port number",
long-options: #("port"),
short-options: #("p"));
add-option-parser-by-type(parser,
Modified: trunk/libraries/network/koala/config/koala-config.xml
==============================================================================
Binary files. No diff available.
Modified: trunk/libraries/network/koala/sources/dylan-basics/dylan-basics.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/dylan-basics/dylan-basics.dylan (original)
+++ trunk/libraries/network/koala/sources/dylan-basics/dylan-basics.dylan Sat May 3 22:07:38 2008
@@ -228,20 +228,19 @@
// passing them along with apply or next-method.
//
define method remove-keys
- (arglist :: <sequence>, #rest keys) => (x :: <list>)
+ (arglist :: <sequence>, #rest keys-to-remove) => (x :: <list>)
let result :: <list> = #();
let last-pair = #f;
- for (arg in arglist, i from 0)
- if (even?(i))
- if (~ member?(arg, keys))
- if (last-pair)
- tail(last-pair) := list(arg);
- else
- result := list(arg);
- last-pair := result;
- end;
- tail(last-pair) := list(arglist[i + 1]);
- last-pair := tail(last-pair);
+ for (i from 0 below arglist.size by 2)
+ let arg = arglist[i];
+ if (~member?(arg, keys-to-remove))
+ if (last-pair)
+ let key-val = list(arg, arglist[i + 1]);
+ tail(last-pair) := key-val;
+ last-pair := tail(key-val);
+ else
+ result := list(arg, arglist[i + 1]);
+ last-pair := tail(result);
end;
end;
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 Sat May 3 22:07:38 2008
@@ -49,7 +49,7 @@
defaults));
block (return)
let handler <error> = method (c :: <error>, next-handler :: <function>)
- if (*debugging-server*)
+ if (debugging-enabled?(*server*))
next-handler(); // decline to handle the error
else
log-error("Error loading config file: %=", c);
@@ -204,10 +204,11 @@
(node :: xml$<element>, name == #"debug-server")
bind (attr = get-attr(node, #"value"))
when (attr)
- *debugging-server* := true-value?(attr);
+ debugging-enabled?(*server*) := true-value?(attr);
end;
- when (*debugging-server*)
- warn("Server debugging is enabled. Server may crash if not run inside an IDE!");
+ when (debugging-enabled?(*server*))
+ warn("Server debugging is enabled. "
+ "Server may crash if not run inside an IDE!");
end;
end;
end;
@@ -224,16 +225,6 @@
end;
define method process-config-element
- (node :: xml$<element>, name == #"auto-register")
- bind (attr = get-attr(node, #"enabled"))
- iff(attr,
- auto-register-pages?(active-vhost()) := true-value?(attr),
- 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")
// Note use of %vhost directly rather than active-vhost() here.
// Don't want to blow out while setting *server-root* just because
@@ -400,32 +391,33 @@
define method process-config-element
(node :: xml$<element>, name == #"mime-type-map")
- log-info("configuring mime-type-map");
let filename = get-attr(node, #"location");
- log-info("mime-type-map: %s", filename);
-
-
- let mime-type-loc = as(<string>,
- merge-locators(merge-locators(as(<file-locator>, filename),
- as(<directory-locator>, $koala-config-dir)),
- *server-root*));
-
- log-info("mime-type-map-loc: %s", mime-type-loc);
- let mime-text = file-contents(mime-type-loc);
- if (mime-text)
- let mime-xml :: xml$<document> = xml$parse-document(mime-text);
- log-info("Loading mime-type map from %s.", mime-type-loc);
- log-info("%s",
- with-output-to-string (stream)
- xml$transform-document(mime-xml, state: $mime-type, stream: stream);
- end);
- else
- warn("mime-type map %s not found", mime-type-loc);
- end if;
-end method;
+ let mime-type-loc
+ = as(<string>,
+ merge-locators(merge-locators(as(<file-locator>, filename),
+ as(<directory-locator>, $koala-config-dir)),
+ *server-root*));
+
+ log-info("Loading mime-type map from %s", mime-type-loc);
+ let mime-text = file-contents(mime-type-loc);
+ if (mime-text)
+ let mime-xml :: xml$<document> = xml$parse-document(mime-text);
+ log-info("Transforming mime-type map...");
+ log-info("%s",
+ with-output-to-string (stream)
+ // Transforming the document side-effects *mime-type-map*.
+ xml$transform-document(mime-xml, state: $mime-type, stream: stream);
+ end);
+ else
+ warn("mime-type map %s not found", mime-type-loc);
+ end if;
+end method process-config-element;
-define method xml$transform (node :: xml$<element>, name == #"mime-type",
- state :: <mime-type>, stream :: <stream>)
+define method xml$transform
+ (node :: xml$<element>,
+ name == #"mime-type",
+ state :: <mime-type>,
+ stream :: <stream>)
let mime-type = get-attr(node, #"id");
for (child in xml$node-children(node))
if (xml$name(child) = #"extension")
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 Sat May 3 22:07:38 2008
@@ -1218,13 +1218,3 @@
end iterate
end extract-tag-args;
-
-//// 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: 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 Sat May 3 22:07:38 2008
@@ -39,11 +39,7 @@
// This is defined here rather than in koala-app because wiki needs it too.
//
define function koala-main
- (#key server :: false-or(<http-server>),
- debug :: <boolean>,
- port :: false-or(<integer>),
- config-file :: false-or(<string>))
- => ()
+ () => ()
let parser = *argument-list-parser*;
parse-arguments(parser, application-arguments());
if (option-value-by-long-name(parser, "help")
@@ -55,11 +51,12 @@
usage: "koala [options]",
description: desc);
else
- start-server(server | make(<http-server>),
+ let server = make(<http-server>,
+ debug: option-value-by-long-name(parser, "debug"));
+ start-server(server,
config-file: option-value-by-long-name(parser, "config"),
port: string-to-integer(option-value-by-long-name(parser, "port")
- | "80"),
- debug: option-value-by-long-name(parser, "debug"));
+ | "80"));
end;
end function koala-main;
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 Sat May 3 22:07:38 2008
@@ -43,7 +43,7 @@
log-info("responder on %s registered", url);
end if;
end;
- if (*server-running?*)
+ if (*server*)
register-responder();
else
register-init-function(register-responder);
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 Sat May 3 22:07:38 2008
@@ -27,6 +27,14 @@
end;
define class <server> (<sealed-constructor>)
+ // Whether the server should run in debug mode or not. If this is true then
+ // errors encountered while servicing HTTP requests will not be handled by the
+ // server itself. Normally the server will handle them and return an "internal
+ // server error" response. A good way to debug Dylan Server Pages. Can be
+ // enabled via the --debug command-line option.
+ slot debugging-enabled? :: <boolean> = #f,
+ init-keyword: #"debug";
+
constant slot server-lock :: <lock>,
required-init-keyword: lock:;
// Support for shutting down listeners.
@@ -39,7 +47,6 @@
constant slot listener-shutdown-timeout :: <real> = 15;
constant slot client-shutdown-timeout :: <real> = 15;
- // Parameters
slot max-listeners :: <integer> = 1;
slot request-class :: subclass(<basic-request>) = <basic-request>;
@@ -49,12 +56,7 @@
// 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.
- // TODO: this should be per vhost
- // then 'define page' needs to specify vhost until dynamic
- // library loading works. (ick.) once dynamic library loading
- // works we use <module foo> inside <virtual-host> in the config
- // and bind *virtual-host* while the library is loading?
-
+ // todo -- this should be per vhost
constant slot url-map :: <string-trie> = make(<string-trie>, object: #f);
// pathname translations
@@ -106,7 +108,7 @@
(server :: <http-server>,
#rest keys,
#key document-root: doc-root)
- apply(next-method, remove-keys(keys, #"document-root"));
+ apply(next-method, server, remove-keys(keys, #"document-root"));
let vhost :: <virtual-host> = default-virtual-host(server);
if (doc-root)
document-root(vhost) := as(<directory-locator>, doc-root);
@@ -145,18 +147,25 @@
define class <listener> (<sealed-constructor>)
constant slot listener-server :: <server>,
required-init-keyword: server:;
+
constant slot listener-port :: <integer>,
required-init-keyword: port:;
+
constant slot listener-host :: false-or(<string>),
required-init-keyword: host:;
+
constant slot listener-thread :: <thread>,
required-init-keyword: thread:;
+
slot listener-socket :: <server-socket>,
required-init-keyword: socket:;
+
// Maybe should hold some mark of who requested it..
slot listener-exit-requested? :: <boolean> = #f;
+
// The time when server entered 'accept', so we can
// abort it if it's hung...
+ // This gets set but is otherwise unused so far.
slot listener-listen-start :: false-or(<date>) = #f;
// Statistics
@@ -168,12 +177,16 @@
define class <client> (<sealed-constructor>)
constant slot client-server :: <server>,
required-init-keyword: server:;
+
constant slot client-listener :: <listener>,
required-init-keyword: listener:;
+
constant slot client-socket :: <tcp-socket>,
required-init-keyword: socket:;
+
constant slot client-thread :: <thread>,
required-init-keyword: thread:;
+
slot client-request :: <basic-request>;
end;
@@ -235,16 +248,12 @@
config-file :: false-or(<string>))
server.max-listeners := listeners;
server.request-class := request-class;
- *server* := server;
if (config-file)
configure-server(config-file);
end;
log-info("%s HTTP Server starting up", $server-name);
ensure-sockets-started(); // TODO: Can this be moved into start-server?
log-info("Server root directory is %s", *server-root*);
- when (*auto-register-pages?*)
- log-info("Auto-register enabled");
- end;
run-init-functions();
end init-server;
@@ -255,11 +264,11 @@
(server :: <http-server>,
#key config-file :: false-or(<string>),
port :: false-or(<integer>),
- background :: <boolean> = #f,
- debug :: <boolean> = #f)
+ background :: <boolean> = #f)
=> (started? :: <boolean>)
- *debugging-server* := debug;
- init-server(server, config-file: config-file);
+ dynamic-bind (*server* = server)
+ init-server(server, config-file: config-file);
+ end;
if (*abort-startup?*)
log-error("Server startup aborted due to the previous errors");
#f
@@ -281,13 +290,11 @@
(server :: <http-server>, listen-ip :: <string>, listen-port :: <integer>)
dynamic-bind (*server* = server)
while (start-http-listener(*server*, listen-port, listen-ip))
- *server-running?* := #t;
end;
// Apparently when the main thread dies in an Open Dylan application
// the application exits without waiting for spawned threads to die,
// so join-listeners keeps the main thread alive until all listeners die.
join-listeners(*server*);
- *server-running?* := #f;
end;
end function http-server-top-level;
@@ -597,7 +604,7 @@
block (exit-inner)
let handler <error>
= method (c :: <error>, next-handler :: <function>)
- if (*debugging-server*)
+ if (debugging-enabled?(*server*))
next-handler(); // decline to handle the error
else
send-error-response(request, c);
@@ -606,7 +613,7 @@
end;
let handler <stream-error>
= method (c :: <error>, next-handler :: <function>)
- if (*debugging-server*)
+ if (debugging-enabled?(*server*))
next-handler(); // decline to handle the error
else
log-error("A stream error occurred. %=", c);
Modified: trunk/libraries/network/koala/sources/koala/static-files.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/static-files.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/static-files.dylan Sat May 3 22:07:38 2008
@@ -348,15 +348,4 @@
format(stream, property);
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.)
-end;
-
-
Modified: trunk/libraries/network/koala/sources/koala/variables.dylan
==============================================================================
--- trunk/libraries/network/koala/sources/koala/variables.dylan (original)
+++ trunk/libraries/network/koala/sources/koala/variables.dylan Sat May 3 22:07:38 2008
@@ -7,17 +7,12 @@
Warranty: Distributed WITHOUT WARRANTY OF ANY KIND
-// Whether the server should run in debug mode or not. If this is true then
-// errors encountered while servicing HTTP requests will not be handled by the
-// server itself. Normally the server will handle them and return an "internal
-// server error" response. A good way to debug Dylan Server Pages. Can be
-// enabled via the --debug command-line option.
-define variable *debugging-server* :: <boolean> = #f;
-
// 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 koala executable, unless changed in the config file.
+// (Moving this into the <server> class causes initialization ordering problems
+// with <virtual-host>...deal with it later.)
define variable *server-root* :: <directory-locator>
= parent-directory(locator-directory(as(<file-locator>, application-filename())));
@@ -25,24 +20,6 @@
define variable *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*
-define variable *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.
-define variable *auto-register-map* :: <string-table>
- = make(<string-table>);
-
-// This is #t when the server is listening for requests and #f otherwise.
-define variable *server-running?* :: <boolean> = #f;
// Since logging is done on a per-vhost basis, this hack is needed
// to make logging work before vhosts are initialized.
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 Sat May 3 22:07:38 2008
@@ -142,23 +142,6 @@
// 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>);
-
// Log targets. If these are #f then the default virtual host's
// log target is used. They are never #f in the default virtual host.
slot %activity-log-target :: false-or(<log-target>) = #f,
@@ -176,8 +159,6 @@
default-static-content-type-setter;
default-dynamic-content-type-setter;
generate-server-header?-setter;
- auto-register-pages?;
- auto-register-pages?-setter;
end;
define method initialize
@@ -231,8 +212,7 @@
// Maps host names to virtual hosts.
define constant $virtual-hosts :: <string-table> = make(<string-table>);
-define thread variable *virtual-host* :: <virtual-host>
- = make(<virtual-host>, name: "temporary"); // this value will be replaced.
+define thread variable *virtual-host* :: false-or(<virtual-host>) = #f;
define method add-virtual-host
(name :: <string>, vhost :: <virtual-host>)
More information about the chatter
mailing list