Changeset 12035 in project


Ignore:
Timestamp:
09/29/08 21:55:49 (12 years ago)
Author:
sjamaan
Message:

Fix some small inconsistencies, add vhost support

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/spiffy/trunk/spiffy.scm

    r12025 r12035  
    3939  (start-server with-headers send-status send-static-file
    4040   current-request current-response current-file current-pathinfo
    41    root-path server-port index-files mime-type-map default-mime-type default-host
     41   root-path server-port index-files mime-type-map default-mime-type
     42   file-extension-handlers default-host vhost-map
    4243   handle-directory handle-not-found
    4344   restart-request)
    4445
    4546(import chicken scheme extras ports files data-structures)
    46 (require-extension srfi-1 srfi-18 posix tcp
     47(require-extension srfi-1 srfi-18 posix tcp regex
    4748                   intarweb uri-generic sendfile matchable)
    4849
     
    5960(define root-path        (make-parameter "./web"))
    6061(define server-port      (make-parameter 8080))
    61 (define index-files      (make-parameter '("index.html" "index.htm")))
     62(define index-files      (make-parameter '("index.html" "index.xhtml")))
    6263(define mime-type-map
    6364  (make-parameter
     
    7576     ("svg" . image/svg+xml)
    7677     ("bmp" . image/bmp)
    77      ("txt" . text/plain)
    78      ("htm" . text/html))))
     78     ("txt" . text/plain))))
    7979(define default-mime-type (make-parameter 'application/octet-stream))
     80(define file-extension-handlers (make-parameter '()))
    8081(define default-host (make-parameter "localhost")) ;; XXX Can we do without?
    81 (define file-extension-handlers (make-parameter '()))
     82(define vhost-map (make-parameter `((".*" . ,(lambda (continue) (continue))))))
    8283
    8384;;; Custom handlers
     
    9798(define handle-not-found
    9899  (make-parameter
    99    (lambda ()
     100   (lambda (path)
    100101     (send-status 404 "Not found"
    101102                  "The resource you requested could not be found"))))
     
    181182                             (cdr remaining-path)))))
    182183     ((file-exists? path)
    183       ((handle-file) current-path))
    184      (else ((handle-not-found))))))
     184      (parameterize ((current-pathinfo remaining-path)
     185                     (current-file path))
     186        ((handle-file) current-path)))
     187     (else ((handle-not-found) current-path)))))
    185188
    186189;; Determine the vhost and port to use. This follows RFC 2616, section 5.2:
     
    227230                       (request-restarter cont))
    228231          (if (and (uri-host (request-uri (current-request))) (pair? path))
    229               (process-entry "" path)
     232              (let* ((host (uri-host (request-uri (current-request))))
     233                     (handler (alist-ref host
     234                                        (vhost-map)
     235                                        (lambda (h _)
     236                                          (if (not (regexp? h))
     237                                              (string-match (regexp h #t) host)
     238                                              (string-match h host))))))
     239                (if handler
     240                    (handler (lambda () (process-entry "" path)))
     241                    ;; Is this ok?
     242                    (send-status 404 "Not found" "Host not found")))
    230243              ;; No host in the request? That's an error.
    231244              (send-status 400 "Bad request"
Note: See TracChangeset for help on using the changeset viewer.