diff --git a/collects/web-server/configuration-util.ss b/collects/web-server/configuration-util.ss
new file mode 100644
index 0000000000..f1cbb82df3
--- /dev/null
+++ b/collects/web-server/configuration-util.ss
@@ -0,0 +1,58 @@
+(module configuration-util mzscheme
+  (require (lib "file.ss")           
+           (lib "pretty.ss"))
+  (require "configuration-table-structs.ss")
+  (provide (all-defined))
+  
+  ; write-configuration-table : configuration-table path -> void
+  ; writes out the new configuration file
+  (define (write-configuration-table new configuration-path)
+    (write-to-file
+     configuration-path
+     `((port ,(configuration-table-port new))
+       (max-waiting ,(configuration-table-max-waiting new))
+       (initial-connection-timeout ,(configuration-table-initial-connection-timeout new))
+       (default-host-table
+         ,(format-host (configuration-table-default-host new)))
+       (virtual-host-table
+        . ,(map (lambda (h) (list (car h) (format-host (cdr h))))
+                (configuration-table-virtual-hosts new))))))
+  
+  ; format-host : host-table
+  (define (format-host host)
+    (let ([t (host-table-timeouts host)]
+          [p (host-table-paths host)]
+          [m (host-table-messages host)])
+      `(host-table
+        ; more here - configure
+        (default-indices "index.html" "index.htm")
+        ; more here - configure
+        (log-format parenthesized-default)
+        (messages
+         (servlet-message ,(messages-servlet m))
+         (authentication-message ,(messages-authentication m))
+         (servlets-refreshed ,(messages-servlets-refreshed m))
+         (passwords-refreshed ,(messages-passwords-refreshed m))
+         (file-not-found-message ,(messages-file-not-found m))
+         (protocol-message ,(messages-protocol m))
+         (collect-garbage ,(messages-collect-garbage m)))
+        (timeouts
+         (default-servlet-timeout ,(timeouts-default-servlet t))
+         (password-connection-timeout ,(timeouts-password t))
+         (servlet-connection-timeout ,(timeouts-servlet-connection t))
+         (file-per-byte-connection-timeout ,(timeouts-file-per-byte t))
+         (file-base-connection-timeout ,(timeouts-file-base t)))
+        (paths
+         (configuration-root ,(paths-conf p))
+         (host-root ,(paths-host-base p))
+         (log-file-path ,(paths-log p))
+         (file-root ,(paths-htdocs p))
+         (servlet-root ,(paths-servlet p))
+         (mime-types ,(paths-mime-types p))
+         (password-authentication ,(paths-passwords p))))))
+  
+  ; write-to-file : str TST -> void
+  (define (write-to-file file-name x)
+    (call-with-output-file file-name
+      (lambda (out) (pretty-print x out))
+      'truncate)))
\ No newline at end of file
diff --git a/collects/web-server/configuration.ss b/collects/web-server/configuration.ss
index 98082edb52..9dea338871 100644
--- a/collects/web-server/configuration.ss
+++ b/collects/web-server/configuration.ss
@@ -11,6 +11,7 @@
            (lib "contract.ss"))
   
   (provide complete-configuration
+           get-configuration
            build-developer-configuration
            build-developer-configuration/vhosts ;; added 2/3/05 by Jacob
            default-configuration-table-path
diff --git a/collects/web-server/configure.ss b/collects/web-server/configure.ss
index 0da86fe085..e3f5fb2cd6 100644
--- a/collects/web-server/configure.ss
+++ b/collects/web-server/configure.ss
@@ -11,8 +11,9 @@
                  default-configuration-table-path)
            (lib "configuration-table-structs.ss" "web-server")
            (lib "parse-table.ss" "web-server")
+           (lib "configuration-util.ss" "web-server")
            (all-except (lib "util.ss" "web-server") translate-escapes))
-
+  
   ;; FIX
   ; - fuss with changing absolute paths into relative ones internally
   ; - move old config files instead of copying default ones
@@ -24,46 +25,46 @@
   ;     - editing an individual path
   ; - change all configuration paths (in the configure servlet and in the server) to
   ;   use a platform independent representation (i.e. a listof strings)
-
+  
   ; servlet-maker : str -> (unit/sig servlet^ -> ())
   (define (servlet-maker default-configuration-path)
     (unit/sig ()
       (import servlet^)
-
+      
       (define CONFIGURE-SERVLET-NAME "configure.ss")
       (define WIDE "70")
-
+      
       (adjust-timeout! (* 12 60 60))
       (error-print-width 800) ; 10-ish lines
-
+      
       ; passwords = (listof realm)
       ; realm = (make-realm str str (listof user-pass))
       (define-struct realm (name pattern allowed))
-
+      
       ; user-pass = (make-user-pass sym str)
       (define-struct user-pass (user pass))
-
+      
       (define doc-dir "Defaults/documentation")
-
+      
       (define edit-host-button-name "Edit Minor Details")
-
+      
       ; build-footer : str -> html
       (define (build-footer base)
         (let ([scale (lambda (n) (number->string (round (/ n 4))))])
           `(p "Powered by "
               (a ([href "http://www.plt-scheme.org/"])
                  (img ([width ,(scale 211)] [height ,(scale 76)]
-                       [src ,(string-append base doc-dir "/plt-logo.gif")]))))))
-
+                                            [src ,(string-append base doc-dir "/plt-logo.gif")]))))))
+      
       (define footer (build-footer "/"))
-
+      
       ; access-error-page : html
       (define access-error-page
         `(html (head (title "Web Server Configuration Access Error"))
                (body ([bgcolor "white"])
                      (p "You must connect to the configuration tool from the machine the server runs on using 127.0.0.1 for the host part of the URL.")
                      ,footer)))
-
+      
       ; permission-error-page : path -> html
       (define (permission-error-page configuration-path)
         `(html (head (title "Web Server Configuration Permissions Error"))
@@ -71,27 +72,27 @@
                      (p "You must have read and write access to "
                         (code ,(path->string configuration-path))
                         " in order to configure the server."))))
-
+      
       ; check-ip-address : request -> request
       (define (check-ip-address request)
         (unless (string=? "127.0.0.1" (request-host-ip request))
           (send/finish access-error-page))
         request)
-
+      
       (check-ip-address initial-request)
-
+      
       (define web-base (directory-part default-configuration-path))
-
+      
       ; more here - abstract with static pages?
       (define web-server-icon
         `(img ([src ,(string-append "/" doc-dir "/web-server.gif")]
                ;[width "123"] [height "115"]
                [width "61"] [height "57"])))
-
+      
       ; interact : (str -> response) -> bindings
       (define (interact page)
         (request-bindings (check-ip-address (send/suspend page))))
-
+      
       ; choose-configuration-file : -> doesn't
       (define (choose-configuration-file)
         (let ([configuration-path (ask-for-configuration-path)])
@@ -109,7 +110,7 @@
                            (ensure-directory-shallow base))
                          (copy-file default-configuration-path configuration-path))
                        (loop))))))
