Changeset 12035 in project

Timestamp:

09/29/08 21:55:49 (12 years ago)

Author:

sjamaan

Message:

Fix some small inconsistencies, add vhost support

File:

• release/4/spiffy/trunk/spiffy.scm (modified) (6 diffs)

release/4/spiffy/trunk/spiffy.scm

@@ -39 +39 @@
   (start-server with-headers send-status send-static-file
    current-request current-response current-file current-pathinfo
-   root-path server-port index-files mime-type-map default-mime-type default-host
+   root-path server-port index-files mime-type-map default-mime-type
+   file-extension-handlers default-host vhost-map
    handle-directory handle-not-found
    restart-request)
 
 (import chicken scheme extras ports files data-structures)
-(require-extension srfi-1 srfi-18 posix tcp
+(require-extension srfi-1 srfi-18 posix tcp regex
                    intarweb uri-generic sendfile matchable)
 
@@ -59 +60 @@
 (define root-path        (make-parameter "./web"))
 (define server-port      (make-parameter 8080))
-(define index-files      (make-parameter '("index.html" "index.htm")))
+(define index-files      (make-parameter '("index.html" "index.xhtml")))
 (define mime-type-map
   (make-parameter
@@ -75 +76 @@
      ("svg" . image/svg+xml)
      ("bmp" . image/bmp)
-     ("txt" . text/plain)
-     ("htm" . text/html))))
+     ("txt" . text/plain))))
 (define default-mime-type (make-parameter 'application/octet-stream))
+(define file-extension-handlers (make-parameter '()))
 (define default-host (make-parameter "localhost")) ;; XXX Can we do without?
-(define file-extension-handlers (make-parameter '()))
+(define vhost-map (make-parameter `((".*" . ,(lambda (continue) (continue))))))
 
 ;;; Custom handlers
@@ -97 +98 @@
 (define handle-not-found
   (make-parameter
-   (lambda ()
+   (lambda (path)
      (send-status 404 "Not found"
                   "The resource you requested could not be found"))))
@@ -181 +182 @@
                              (cdr remaining-path)))))
      ((file-exists? path)
-      ((handle-file) current-path))
-     (else ((handle-not-found))))))
+      (parameterize ((current-pathinfo remaining-path)
+                     (current-file path))
+        ((handle-file) current-path)))
+     (else ((handle-not-found) current-path)))))
 
 ;; Determine the vhost and port to use. This follows RFC 2616, section 5.2:
@@ -227 +230 @@
                        (request-restarter cont))
           (if (and (uri-host (request-uri (current-request))) (pair? path))
-              (process-entry "" path)
+              (let* ((host (uri-host (request-uri (current-request))))
+                     (handler (alist-ref host
+                                        (vhost-map)
+                                        (lambda (h _)
+                                          (if (not (regexp? h))
+                                              (string-match (regexp h #t) host)
+                                              (string-match h host))))))
+                (if handler
+                    (handler (lambda () (process-entry "" path)))
+                    ;; Is this ok?
+                    (send-status 404 "Not found" "Host not found")))
               ;; No host in the request? That's an error.
               (send-status 400 "Bad request"