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

up

Browse Source 
svn: r7088
This commit is contained in:
Jay McCarthy 2007-08-13 21:13:45 +00:00
parent 4f0479a688
commit e155deea8e
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,11 +7,17 @@
"../private/util.ss"
"../private/request-structs.ss"
"../private/response-structs.ss"
"../servlet/helpers.ss"
"../private/response.ss")
(provide/contract
[interface-version dispatcher-interface-version?])
(provide make)
;; looks-like-directory : str -> bool
;; to determine if is url style path looks like it refers to a directory
(define (looks-like-directory? path)
(eq? #\/ (string-ref path (sub1 (string-length path)))))
(define interface-version 'v1)
(define/kw (make #:key
url->path
@ -46,14 +52,18 @@
r)
(output-file conn path method (path->mime-type path)
0 +inf.0)])])]
[(and (directory-exists? path))
(let/ec esc
(for-each (lambda (dir-default)
(define full-name (build-path path dir-default))
(when (file-exists? full-name)
(esc (output-file conn full-name method (path->mime-type full-name)
0 +inf.0))))
indices)
(next-dispatcher))]
[(directory-exists? path)
(if (looks-like-directory? (url-path->string (url-path uri)))
(let/ec esc
(for-each (lambda (dir-default)
(define full-name (build-path path dir-default))
(when (file-exists? full-name)
(esc (output-file conn full-name method (path->mime-type full-name)
0 +inf.0))))
indices)
(next-dispatcher))
(output-response
conn
(redirect-to (string-append (url-path->string (url-path uri)) "/"))))]
[else
(next-dispatcher)]))))

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

@ -65,7 +65,7 @@
#"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? "dir, not dir-url, get"
(collect (dispatch #t a-dir) (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/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>")
#"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\nLocation: /foo/\r\n\r\n")
(test-exn "dir, not exists, get"
exn:dispatcher?
(lambda () (collect (dispatch #f a-dir) (req #t 'get empty))))