-
+      
       ; copy-configuration-file : path -> html
       (define (copy-configuration-file configuration-path)
         (build-suspender
@@ -120,14 +121,14 @@
               "does not exist.  Would you like to copy the default configuration to this "
               "location?")
            (center (input ([type "submit"] [name "ok"] [value "Copy"]))))))
-
+      
       ; ask-for-configuration-path : -> path
       (define (ask-for-configuration-path)
         (build-path
          (extract-binding/single
           'path
           (request-bindings (send/suspend configuration-path-page)))))
-
+      
       ; configuration-path-page : str -> html
       (define configuration-path-page
         (build-suspender
@@ -140,10 +141,10 @@
               (blockquote (code ,(path->string default-configuration-path))))
            (table (tr (th "Configuration path")
                       (td (input ([type "text"] [name "path"] [size ,WIDE]
-                                  [value ,(path->string default-configuration-path)]))))
+                                                [value ,(path->string default-configuration-path)]))))
                   (tr (td ([colspan "2"] [align "center"])
                           (input ([type "submit"] [name "choose-path"] [value "Select"]))))))))
-
+      
       ; configure-top-level : path -> doesn't
       (define (configure-top-level configuration-path)
         (with-handlers ([exn:fail:filesystem:exists? send-exn])
@@ -172,7 +173,7 @@
                         [else form-configuration])])
                 (write-configuration new-configuration configuration-path)
                 (loop new-configuration))))))
