From 350bc2167cb00c7afb629eb17fd41cc69bdab3b3 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Sun, 20 Aug 2006 01:06:57 +0000
Subject: [PATCH] pr8188

svn: r4098
---
 collects/web-server/configuration-table   | 39 +++++++++++++++--------
 collects/web-server/configuration-util.ss |  4 +--
 collects/web-server/configure.ss          |  8 +++--
 3 files changed, 34 insertions(+), 17 deletions(-)

diff --git a/collects/web-server/configuration-table b/collects/web-server/configuration-table
index 7d8155b08b..9d491d06df 100644
--- a/collects/web-server/configuration-table
+++ b/collects/web-server/configuration-table
@@ -6,13 +6,20 @@
      (default-indices "index.html" "index.htm")
      (log-format parenthesized-default)
      (messages
-       (servlet-message "servlet-error.html")
-       (authentication-message "forbidden.html")
-       (servlets-refreshed "servlet-refresh.html")
-       (passwords-refreshed "passwords-refresh.html")
-       (file-not-found-message "not-found.html")
-       (protocol-message "protocol-error.html")
-       (collect-garbage "collect-garbage.html"))
+       (servlet-message
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/servlet-error.html")
+       (authentication-message
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/forbidden.html")
+       (servlets-refreshed
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/servlet-refresh.html")
+       (passwords-refreshed
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/passwords-refresh.html")
+       (file-not-found-message
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/not-found.html")
+       (protocol-message
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/protocol-error.html")
+       (collect-garbage
+         "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/collect-garbage.html"))
      (timeouts
        (default-servlet-timeout 30)
        (password-connection-timeout 300)
@@ -21,10 +28,16 @@
        (file-base-connection-timeout 30))
      (paths
       (configuration-root "conf")
-      (host-root "default-web-root")
-      (log-file-path "log")
-      (file-root "htdocs")
-      (servlet-root ".")
-      (mime-types "mime.types")
-      (password-authentication "passwords"))))
+      (host-root
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root")
+      (log-file-path
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/log")
+      (file-root
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/htdocs")
+      (servlet-root
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/.")
+      (mime-types
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/mime.types")
+      (password-authentication
+        "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/passwords"))))
  (virtual-host-table))
diff --git a/collects/web-server/configuration-util.ss b/collects/web-server/configuration-util.ss
index 4496735166..c0abf8b3e3 100644
--- a/collects/web-server/configuration-util.ss
+++ b/collects/web-server/configuration-util.ss
@@ -58,6 +58,6 @@
       'truncate))
   
   (provide/contract
-   [write-configuration-table (configuration-table? string? . -> . void)]
+   [write-configuration-table (configuration-table? (or/c path? string?) . -> . void)]
    [format-host (host-table? . -> . list?)]
-   [write-to-file (string? list? . -> . void)]))
\ No newline at end of file
+   [write-to-file ((or/c path? string?) list? . -> . void)]))
\ No newline at end of file
diff --git a/collects/web-server/configure.ss b/collects/web-server/configure.ss
index 331811673d..6c752b1322 100644
--- a/collects/web-server/configure.ss
+++ b/collects/web-server/configure.ss
@@ -395,6 +395,7 @@
                     (paths-log paths)
                     (paths-htdocs paths)
                     (paths-servlet paths)
+                    (paths-mime-types paths)
                     (paths-passwords paths)))
       
       ; string->num : str -> nat
@@ -428,6 +429,8 @@
                             'path-htdocs (build-path-unless-absolute host-root (paths-htdocs paths)))
               ,(make-tr-str "Servlet root"
                             'path-servlet (build-path-unless-absolute host-root (paths-servlet paths)))
+              ,(make-tr-str "MIME Types"
+                            'path-mime-types (build-path-unless-absolute host-root (paths-mime-types paths)))
               ,(make-tr-str "Password File"
                             'path-password (build-path-unless-absolute host-root (paths-passwords paths)))
               (tr (td ([colspan "2"])
@@ -481,8 +484,9 @@
            (let ([old-paths (host-table-paths old)])
              (apply make-paths
                     (paths-conf old-paths)
-                    ((un-build-path web-base) (build-path (paths-host-base old-paths)))
-                    (map eb-host-root '(path-log path-htdocs path-servlet path-password)))))))
+                    ((un-build-path web-base)
+                     (build-path (paths-host-base old-paths)))
+                    (map eb-host-root '(path-log path-htdocs path-servlet path-mime-types path-password)))))))
       
       ; un-build-path : path -> path -> string
       ; (GregP) Theory: this should return a string not a path so that the result can be