suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merging defaults

Browse Source 
svn: r6637
This commit is contained in:
Jay McCarthy 2007-06-13 19:08:52 +00:00
parent fad9c2210f
commit a1bfdc696d
5 changed files with 16 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/web-server/dispatchers/dispatch-files.ss
View File

@ -5,8 +5,8 @@
(lib "contract.ss")) (lib "contract.ss"))
(require "dispatch.ss" (require "dispatch.ss"
"../private/util.ss" "../private/util.ss"
"../private/mime-types.ss"
"../private/request-structs.ss" "../private/request-structs.ss"
"../private/response-structs.ss"
"../private/response.ss") "../private/response.ss")
(provide/contract (provide/contract
[interface-version dispatcher-interface-version?]) [interface-version dispatcher-interface-version?])
@ -20,8 +20,7 @@
(define interface-version 'v1) (define interface-version 'v1)
(define/kw (make #:key (define/kw (make #:key
url->path url->path
; XXX Make the default a define from response.ss [path->mime-type (lambda (path) TEXT/HTML-MIME-TYPE)]
[path->mime-type (lambda (path) #"text/plain; charset=utf-8")]
[indices (list "index.html" "index.htm")]) [indices (list "index.html" "index.htm")])
(lambda (conn req) (lambda (conn req)
(define uri (request-uri req)) (define uri (request-uri req))

2
collects/web-server/docs/reference/dispatchers.scrbl
View File

@ -224,7 +224,7 @@ that calls a different dispatcher based upon the host requested.
It defines a dispatcher construction procedure: It defines a dispatcher construction procedure:
@defproc[(make [#:url->path url->path url->path?] @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")]) [#:indices indices (listof string?) (list "index.html" "index.htm")])
dispatcher?]{ dispatcher?]{
Uses @scheme[url->path] to extract a path from the URL in the request Uses @scheme[url->path] to extract a path from the URL in the request

8
collects/web-server/private/mime-types.ss
View File

@ -2,7 +2,8 @@
(require (lib "contract.ss") (require (lib "contract.ss")
(lib "plt-match.ss") (lib "plt-match.ss")
(lib "string.ss")) (lib "string.ss"))
(require "util.ss") (require "util.ss"
"response-structs.ss")
(provide/contract (provide/contract
[read-mime-types (path? . -> . hash-table?)] [read-mime-types (path? . -> . hash-table?)]
[make-path->mime-type (path? . -> . (path? . -> . bytes?))]) [make-path->mime-type (path? . -> . (path? . -> . bytes?))])
@ -36,12 +37,11 @@
;; 2. Assuming that 7-bit ASCII is correct for mime-type ;; 2. Assuming that 7-bit ASCII is correct for mime-type
(define (make-path->mime-type a-path) (define (make-path->mime-type a-path)
(define MIME-TYPE-TABLE (read-mime-types 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 #".*\\.([^\\.]*$)")) (define file-suffix-regexp (byte-regexp #".*\\.([^\\.]*$)"))
(lambda (path) (lambda (path)
(match (regexp-match file-suffix-regexp (path->bytes path)) (match (regexp-match file-suffix-regexp (path->bytes path))
[(list path-bytes sffx) [(list path-bytes sffx)
(hash-table-get MIME-TYPE-TABLE (hash-table-get MIME-TYPE-TABLE
(lowercase-symbol! sffx) (lowercase-symbol! sffx)
(lambda () DEFAULT-MIME-TYPE))] (lambda () TEXT/HTML-MIME-TYPE))]
[_ DEFAULT-MIME-TYPE])))) [_ TEXT/HTML-MIME-TYPE]))))

12
collects/web-server/tests/dispatchers/dispatch-files-test.ss
View File

@ -42,16 +42,16 @@
(test-equal? "file, exists, whole, get" (test-equal? "file, exists, whole, get"
(collect (dispatch #t tmp-file) (req #f 'get empty)) (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" (test-equal? "file, exists, whole, head"
(collect (dispatch #t tmp-file) (req #f 'head empty)) (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" (test-equal? "file, exists, part, get"
(collect (dispatch #t tmp-file) (req #f 'get (list (make-header #"Range" #"bytes=5-10")))) (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" (test-equal? "file, exists, part, head"
(collect (dispatch #t tmp-file) (req #f 'head (list (make-header #"Range" #"bytes=5-10")))) (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" (test-exn "path, non"
exn:dispatcher? exn:dispatcher?
@ -59,10 +59,10 @@
(test-equal? "dir, exists, get" (test-equal? "dir, exists, get"
(collect (dispatch #t a-dir) (req #t 'get empty)) (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" (test-equal? "dir, exists, head"
(collect (dispatch #t a-dir) (req #t 'head empty)) (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" (test-exn "dir, not dir-url, get"
exn:dispatcher? exn:dispatcher?
(lambda () (collect (dispatch #t a-dir) (req #f 'get empty)))) (lambda () (collect (dispatch #t a-dir) (req #f 'get empty))))

5
collects/web-server/tests/private/mime-types-test.ss
View File

@ -1,7 +1,8 @@
(module mime-types-test mzscheme (module mime-types-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(lib "file.ss") (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) (provide mime-types-tests)
(define test-file (make-temporary-file)) (define test-file (make-temporary-file))
@ -27,7 +28,7 @@ END
(check-not-false (read-mime-types test-file))) (check-not-false (read-mime-types test-file)))
(test-case (test-case
"Default mime-type given" "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 (test-case
"MIME type resolves (single in file)" "MIME type resolves (single in file)"
(check-equal? ((make-path->mime-type test-file) (build-path "test.mp4")) #"video/mp4")) (check-equal? ((make-path->mime-type test-file) (build-path "test.mp4")) #"video/mp4"))