Changeset 18361 in project

Timestamp:

06/06/10 15:07:22 (11 years ago)

Author:

sjamaan

Message:

Fix #266

Location:

release/4/spiffy/trunk

Files:

• spiffy.scm (modified) (1 diff)
• tests/run.scm (modified) (2 diffs)
• tests/testweb/subdir with space (added)
• tests/testweb/subdir with space/index.html (added)

release/4/spiffy/trunk/spiffy.scm

@@ -332 +332 @@
 ;; would be seen as the file component in the path and get replaced.
 (define (redirect-directory-root path)
-  (let ((new-path (uri-path (uri-reference (string-append path "/")))))
+  (let ((new-path (cons '/ (string-split (string-append path "/") "/" #t))))
    (with-headers `((location ,(update-uri (server-root-uri)
                                           path: new-path)))

release/4/spiffy/trunk/tests/run.scm

@@ -63 +63 @@
 (define index-subdir (with-input-from-file "testweb/subdir/index.html" read-string))
 (define index-subsubdir (with-input-from-file "testweb/subdir/subsubdir/index.html" read-string))
+(define index-subdir-with-space (with-input-from-file "testweb/subdir with space/index.html" read-string))
+
 
 (test-begin "static file serving")
@@ -82 +84 @@
 
 (test-begin "path normalization")
-(test "index page redir" '(/ "subdir" "") (uri-path (header-value 'location (fetch-file "/subdir" "testhost" get-headers: #t))))
-(test "index page redir preserves GET args" '((foo . "bar")) (uri-query (header-value 'location (fetch-file "/subdir?foo=bar" "testhost" get-headers: #t))))
-(test "index page redir status" 301 (car (fetch-file "/subdir" "testhost")))
-(test "index page" `(200 ,index-subdir) (fetch-file "/subdir/" "testhost"))
+(test "index page redir" '(/ "subdir with space" "") (uri-path (header-value 'location (fetch-file "/subdir%20with%20space" "testhost" get-headers: #t))))
+(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))))
+(test "index page redir status" 301 (car (fetch-file "/subdir%20with%20space" "testhost")))
+(test "index page" `(200 ,index-subdir-with-space) (fetch-file "/subdir%20with%20space/" "testhost"))
 (test "break out of webroot fails" `(200 ,index-subdir) (fetch-file "/subdir/../../subdir/" "testhost"))
 (test "index page in subdir vhost" `(200 ,index-subdir) (fetch-file "/" "subdir-host"))