Skip to content

Commit

Permalink
Merge pull request #95 from cgay/updates
Browse files Browse the repository at this point in the history 
Update command-line and fix static file bug
  • Loading branch information
@cgay
cgay committed Apr 7, 2021
2 parents 9f30a1d + 7601469 commit f85bb33
Show file tree
Hide file tree
Showing 3 changed files with 82 additions and 81 deletions.
154 changes: 75 additions & 79 deletions server/core/command-line.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,38 +10,41 @@ Copyright: See LICENSE in this distribution for details.
// --listen <interface> ...
add-option(*command-line-parser*,
make(<repeated-parameter-option>,
help: format-to-string("host:port on which to "
"listen. Option may be "
"repeated. "
names: #("listen", "l"),
variable: "host:port",
help: format-to-string("Address and port on which to "
"listen. May be repeated. "
"[default: 0.0.0.0:%d]",
$default-http-port),
names: #("listen", "l")));
$default-http-port)));

// --config <file>
add-option(*command-line-parser*,
make(<parameter-option>,
names: #("config", "c"),
variable: "file",
help: "Location of the server configuration file. "
"[default: None]",
names: #("config", "c")));
"[default: None]"));

// --debug
add-option(*command-line-parser*,
make(<flag-option>,
names: #("debug"),
help: "Enable debug mode. Causes the server to not handle "
"most errors during request handling.",
names: #("debug")));
"most errors during request handling."));

// --working-directory <dir>
add-option(*command-line-parser*,
make(<parameter-option>,
help: "Working directory to change to upon startup",
names: #("working-directory", "w")));
names: #("working-directory", "w"),
variable: "dir",
help: "Working directory to change to upon startup"));

// --directory <static-dir>
add-option(*command-line-parser*,
make(<parameter-option>,
help: "Serve static content from the given directory.",
names: #("directory")));
names: #("directory"),
variable: "dir",
help: "Serve static content from the given directory."));

/*
This is the precedence order (lowest to highest) in which initialization
Expand All @@ -61,86 +64,79 @@ command-line args

define function http-server-main
(#key server :: false-or(<http-server>),
description :: <string> = "An HTTP server",
before-startup :: false-or(<function>))
=> ()
let parser = *command-line-parser*;
block ()
parse-command-line(parser, application-arguments(),
description: description);
exception (ex :: <usage-error>)
exit-application(2);
parse-command-line(parser, application-arguments());
exception (err :: <abort-command-error>)
exit-application(err.exit-status);
end;
if (~empty?(parser.positional-options))
print-synopsis(parser, *standard-output*, description: description);
exit-application(2);
else
let debug? :: <boolean> = get-option-value(parser, "debug");
let handler <error>
= method (cond :: <error>, next-handler :: <function>)
if (debug?)
next-handler() // decline to handle it
else
format(*standard-error*, "Error: %s\n", cond);
force-output(*standard-error*);
exit-application(1);
end;
let debug? :: <boolean> = get-option-value(parser, "debug");
let handler <error>
= method (cond :: <error>, next-handler :: <function>)
if (debug?)
next-handler() // decline to handle it
else
format(*standard-error*, "Error: %s\n", cond);
force-output(*standard-error*);
exit-application(1);
end;
end;

let cwd = get-option-value(parser, "working-directory");
if (cwd)
log-info("Working directory is %s", cwd);
working-directory() := as(<directory-locator>, cwd);
end;
let cwd = get-option-value(parser, "working-directory");
if (cwd)
log-info("Working directory is %s", cwd);
working-directory() := as(<directory-locator>, cwd);
end;

// We want to bind *server* early so that log output goes to the
// right place (the server's default virtual host's logs).
let server = server | make(<http-server>);
dynamic-bind (*server* = server)
*server*.debugging-enabled? := debug?;
if (*server*.debugging-enabled?)
log-warning("*** DEBUGGING ENABLED *** Error conditions will "
"cause server to enter debugger (or exit).");
end;
// We want to bind *server* early so that log output goes to the
// right place (the server's default virtual host's logs).
let server = server | make(<http-server>);
dynamic-bind (*server* = server)
*server*.debugging-enabled? := debug?;
if (*server*.debugging-enabled?)
log-warning("*** DEBUGGING ENABLED *** Error conditions will "
"cause server to enter debugger (or exit).");
end;

// Configure first so that command-line argument override config settings.
let config-file = get-option-value(parser, "config");
if (config-file)
configure-server(*server*, config-file);
end;
// Configure first so that command-line argument override config settings.
let config-file = get-option-value(parser, "config");
if (config-file)
configure-server(*server*, config-file);
end;

// If --directory is specified, map it to / on the server.
// This is a special case to make serving a directory super-easy.
let directory = get-option-value(parser, "directory");
if (directory)
add-resource(*server*, "/", make(<directory-resource>,
directory: directory,
allow-directory-listing?: #t,
follow-symlinks?: #f));
end;
// If --directory is specified, map it to / on the server.
// This is a special case to make serving a directory super-easy.
let directory = get-option-value(parser, "directory");
if (directory)
add-resource(*server*, "/", make(<directory-resource>,
directory: directory,
allow-directory-listing?: #t,
follow-symlinks?: #f));
end;

// Gives callers a chance to do things after the server has been
// configured. e.g., the wiki wants to add responders after a
// URL prefix has been configured.
if (before-startup)
before-startup(*server*);
end;
// Gives callers a chance to do things after the server has been
// configured. e.g., the wiki wants to add responders after a
// URL prefix has been configured.
if (before-startup)
before-startup(*server*);
end;

// Any command-line listeners specified?
let listeners = get-option-value(parser, "listen");
for (listener in listeners)
add!(*server*.server-listeners, make-listener(listener));
end;
// Any command-line listeners specified?
let listeners = get-option-value(parser, "listen");
for (listener in listeners)
add!(*server*.server-listeners, make-listener(listener));
end;

log-debug("Mapped resources:");
do-resources(*server*,
method (res)
log-debug(" %-25s -- %s", res.resource-url-path, res);
end);
log-debug("Mapped resources:");
do-resources(*server*,
method (res)
log-debug(" %-25s -- %s", res.resource-url-path, res);
end);

start-server(*server*);
end dynamic-bind;
end if;
start-server(*server*);
end dynamic-bind;
end function http-server-main;

begin
Expand Down
6 changes: 5 additions & 1 deletion server/core/static-files.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,11 @@ define method copy-to-end
let buffer :: <sequence> = make(stream-sequence-class(in-stream),
size: buffer-size);
iterate loop ()
let count = read-into!(in-stream, buffer-size, buffer, on-end-of-stream: #f);
let count = block ()
read-into!(in-stream, buffer-size, buffer)
exception (ex :: <incomplete-read-error>)
ex.stream-error-count
end;
write(out-stream, buffer, end: count);
if (count = buffer-size)
loop()
Expand Down
3 changes: 2 additions & 1 deletion server/core/utilities.dylan
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,8 @@ define constant $default-https-port :: <integer> = 8443;
// and extend this server (e.g., wiki) may want to add their own <option-parser>s to
// this before calling http-server-main().
define variable *command-line-parser* :: <command-line-parser>
= make(<command-line-parser>);
= make(<command-line-parser>,
help: "Dylan HTTP server");


// Max size of data in a POST.
Expand Down

0 comments on commit f85bb33

Please sign in to comment.