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

directory redirect

Browse Source 
svn: r7075
This commit is contained in:
Jay McCarthy 2007-08-10 00:49:05 +00:00
parent 56394cf69f
commit 2991f2a44a
2 changed files with 4 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -12,11 +12,6 @@
[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
@ -51,8 +46,7 @@
r)
(output-file conn path method (path->mime-type path)
0 +inf.0)])])]
[(and (directory-exists? path)
(looks-like-directory? (url-path->string (url-path uri))))
[(and (directory-exists? path))
(let/ec esc
(for-each (lambda (dir-default)
(define full-name (build-path path dir-default))

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

@ -63,9 +63,9 @@
(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/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))))
(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>")
(test-exn "dir, not exists, get"
exn:dispatcher?
(lambda () (collect (dispatch #f a-dir) (req #t 'get empty))))