From ceee79e07fbe4842040f1b573998e972b60e3eed Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Sun, 5 Apr 2009 13:50:02 +0000
Subject: [PATCH] mjadud bug

svn: r14426
---
 .../web-server/dispatchers/dispatch-files-test.ss   | 13 +++++++++++++
 collects/web-server/dispatchers/dispatch-files.ss   |  3 ++-
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/collects/tests/web-server/dispatchers/dispatch-files-test.ss b/collects/tests/web-server/dispatchers/dispatch-files-test.ss
index e4080c4e37..d1c825d2a7 100644
--- a/collects/tests/web-server/dispatchers/dispatch-files-test.ss
+++ b/collects/tests/web-server/dispatchers/dispatch-files-test.ss
@@ -11,6 +11,8 @@
          web-server/dispatchers/dispatch
          (prefix-in files: web-server/dispatchers/dispatch-files)
          "../util.ss")
+(require/expose web-server/dispatchers/dispatch-files
+                (looks-like-directory?))
 (provide dispatch-files-tests)
 
 (define tmp-file (make-temporary-file))
@@ -42,6 +44,14 @@
   (test-suite
    "Files"
    
+   (local [(define (yes s) (test-not-false s (looks-like-directory? s)))
+           (define (no s) (test-false s (looks-like-directory? s)))]
+   (test-suite
+    "Looks like directory"
+
+    (no "") (no "foo") (no "/foo") (no "/foo/bar")
+    (yes "/") (yes "/foo/") (yes "foo/" )(yes "/bar/zog/trog/")))
+   
    (test-case
     "read-range-header: missing and badly formed headers"
     (check-false (files:read-range-header (list (make-header #"Ranges" #"bytes=1-10"))) "check 1")
@@ -109,3 +119,6 @@
    (test-exn "dir, not exists, head"
              exn:dispatcher?
              (lambda () (collect (dispatch #f a-dir) (req #t #"HEAD" empty))))))
+
+#;(require (planet schematics/schemeunit:3/text-ui))
+#;(run-tests dispatch-files-tests)
\ No newline at end of file
diff --git a/collects/web-server/dispatchers/dispatch-files.ss b/collects/web-server/dispatchers/dispatch-files.ss
index f73631a9be..9ff1d8ac41 100644
--- a/collects/web-server/dispatchers/dispatch-files.ss
+++ b/collects/web-server/dispatchers/dispatch-files.ss
@@ -22,7 +22,8 @@
 ;; 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)))))
+  (and (regexp-match #rx"/$" path)
+       #t))
 
 (define interface-version 'v1)