From 6d6e03b03f132a2a001db3c922d3632cff34a02d Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Tue, 6 Apr 2021 05:42:30 +0000 Subject: [PATCH 1/2] Update to match changes in command-line-parser v2.0.0 --- server/core/command-line.dylan | 154 ++++++++++++++++----------------- server/core/utilities.dylan | 3 +- 2 files changed, 77 insertions(+), 80 deletions(-) diff --git a/server/core/command-line.dylan b/server/core/command-line.dylan index 1662bf5..71da211 100644 --- a/server/core/command-line.dylan +++ b/server/core/command-line.dylan @@ -10,38 +10,41 @@ Copyright: See LICENSE in this distribution for details. // --listen ... add-option(*command-line-parser*, make(, - 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 add-option(*command-line-parser*, make(, + 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(, + 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 add-option(*command-line-parser*, make(, - 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 add-option(*command-line-parser*, make(, - 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 @@ -61,86 +64,79 @@ command-line args define function http-server-main (#key server :: false-or(), - description :: = "An HTTP server", before-startup :: false-or()) => () let parser = *command-line-parser*; block () - parse-command-line(parser, application-arguments(), - description: description); - exception (ex :: ) - exit-application(2); + parse-command-line(parser, application-arguments()); + exception (err :: ) + exit-application(err.exit-status); end; - if (~empty?(parser.positional-options)) - print-synopsis(parser, *standard-output*, description: description); - exit-application(2); - else - let debug? :: = get-option-value(parser, "debug"); - let handler - = method (cond :: , next-handler :: ) - 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? :: = get-option-value(parser, "debug"); + let handler + = method (cond :: , next-handler :: ) + 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(, cwd); - end; + let cwd = get-option-value(parser, "working-directory"); + if (cwd) + log-info("Working directory is %s", cwd); + working-directory() := as(, 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(); - 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(); + 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: 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: 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 diff --git a/server/core/utilities.dylan b/server/core/utilities.dylan index 4498120..c077b6d 100644 --- a/server/core/utilities.dylan +++ b/server/core/utilities.dylan @@ -13,7 +13,8 @@ define constant $default-https-port :: = 8443; // and extend this server (e.g., wiki) may want to add their own s to // this before calling http-server-main(). define variable *command-line-parser* :: - = make(); + = make(, + help: "Dylan HTTP server"); // Max size of data in a POST. From 7601469d7f0ca0ac43f012df171c1d0fb6beaff7 Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Tue, 6 Apr 2021 05:44:41 +0000 Subject: [PATCH 2/2] static files: fix bug in copy-to-end --- server/core/static-files.dylan | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/server/core/static-files.dylan b/server/core/static-files.dylan index 364955f..1786022 100644 --- a/server/core/static-files.dylan +++ b/server/core/static-files.dylan @@ -230,7 +230,11 @@ define method copy-to-end let buffer :: = 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 :: ) + ex.stream-error-count + end; write(out-stream, buffer, end: count); if (count = buffer-size) loop()