Merging defaults
svn: r6637
This commit is contained in:
parent
fad9c2210f
commit
a1bfdc696d
|
@ -5,8 +5,8 @@
|
|||
(lib "contract.ss"))
|
||||
(require "dispatch.ss"
|
||||
"../private/util.ss"
|
||||
"../private/mime-types.ss"
|
||||
"../private/request-structs.ss"
|
||||
"../private/response-structs.ss"
|
||||
"../private/response.ss")
|
||||
(provide/contract
|
||||
[interface-version dispatcher-interface-version?])
|
||||
|
@ -20,8 +20,7 @@
|
|||
(define interface-version 'v1)
|
||||
(define/kw (make #:key
|
||||
url->path
|
||||
; XXX Make the default a define from response.ss
|
||||
[path->mime-type (lambda (path) #"text/plain; charset=utf-8")]
|
||||
[path->mime-type (lambda (path) TEXT/HTML-MIME-TYPE)]
|
||||
[indices (list "index.html" "index.htm")])
|
||||
(lambda (conn req)
|
||||
(define uri (request-uri req))
|
||||
|
|
|
@ -224,7 +224,7 @@ that calls a different dispatcher based upon the host requested.
|
|||
It defines a dispatcher construction procedure:
|
||||
|
||||
@defproc[(make [#:url->path url->path url->path?]
|
||||
[#:path->mime-type path->mime-type (path? . -> . bytes?) (lambda (path) #"text/plain; charset=utf-8")]
|
||||
[#:path->mime-type path->mime-type (path? . -> . bytes?) (lambda (path) TEXT/HTML-MIME-TYPE)]
|
||||
[#:indices indices (listof string?) (list "index.html" "index.htm")])
|
||||
dispatcher?]{
|
||||
Uses @scheme[url->path] to extract a path from the URL in the request
|
||||
|
|
|
@ -2,7 +2,8 @@
|
|||
(require (lib "contract.ss")
|
||||
(lib "plt-match.ss")
|
||||
(lib "string.ss"))
|
||||
(require "util.ss")
|
||||
(require "util.ss"
|
||||
"response-structs.ss")
|
||||
(provide/contract
|
||||
[read-mime-types (path? . -> . hash-table?)]
|
||||
[make-path->mime-type (path? . -> . (path? . -> . bytes?))])
|
||||
|
@ -36,12 +37,11 @@
|
|||
;; 2. Assuming that 7-bit ASCII is correct for mime-type
|
||||
(define (make-path->mime-type a-path)
|
||||
(define MIME-TYPE-TABLE (read-mime-types a-path))
|
||||
(define DEFAULT-MIME-TYPE #"text/plain; charset=utf-8")
|
||||
(define file-suffix-regexp (byte-regexp #".*\\.([^\\.]*$)"))
|
||||
(lambda (path)
|
||||
(match (regexp-match file-suffix-regexp (path->bytes path))
|
||||
[(list path-bytes sffx)
|
||||
(hash-table-get MIME-TYPE-TABLE
|
||||
(lowercase-symbol! sffx)
|
||||
(lambda () DEFAULT-MIME-TYPE))]
|
||||
[_ DEFAULT-MIME-TYPE]))))
|
||||
(lambda () TEXT/HTML-MIME-TYPE))]
|
||||
[_ TEXT/HTML-MIME-TYPE]))))
|
|
@ -42,16 +42,16 @@
|
|||
|
||||
(test-equal? "file, exists, whole, get"
|
||||
(collect (dispatch #t tmp-file) (req #f 'get empty))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
|
||||
(test-equal? "file, exists, whole, head"
|
||||
(collect (dispatch #t tmp-file) (req #f 'head empty))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n")
|
||||
(test-equal? "file, exists, part, get"
|
||||
(collect (dispatch #t tmp-file) (req #f 'get (list (make-header #"Range" #"bytes=5-10"))))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 5\r\nContent-Range: bytes 5-10/81\r\n\r\n><head><ti")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 5\r\nContent-Range: bytes 5-10/81\r\n\r\n><head><ti")
|
||||
(test-equal? "file, exists, part, head"
|
||||
(collect (dispatch #t tmp-file) (req #f 'head (list (make-header #"Range" #"bytes=5-10"))))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 5\r\nContent-Range: bytes 5-10/81\r\n\r\n")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 5\r\nContent-Range: bytes 5-10/81\r\n\r\n")
|
||||
|
||||
(test-exn "path, non"
|
||||
exn:dispatcher?
|
||||
|
@ -59,10 +59,10 @@
|
|||
|
||||
(test-equal? "dir, exists, get"
|
||||
(collect (dispatch #t a-dir) (req #t 'get empty))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
|
||||
(test-equal? "dir, exists, head"
|
||||
(collect (dispatch #t a-dir) (req #t 'head empty))
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n")
|
||||
#"HTTP/1.1 206 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 81\r\nContent-Range: bytes 0-81/81\r\n\r\n")
|
||||
(test-exn "dir, not dir-url, get"
|
||||
exn:dispatcher?
|
||||
(lambda () (collect (dispatch #t a-dir) (req #f 'get empty))))
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
(module mime-types-test mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "file.ss")
|
||||
(lib "mime-types.ss" "web-server" "private"))
|
||||
(lib "mime-types.ss" "web-server" "private")
|
||||
(lib "response-structs.ss" "web-server" "private"))
|
||||
(provide mime-types-tests)
|
||||
|
||||
(define test-file (make-temporary-file))
|
||||
|
@ -27,7 +28,7 @@ END
|
|||
(check-not-false (read-mime-types test-file)))
|
||||
(test-case
|
||||
"Default mime-type given"
|
||||
(check-equal? ((make-path->mime-type test-file) (build-path "test.html")) #"text/plain; charset=utf-8"))
|
||||
(check-equal? ((make-path->mime-type test-file) (build-path "test.html")) TEXT/HTML-MIME-TYPE))
|
||||
(test-case
|
||||
"MIME type resolves (single in file)"
|
||||
(check-equal? ((make-path->mime-type test-file) (build-path "test.mp4")) #"video/mp4"))
|
||||
|
|
Loading…
Reference in New Issue
Block a user