-
+      
       ; switch-to-current-port : configuration-table -> (U #f configuration-table)
       ; doesn't work - the browser doesn't send the port and it wouldn't be reliable anyway
       ; perhaps the server could include it?
@@ -185,11 +186,11 @@
                  (configuration-table-initial-connection-timeout old)
                  (configuration-table-default-host old)
                  (configuration-table-virtual-hosts old)))))
-
+      
       ; send-exn : tst -> doesn't
       (define (send-exn exn)
         (send/back (exception-error-page exn)))
-
+      
       ; reverse-assoc : a (listof (cons b a)) -> (U #f (cons b a))
       (define (reverse-assoc x lst)
         (cond
@@ -197,13 +198,13 @@
           [else (if (equal? x (cdar lst))
                     (car lst)
                     (reverse-assoc x (cdr lst)))]))
-
+      
       ; add-virtual-host : configuration-table (listof str) -> configuration-table
       (define (add-virtual-host conf existing-prefixes)
         (update-hosts conf (cons (cons "my-host.my-domain.org"
                                        (configuration-table-default-host conf))
                                  (configuration-table-virtual-hosts conf))))
-
+      
       ; update-hosts : configuration-table (listof (cons str host-table))
       (define (update-hosts conf new-hosts)
         (make-configuration-table
@@ -212,13 +213,7 @@
          (configuration-table-initial-connection-timeout conf)
          (configuration-table-default-host conf)
          new-hosts))
-
-      ; write-to-file : str TST -> void
-      (define (write-to-file file-name x)
-        (call-with-output-file file-name
-          (lambda (out) (pretty-print x out))
-          'truncate))
-
+      
       ; delete-hosts : configuration-table (listof str) -> configuration-table
       ; pre: (>= (length (configuration-table-virtual-hosts conf)) (max to-delete))
       (define (delete-hosts conf to-delete)
@@ -228,7 +223,7 @@
             (update-hosts
              conf
              (drop (configuration-table-virtual-hosts conf) to-delete))))
-
+      
       ; drop : (listof a) (listof str) -> (listof a)
       ; pre: (apply < to-delete)
       ; to delete the entries in to-filter indexed by to-delete
@@ -239,7 +234,7 @@
             [else (if (= i (car to-delete))
                       (loop (cdr to-filter) (cdr to-delete) (add1 i))
                       (cons (car to-filter) (loop (cdr to-filter) to-delete (add1 i))))])))
-
+      
       ; configure-hosts : configuration-table (U #f nat) -> configuration-table
       ; n is either the virtual host number or #f for the default virtual host
       (define (configure-hosts old n)
@@ -261,7 +256,7 @@
              (configuration-table-initial-connection-timeout old)
              (configure-host (configuration-table-default-host old))
              (configuration-table-virtual-hosts old))))
-
+      
       ; configure-host : host-table -> host-table
       (define (configure-host old)
         (let* ([bindings (interact (request-new-host-table old))]
@@ -277,10 +272,10 @@
                 (write-to-file password-path ''()))
               (configure-passwords password-path)))
           new))
