Changeset 18361 in project
- Timestamp:
- 06/06/10 15:07:22 (11 years ago)
- Location:
- release/4/spiffy/trunk
- Files:
-
- 2 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/spiffy/trunk/spiffy.scm
r18092 r18361 332 332 ;; would be seen as the file component in the path and get replaced. 333 333 (define (redirect-directory-root path) 334 (let ((new-path ( uri-path (uri-reference (string-append path "/")))))334 (let ((new-path (cons '/ (string-split (string-append path "/") "/" #t)))) 335 335 (with-headers `((location ,(update-uri (server-root-uri) 336 336 path: new-path))) -
release/4/spiffy/trunk/tests/run.scm
r18086 r18361 63 63 (define index-subdir (with-input-from-file "testweb/subdir/index.html" read-string)) 64 64 (define index-subsubdir (with-input-from-file "testweb/subdir/subsubdir/index.html" read-string)) 65 (define index-subdir-with-space (with-input-from-file "testweb/subdir with space/index.html" read-string)) 66 65 67 66 68 (test-begin "static file serving") … … 82 84 83 85 (test-begin "path normalization") 84 (test "index page redir" '(/ "subdir " "") (uri-path (header-value 'location (fetch-file "/subdir" "testhost" get-headers: #t))))85 (test "index page redir preserves GET args" '((foo . "bar")) (uri-query (header-value 'location (fetch-file "/subdir ?foo=bar" "testhost" get-headers: #t))))86 (test "index page redir status" 301 (car (fetch-file "/subdir " "testhost")))87 (test "index page" `(200 ,index-subdir ) (fetch-file "/subdir/" "testhost"))86 (test "index page redir" '(/ "subdir with space" "") (uri-path (header-value 'location (fetch-file "/subdir%20with%20space" "testhost" get-headers: #t)))) 87 (test "index page redir preserves GET args" '((foo . "bar")) (uri-query (header-value 'location (fetch-file "/subdir%20with%20space?foo=bar" "testhost" get-headers: #t)))) 88 (test "index page redir status" 301 (car (fetch-file "/subdir%20with%20space" "testhost"))) 89 (test "index page" `(200 ,index-subdir-with-space) (fetch-file "/subdir%20with%20space/" "testhost")) 88 90 (test "break out of webroot fails" `(200 ,index-subdir) (fetch-file "/subdir/../../subdir/" "testhost")) 89 91 (test "index page in subdir vhost" `(200 ,index-subdir) (fetch-file "/" "subdir-host"))
Note: See TracChangeset
for help on using the changeset viewer.