Changing web server default servlet handling

svn: r12178

collects/tests/web-server/dispatchers/dispatch-servlets-test.ss

@@ -27,7 +27,7 @@
   d)
 
 (define example-servlets 
-  (build-path (collection-path "web-server") "default-web-root" "servlets" "examples/"))
+  (build-path (collection-path "web-server") "default-web-root" "htdocs" "servlets" "examples/"))
 
 (define dispatch-servlets-tests
   (test-suite

collects/web-server/default-web-root/htdocs/servlets/examples/quiz.ss

@@ -15,7 +15,7 @@
 ;; Configuration
 (define *data-file*
   (build-path (collection-path "web-server")
-              "default-web-root" "servlets" "examples" "english-measure-questions.ss"))
+              "default-web-root" "htdocs" "servlets" "examples" "english-measure-questions.ss"))
 (define *questions-per-quiz* 5)
 
 (require web-server/servlet

collects/web-server/scribblings/configuration.scrbl

@@ -113,7 +113,6 @@ structures.
 
 where a @scheme[host-table-sexpr] is:
 
-@; XXX Allowable log-formats?
 @; XXX Where the paths are resolved relative to
 @schemeblock[
 `(host-table
@@ -142,6 +141,12 @@ where a @scheme[host-table-sexpr] is:
    (mime-types ,path-string?)
    (password-authentication ,path-string?)))]
 
+@(require (for-label web-server/dispatchers/dispatch-log))
+
+Allowable @scheme['log-format]s are those accepted by @scheme[log-format->format].
+
+Note: You almost always want to leave everything in the @scheme['paths] section the default except the @scheme['host-root].
+
 @defproc[(read-configuration-table (path path-string?))
          configuration-table?]{
 This function reads a @scheme[configuration-table] from @scheme[path].

collects/web-server/scribblings/dispatchers.scrbl

@@ -187,25 +187,31 @@ a URL that refreshes the password file, servlet cache, etc.}
 @defthing[paren-format format-req/c]{
  Formats a request by:
  @schemeblock[
-  (format "~s~n"
+  (format 
-            (list 'from (request-client-ip req)
+   "~s~n"
-                  'to (request-host-ip req)
+   (list 'from (request-client-ip req)
-                  'for (url->string (request-uri req)) 'at
+         'to (request-host-ip req)
-                  (date->string (seconds->date (current-seconds)) #t)))
+         'for (url->string (request-uri req)) 'at
- ]}
+         (date->string
+          (seconds->date (current-seconds)) #t)))
+  ]}
 
 @defthing[extended-format format-req/c]{
  Formats a request by:
  @schemeblock[
-  (format "~s~n"
+  (format 
-            `((client-ip ,(request-client-ip req))
+   "~s~n"
-              (host-ip ,(request-host-ip req))
+   `((client-ip ,(request-client-ip req))
-              (referer ,(let ([R (headers-assq* #"Referer" (request-headers/raw req))])
+     (host-ip ,(request-host-ip req))
-                          (if R
+     (referer 
-                              (header-value R)
+      ,(let ([R (headers-assq* 
-                              #f)))
+                 #"Referer"
-              (uri ,(url->string (request-uri req)))
+                 (request-headers/raw req))])
-              (time ,(current-seconds))))
+         (if R
+             (header-value R)
+             #f)))
+     (uri ,(url->string (request-uri req)))
+     (time ,(current-seconds))))
  ]}
 
 @defthing[apache-default-format format-req/c]{

collects/web-server/scribblings/web-server-unit.scrbl

@@ -43,7 +43,7 @@ operations:
  @item{Allows the @scheme["/conf/refresh-passwords"] URL to refresh the password file.}
  @item{Allows the @scheme["/conf/collect-garbage"] URL to call the garbage collector.}
  @item{Allows the @scheme["/conf/refresh-servlets"] URL to refresh the servlets cache.}
- @item{Execute servlets under the @scheme["/servlets/"] URL in the given servlet root directory.}
+ @item{Execute servlets in the mapping URLs to the given servlet root directory.}
  @item{Serves files under the @scheme["/"] URL in the given htdocs directory.}
 ]
 

collects/web-server/web-config-unit.ss

@@ -15,14 +15,14 @@
        (#:port (or/c false/c number?)
                #:listen-ip (or/c false/c string?)
                #:make-servlet-namespace make-servlet-namespace/c)
-      unit?)]
+       unit?)]
  [configuration-table-sexpr->web-config@
   (->* (list?) ; XXX
-      (#:web-server-root path-string?
+       (#:web-server-root path-string?
-      #:port (or/c false/c number?)
+                          #:port (or/c false/c number?)
-      #:listen-ip (or/c false/c string?)
+                          #:listen-ip (or/c false/c string?)
-      #:make-servlet-namespace make-servlet-namespace/c)
+                          #:make-servlet-namespace make-servlet-namespace/c)
-      unit?)])
+       unit?)])
 
 ; configuration-table->web-config@ : path -> configuration
 (define (configuration-table->web-config@ 
@@ -121,12 +121,13 @@
            (if p 
                (build-path-unless-absolute b p)
                #f))])
-    (let ([host-base (build-path-unless-absolute web-server-root (paths-host-base paths))])
+    (let* ([host-base (build-path-unless-absolute web-server-root (paths-host-base paths))]
+           [htdocs-base (build-path-unless-absolute host-base (paths-htdocs paths))])
       (make-paths (build-path-unless-absolute host-base (paths-conf paths))
                   host-base
                   (build-path-unless-absolute host-base (paths-log paths))
-                  (build-path-unless-absolute host-base (paths-htdocs paths))
+                  htdocs-base
-                  (build-path-unless-absolute host-base (paths-servlet paths))
+                  (build-path-unless-absolute htdocs-base (paths-servlet paths))
                   (build-path-unless-absolute host-base (paths-mime-types paths))                    
                   (build-path-unless-absolute host-base (paths-passwords paths))))))
 

collects/web-server/web-server-unit.ss

@@ -85,11 +85,9 @@
                              (lambda _
                                (clear-cache!)
                                ((responders-servlets-refreshed (host-responders host-info)))))
-        (filter:make
+        (sequencer:make
-         #rx"^/servlets"
+         (timeout:make (timeouts-servlet-connection (host-timeouts host-info)))
-         (sequencer:make
+         servlet-dispatch)))
-          (timeout:make (timeouts-servlet-connection (host-timeouts host-info)))
-          servlet-dispatch))))
      (files:make #:url->path (fsmap:make-url->path (paths-htdocs (host-paths host-info)))
                  #:path->mime-type (make-path->mime-type (paths-mime-types (host-paths host-info)))
                  #:indices (host-indices host-info))