-
+      
       (define restart-message
         `((h3 (font ([color "red"]) "Restart the Web server to use the new settings."))))
-
+      
       ; request-new-configuration-table : configuration-table configuration-table -> str -> html
       (define (request-new-configuration-table old orig)
         (build-suspender
@@ -308,8 +303,8 @@
                       (th nbsp))
                   (tr (td ,"Default Host")
                       (td ,(make-field-size "text" 'default-host-root
-                                       (table->host-root (configuration-table-default-host old))
-                                       WIDE))
+                                            (table->host-root (configuration-table-default-host old))
+                                            WIDE))
                       (td ([align "center"])
                           (input ([type "submit"] [name "default"] [value ,edit-host-button-name])))
                       (td nbsp))
@@ -334,11 +329,11 @@
                   (tr (td (input ([type "submit"] [name "configure"] [value "Update Configuration"])))))
            (hr)
            ,footer)))
-
+      
       ; table->host-root : host-table -> str
       (define (table->host-root t)
         (path->string (build-path-unless-absolute web-base (paths-host-base (host-table-paths t)))))
-
+      
       ; gen-make-tr : nat -> xexpr sym str [xexpr ...] -> xexpr
       (define (gen-make-tr size-n)
         (let ([size-str (number->string size-n)])
@@ -346,38 +341,38 @@
             `(tr (td (a ([href ,(format "/~a/terms/~a.html" doc-dir tag)]) ,label))
                  (td ,(make-field-size "text" tag (format "~a" default-text) size-str))
                  . ,extra-tds))))
-
+      
       (define make-tr-num (gen-make-tr 20))
-
+      
       (define make-tr-str (gen-make-tr 70))
-
+      
       ; make-field : str sym str -> xexpr
       (define (make-field type label value)
         (make-field-size type label value "30"))
