From 6686571f7a808c1ea26b8584f4c186ad4eab2a27 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 1 Jun 2007 16:53:20 +0000 Subject: [PATCH] Update run program svn: r6447 --- .../{ => htdocs}/lang-servlets/add-param.ss | 0 .../{ => htdocs}/lang-servlets/add-simple.ss | 0 .../{ => htdocs}/lang-servlets/add.ss | 0 .../{ => htdocs}/lang-servlets/add01.ss | 0 .../{ => htdocs}/lang-servlets/add02.ss | 0 .../{ => htdocs}/lang-servlets/add03.ss | 0 .../{ => htdocs}/lang-servlets/add04.ss | 0 .../{ => htdocs}/lang-servlets/add05.ss | 0 .../{ => htdocs}/lang-servlets/check-dir.ss | 0 .../{ => htdocs}/lang-servlets/quiz-lib.ss | 0 .../{ => htdocs}/lang-servlets/quiz01.ss | 0 .../{ => htdocs}/lang-servlets/quiz02.ss | 0 .../{ => htdocs}/lang-servlets/temp.ss | 0 .../{ => htdocs}/lang-servlets/toobig.ss | 0 .../{ => htdocs}/lang-servlets/wc-comp.ss | 0 .../{ => htdocs}/lang-servlets/wc-fake.ss | 0 .../{ => htdocs}/lang-servlets/wc.ss | 0 collects/web-server/run.ss | 52 +++++++++++++------ collects/web-server/web-server.ss | 7 ++- 19 files changed, 38 insertions(+), 21 deletions(-) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add-param.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add-simple.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add01.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add02.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add03.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add04.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/add05.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/check-dir.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/quiz-lib.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/quiz01.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/quiz02.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/temp.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/toobig.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/wc-comp.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/wc-fake.ss (100%) rename collects/web-server/default-web-root/{ => htdocs}/lang-servlets/wc.ss (100%) diff --git a/collects/web-server/default-web-root/lang-servlets/add-param.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add-param.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add-simple.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add-simple.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add01.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add01.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add02.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add02.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add02.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add03.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add03.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add03.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add04.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add04.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add04.ss diff --git a/collects/web-server/default-web-root/lang-servlets/add05.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add05.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/add05.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/add05.ss diff --git a/collects/web-server/default-web-root/lang-servlets/check-dir.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/check-dir.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/check-dir.ss diff --git a/collects/web-server/default-web-root/lang-servlets/quiz-lib.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz-lib.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/quiz-lib.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/quiz-lib.ss diff --git a/collects/web-server/default-web-root/lang-servlets/quiz01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/quiz01.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/quiz01.ss diff --git a/collects/web-server/default-web-root/lang-servlets/quiz02.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/quiz02.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/quiz02.ss diff --git a/collects/web-server/default-web-root/lang-servlets/temp.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/temp.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/temp.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/temp.ss diff --git a/collects/web-server/default-web-root/lang-servlets/toobig.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/toobig.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/toobig.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/toobig.ss diff --git a/collects/web-server/default-web-root/lang-servlets/wc-comp.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/wc-comp.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss diff --git a/collects/web-server/default-web-root/lang-servlets/wc-fake.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/wc-fake.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/wc-fake.ss diff --git a/collects/web-server/default-web-root/lang-servlets/wc.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss similarity index 100% rename from collects/web-server/default-web-root/lang-servlets/wc.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss diff --git a/collects/web-server/run.ss b/collects/web-server/run.ss index bf83e7b630..8b8dc8a6bd 100644 --- a/collects/web-server/run.ss +++ b/collects/web-server/run.ss @@ -1,5 +1,7 @@ (module run mzscheme - (require (lib "web-server.ss" "web-server") + (require (lib "cmdline.ss") + (lib "file.ss") + (lib "web-server.ss" "web-server") (lib "responders.ss" "web-server" "configuration") (prefix fsmap: (lib "filesystem-map.ss" "web-server" "dispatchers")) (prefix files: (lib "dispatch-files.ss" "web-server" "dispatchers")) @@ -8,27 +10,43 @@ (prefix sequencer: (lib "dispatch-sequencer.ss" "web-server" "dispatchers")) (prefix lang: (lib "dispatch-lang.ss" "web-server" "dispatchers"))) - (define server-root-path (build-path "~" "Development" "plt" "default-web-root")) - (define default-host-path (build-path server-root-path "conf")) + (define server-root-path (make-parameter (collection-path "web-server" "default-web-root"))) + (define port (make-parameter 8080)) + + (parse-command-line + "run" (current-command-line-arguments) + `((once-each + [("-p" "--port") + ,(lambda (flag the-port) (port (string->number the-port))) + (,(format "Specify a different port (default: ~a)" (number->string (port))) + "number")] + [("-r" "--root") + ,(lambda (flag path) (server-root-path (normalize-path (string->path path)))) + (,(format "Specify a different server root path (default: ~a)" (path->string (server-root-path))) + "path")])) + (lambda (flag-accum) (void)) + null) + + (define default-host-path (build-path (server-root-path) "conf")) (define file-not-found-file (build-path default-host-path "not-found.html")) (define servlet-error-file (build-path default-host-path "servlet-error.html")) (define url->path (fsmap:make-url->path - (build-path server-root-path "htdocs"))) + (build-path (server-root-path) "htdocs"))) - (serve - #:port 8080 - #:dispatch (sequencer:make - (filter:make - #rx"\\.ss" - (lang:make #:url->path (fsmap:make-url->path/optimism url->path) - #:timeouts-servlet-connection 86400 - #:responders-servlet-loading (gen-servlet-responder servlet-error-file) - #:responders-servlet (gen-servlet-responder servlet-error-file))) - (files:make #:url->path url->path - #:mime-types-path (build-path server-root-path "mime.types") - #:indices (list "index.html" "index.htm")) - (const:make (gen-file-not-found-responder file-not-found-file)))) + (serve #:port (port) + #:dispatch + (sequencer:make + (filter:make + #rx"\\.ss" + (lang:make #:url->path (fsmap:make-url->path/optimism url->path) + #:timeouts-servlet-connection 86400 + #:responders-servlet-loading (gen-servlet-responder servlet-error-file) + #:responders-servlet (gen-servlet-responder servlet-error-file))) + (files:make #:url->path url->path + #:mime-types-path (build-path (server-root-path) "mime.types") + #:indices (list "index.html" "index.htm")) + (const:make (gen-file-not-found-responder file-not-found-file)))) (do-not-return)) \ No newline at end of file diff --git a/collects/web-server/web-server.ss b/collects/web-server/web-server.ss index 70b45ff927..5ec69a2372 100644 --- a/collects/web-server/web-server.ss +++ b/collects/web-server/web-server.ss @@ -11,10 +11,9 @@ "web-server-sig.ss" "web-server-unit.ss" (prefix http: "private/request.ss")) - (provide - serve - serve/ports - serve/ips+ports) + (provide serve + serve/ports + serve/ips+ports) (provide/contract [do-not-return (-> void)] [serve/web-config@ (unit? . -> . (-> void?))])