-
+      
       ; make-field-size : str sym str str -> xexpr
       (define (make-field-size type label value size)
         `(input ([type ,type] [name ,(symbol->string label)] [value ,value] [size ,size])))
-
+      
       ; update-configuration : configuration-table bindings -> configuration-table
       (define (update-configuration old bindings)
         (let ([ubp (un-build-path web-base)]) ;; web-base returned by directory-part is a path
-        (make-configuration-table
-         (string->nat (extract-binding/single 'port bindings))
-         (string->nat (extract-binding/single 'waiting bindings))
-         (string->num (extract-binding/single 'time-initial bindings))
-         (update-host-root (configuration-table-default-host old)
-                           (ubp (build-path (extract-binding/single 'default-host-root bindings))))
-         (map (lambda (h root pattern)
-                (cons pattern (update-host-root (cdr h) (ubp (build-path root)))))
-              (configuration-table-virtual-hosts old)
-              (extract-bindings 'host-roots bindings)
-              (extract-bindings 'host-regexps bindings)))))
-
+          (make-configuration-table
+           (string->nat (extract-binding/single 'port bindings))
+           (string->nat (extract-binding/single 'waiting bindings))
+           (string->num (extract-binding/single 'time-initial bindings))
+           (update-host-root (configuration-table-default-host old)
+                             (ubp (build-path (extract-binding/single 'default-host-root bindings))))
+           (map (lambda (h root pattern)
+                  (cons pattern (update-host-root (cdr h) (ubp (build-path root)))))
+                (configuration-table-virtual-hosts old)
+                (extract-bindings 'host-roots bindings)
+                (extract-bindings 'host-regexps bindings)))))
+      
       ; update-host-root : host-table str -> host-table
       (define (update-host-root host new-root)
         (host-table<-paths host (paths<-host-base (host-table-paths host) new-root)))
-
+      
       ; host-table<-paths : host-table paths -> host-table
       ; more here - create these silly functions automatically from def-struct macro
       (define (host-table<-paths host paths)
@@ -387,7 +382,7 @@
          (host-table-messages host)
          (host-table-timeouts host)
          paths))
-
+      
       ; paths<-host-base : paths str -> paths
       ; more here - create these silly functions automatically from def-struct macro
       (define (paths<-host-base paths host-base)
@@ -397,18 +392,18 @@
                     (paths-htdocs paths)
                     (paths-servlet paths)
                     (paths-passwords paths)))
-
+      
       ; string->num : str -> nat
       (define (string->num str)
         (or (string->number str) (error 'string->nat "~s is not a number" str)))
-
+      
       ; string->nat : str -> nat
       (define (string->nat str)
         (let ([n (string->number str)])
           (if (and n (integer? n) (exact? n) (>= n 0))
               n
               (error 'string->nat "~s is not exactly a natural number" str))))
-
+      
       ; request-new-host-table : host-table -> str -> response
       (define (request-new-host-table old)
         (let* ([timeouts (host-table-timeouts old)]
@@ -459,7 +454,7 @@
              (hr)
              (input ([type "submit"] [value "Save Configuration"]))
              ,footer))))
-
+      
       ; update-host-table : host-table (listof (cons sym str)) -> host-table
       (define (update-host-table old bindings)
         (let* ([eb (lambda (tag) (build-path (extract-binding/single tag bindings)))]
@@ -484,7 +479,7 @@
                     (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 : path -> path -> string
       ; (GregP) Theory: this should return a string not a path so that the result can be
       ;                 written to the configuration file.
@@ -497,7 +492,7 @@
                  => (lambda (x) (path->string (apply build-path x)))]
                 [else
                  (path->string path)])))))
-
+      
       ; suffix : (listof a) (listof a) -> (U #f (listof a))
       ; to return the extra elements in b after removing all elements from a in order
       (define (suffix a b)
@@ -507,9 +502,9 @@
                   [(null? b) #f]
                   [else (and (equal? (car a) (car b))
                              (suffix (cdr a) (cdr b)))])]))
-
+      
       ; Password Configuration
-
+      
       ; configure-passwords : path -> void
       (define (configure-passwords password-path)
         (edit-passwords
@@ -517,7 +512,7 @@
          (if (file-exists? password-path)
              (call-with-input-file password-path read-passwords)
              null)))
-
+      
       ; edit-passwords : path passwords -> passwords
       (define (edit-passwords which-one passwords)
         (let* ([bindings (interact (password-updates which-one passwords))]
@@ -541,7 +536,7 @@
              (again (cons (make-realm "new realm" "" null)
                           (drop passwords to-deactivate)))]
             [else (drop passwords to-deactivate)])))
-
+      
       ; password-updates : path passwords -> request
       (define (password-updates which-one passwords)
         (let ([which-one (path->string which-one)])
@@ -563,7 +558,7 @@
              ,(make-field "submit" 'add "Add Realm")
              ,(make-field "submit" 'edit-button "Edit")
              ,footer))))
-
+      
       ; edit-realm : realm -> realm
       (define (edit-realm realm)
         (let* ([bindings (interact (realm-updates realm))]
@@ -582,7 +577,7 @@
             [(assq 'update bindings)
              (make-realm new-name new-pattern new-allowed)]
             [else (error 'edit-realm "Didn't find either 'add-user or 'update in ~s" bindings)])))
-
+      
       ; realm-updates : realm -> request
       (define (realm-updates realm)
         (build-suspender
@@ -603,7 +598,7 @@
            (input ([type "submit"] [name "add-user"] [value "Add User"]))
            (input ([type "submit"] [name "update"] [value "Update Realm"]))
            ,footer)))
-
+      
       ; read-passwords : iport -> passwords
       ; only works if the file starts with (quote ...)
       (define (read-passwords in)
@@ -618,7 +613,7 @@
                              (map (lambda (x) (make-user-pass (car x) (cadr x)))
                                   (cddr raw-realm))))
                (cadr raw))))
-
+      
       ; format-passwords : passwords -> s-expr
       (define (format-passwords passwords)
         (list 'quote
@@ -629,9 +624,9 @@
                                    (list (user-pass-user x) (user-pass-pass x)))
                                  (realm-allowed r))))
                    passwords)))
-
+      
       ; Little Helpers
-
+      
       ; initialization-error-page : response
       (define initialization-error-page
         `(html (head (title "Web Server Configuration Program Invocation Error"))
@@ -640,7 +635,7 @@
                         (a ([href ,(url->string (request-uri initial-request))]) "configuration program,")
                         " not through another URL.")
                      ,footer)))
-
+      
       ; done-page : html
       (define done-page
         ; more-here - consider adding more useful information
@@ -649,7 +644,7 @@
                      (h2 "Configuration Saved.")
                      (p "Click your browser's back button to continue configuring the server.")
                      ,footer)))
-
+      
       ; exception-error-page : TST -> html
       (define (exception-error-page exn)
         `(html (head (title "Error"))
@@ -657,41 +652,32 @@
                      (p "Servlet exception: "
                         (pre ,(exn->string exn)))
                      ,footer)))
-
+      
       (define must-select-host-page
         `(html (head (title "Web Server Configuration Error"))
                (body ([bgcolor "white"])
                      (p "Please select which host to edit before clicking the Edit button.")
                      ,footer)))
-
+      
       ; io
-
+      
       ; read-configuration : path -> configuration-table
       (define (read-configuration configuration-path)
         (parse-configuration-table (call-with-input-file configuration-path read)))
-
+      
       ; write-configuration : configuration-table path -> void
       ; writes out the new configuration file and
       ; also copies the configure.ss servlet to the default-host's servlet directory
       (define (write-configuration new configuration-path)
         (ensure-configuration-servlet configuration-path (configuration-table-default-host new))
         (ensure-configuration-paths new)
-        (write-to-file
-         configuration-path
-         `((port ,(configuration-table-port new))
-           (max-waiting ,(configuration-table-max-waiting new))
-           (initial-connection-timeout ,(configuration-table-initial-connection-timeout new))
-           (default-host-table
-            ,(format-host (configuration-table-default-host new)))
-           (virtual-host-table
-            . ,(map (lambda (h) (list (car h) (format-host (cdr h))))
-                    (configuration-table-virtual-hosts new))))))
-
+        (write-configuration-table new configuration-path))
+      
       ; ensure-configuration-servlet : path host-table -> void
       (define (ensure-configuration-servlet configuration-path host)
         (let* ([paths (host-table-paths host)]
                [root (build-path-unless-absolute web-base
-                                       (paths-host-base paths))]
+                                                 (paths-host-base paths))]
                [servlets-path
                 (build-path (build-path-unless-absolute root (paths-servlet paths)) "servlets")])
           (ensure-config-servlet configuration-path servlets-path)
@@ -699,14 +685,14 @@
             (ensure* (collection-path "web-server" "default-web-root" "htdocs")
                      (build-path-unless-absolute root (paths-htdocs paths))
                      defaults))))
-
+      
       ; ensure-configuration-paths : configuration-table -> void
       ; to ensure that all the referenced config files exist for an entire configuration
       (define (ensure-configuration-paths configuration)
         (ensure-host-configuration (configuration-table-default-host configuration))
         (for-each (lambda (x) (ensure-host-configuration (cdr x)))
                   (configuration-table-virtual-hosts configuration)))
-
+      
       ; ensure-host-configuration : host-table -> void
       ; to ensure that all the referenced config files exist for a virtual host
       (define (ensure-host-configuration host)
@@ -735,7 +721,7 @@
             (copy-conf "not-found.html" (messages-file-not-found messages))
             (copy-conf "servlet-error.html" (messages-servlet messages))
             (copy-conf "collect-garbage.html" (messages-collect-garbage messages)))))
-
+      
       ; ensure-file : path path path -> void
       ; to copy (build-path from name) to (build-path to name), creating directories as
       ; needed if the latter does not already exist.
@@ -745,14 +731,14 @@
           (let ([to-path (build-path to name)])
             (unless (file-exists? to-path)
               (copy-file (build-path from name) to-path)))))
-
+      
       ; copy-file* : str str -> void
       (define (copy-file* from-path to-path)
         (unless (file-exists? to-path)
           (let-values ([(to-path-base to-path-name must-be-dir?) (split-path to-path)])
             (ensure-directory-shallow to-path-base))
           (copy-file from-path to-path)))
-
+      
       ; ensure* : path path path -> void
       ;; GregP: Don't know what the heck this does (thanks Paul)
       ;;        but the first two arguments are now paths.
@@ -768,13 +754,13 @@
                            (directory-list p))))]
             [(file-exists? p)
              (ensure-file from to name)])))
-
+      
       ; ensure-directory-shallow : path -> void
       (define (ensure-directory-shallow to)
         (unless (directory-exists? to)
           ; race condition - someone else could make the directory
           (make-directory* to)))
-
+      
       ; ensure-config-servlet : str path -> void
       ; to create, if necessary, a stub configuration servlet that includes the main configuration servlet
       ; at the desired location in a new web tree
@@ -792,39 +778,7 @@
                 (pretty-print
                  `(servlet-maker ,(path->string configuration-path))
                  out))))))
-
-      ; format-host : host-table
-      (define (format-host host)
-        (let ([t (host-table-timeouts host)]
-              [p (host-table-paths host)]
-              [m (host-table-messages host)])
-          `(host-table
-            ; more here - configure
-            (default-indices "index.html" "index.htm")
-            ; more here - configure
-            (log-format parenthesized-default)
-            (messages
-             (servlet-message ,(messages-servlet m))
-             (authentication-message ,(messages-authentication m))
-             (servlets-refreshed ,(messages-servlets-refreshed m))
-             (passwords-refreshed ,(messages-passwords-refreshed m))
-             (file-not-found-message ,(messages-file-not-found m))
-             (protocol-message ,(messages-protocol m))
-             (collect-garbage ,(messages-collect-garbage m)))
-            (timeouts
-             (default-servlet-timeout ,(timeouts-default-servlet t))
-             (password-connection-timeout ,(timeouts-password t))
-             (servlet-connection-timeout ,(timeouts-servlet-connection t))
-             (file-per-byte-connection-timeout ,(timeouts-file-per-byte t))
-             (file-base-connection-timeout ,(timeouts-file-base t)))
-            (paths
-             (configuration-root ,(paths-conf p))
-             (host-root ,(paths-host-base p))
-             (log-file-path ,(paths-log p))
-             (file-root ,(paths-htdocs p))
-             (servlet-root ,(paths-servlet p))
-             (password-authentication ,(paths-passwords p))))))
-
+      
       ; extract-definition : sym (listof s-expr) -> s-expr
       ; to return the rhs from (def name rhs) not (def (name . args) body)
       (define (extract-definition name defs)
@@ -835,12 +789,12 @@
                           (caddr def)))
                    defs)
             (error 'extract-definition "definition for ~a not found" name)))
-
+      
       ; passwords = str (i.e. path to a file)
-
+      
       (define build-path-maybe-expression->file-name caddr)
-
+      
       ; main
       (choose-configuration-file)))
-
+  
   (define servlet (servlet-maker default-configuration-table-path)))
diff --git a/collects/web-server/info.ss b/collects/web-server/info.ss
index 58531b142a..679847608c 100644
--- a/collects/web-server/info.ss
+++ b/collects/web-server/info.ss
@@ -1,7 +1,7 @@
 (module info (lib "infotab.ss" "setup")
   (define name "Web Server")
-  (define mzscheme-launcher-libraries (list "text-launch.ss" "monitor-launch.ss"))
-  (define mzscheme-launcher-names (list "web-server-text" "web-server-monitor"))
+  (define mzscheme-launcher-libraries (list "text-launch.ss" "monitor-launch.ss" "setup-launch.ss" ))
+  (define mzscheme-launcher-names (list "web-server-text" "web-server-monitor" "web-server-setup"))
 
   (define mred-launcher-libraries (list "gui-launch.ss"))
   (define mred-launcher-names (list "web-server")))
diff --git a/collects/web-server/launch.ss b/collects/web-server/launch.ss
index fc68ae1d2a..bbd0593d43 100644
--- a/collects/web-server/launch.ss
+++ b/collects/web-server/launch.ss
@@ -26,7 +26,7 @@
         [("-p" "--port")
          ,(lambda (flag port)
             (let ([p (string->number port)])
-              (if (and (number? p) (integer? p) (exact? p) (<= 1 p 65535))
+              (if (valid-port? p)
                   (cons 'port p)
                   (error 'web-server "port expects an argument of type <exact integer in [1, 65535]>; given ~s" port))))
          ("Use an alternate network port." "port")]
diff --git a/collects/web-server/setup-launch.ss b/collects/web-server/setup-launch.ss
new file mode 100644
index 0000000000..bdfd000be7
--- /dev/null
+++ b/collects/web-server/setup-launch.ss
@@ -0,0 +1,41 @@
+(module setup-launch mzscheme
+  (require (lib "cmdline.ss")
+           (lib "file.ss")
+           (lib "struct.ss"))
+  (require "configuration.ss"
+           "configuration-table-structs.ss"
+           "util.ss"
+           "configuration-util.ss")
+  
+  (parse-command-line
+   "web-server-setup"
+   (current-command-line-arguments)
+   `((once-each
+      [("-p" "--port")
+       ,(lambda (flag port)
+          (let ([p (string->number port)])
+            (if (valid-port? p)
+                (cons 'port p)
+                (error 'web-server-setup "port expects an argument of type <exact integer in [1, 65535]>; given ~s" port))))
+       ("Use an alternate network port." "port")]
+      [("-d" "--destination")
+       ,(lambda (flag destination)
+          (let ([p (normalize-path (string->path destination))])
+            (cons 'destination p)))
+       ("Use an destination directory other than the current directory" "directory")]))
+   (lambda (flags)
+     (let ([port (extract-flag 'port flags 8080)]
+           [dest (extract-flag 'destination flags (current-directory))])
+       ;; Create dest
+       (make-directory* dest)
+       ;; Copy default-web-root into dest/default-web-root
+       (copy-directory/files (build-path (collection-path "web-server") "default-web-root")
+                             (build-path dest "default-web-root"))
+       ;; Read default configuration-table, changing the port
+       ;; Write configuration-table into dest/configuration-table
+       (write-configuration-table
+        (copy-struct configuration-table 
+                     (get-configuration default-configuration-table-path)
+                     [configuration-table-port port])
+        (build-path dest "configuration-table"))))
+   '()))
diff --git a/collects/web-server/util.ss b/collects/web-server/util.ss
index 115a7829a8..5c7df263f0 100644
--- a/collects/web-server/util.ss
+++ b/collects/web-server/util.ss
@@ -14,6 +14,7 @@
            url-path->string)
   
   (provide/contract
+   [valid-port? (any/c . -> . boolean?)]
    [decompose-request ((request?) . ->* . (url? symbol? string?))]
    [network-error ((symbol? string?) (listof any/c) . ->* . (void))]
    [path->list  (path? . -> . (cons/c (union path? (symbols 'up 'same))
@@ -24,6 +25,10 @@
    [exn->string ((union exn? any/c) . -> . string?)]
    [build-path-unless-absolute (path? (union string? path?) . -> . path?)])
   
+  ;; valid-port? : any/c -> boolean?
+  (define (valid-port? p)
+    (and (number? p) (integer? p) (exact? p) (<= 1 p 65535)))
+  
   ;; ripped this off from url-unit.ss
   (define (url-path->string strs)
     (apply