on master help sign in
Fixed slash-after-dot in cleanpath
commit8793df87fdd9b49f37c1ebd1f39aad65b54feb74 authorMichael Snoyman <michael@snoyman.com> dateSun 16 May 2010, 07:15 (16 years ago) parent0b6433a
2 files changed+19−12
Network/Wai/Middleware/CleanPath.hs+9−1 test/sample.hs+10−11
Network/Wai/Middleware/CleanPath.hs+9−1
@@ -34,7 +34,7 @@ emptyEnum = Enumerator $ \_ -> return . Right
3434-- * There are any doubled slashes.
3535splitPath :: B.ByteString -> Either B.ByteString [String]
3636splitPath s =
37− let corrected = B.pack $ ats $ rds $ B.unpack s
37+ let corrected = B.pack $ rts $ ats $ rds $ B.unpack s
3838 in if corrected == s
3939 then Right $ map (unEscapeString . B.unpack)
4040 $ filter (not . B.null)
@@ -57,6 +57,14 @@ ats s =
5757 then s
5858 else s ++ "/"
5959
60+-- | Remove a trailing slash if the last piece has a period.
61+rts :: String -> String
62+rts [] = []
63+rts s =
64+ if last s == '/' && dbs (tail $ reverse s)
65+ then init s
66+ else s
67+
6068-- | Is there a period before a slash here?
6169dbs :: String -> Bool
6270dbs ('/':_) = False
test/sample.hs+10−11
@@ -4,23 +4,22 @@ import Network.Wai
44import Network.Wai.Enumerator
55import Network.Wai.Middleware.Gzip
66import Network.Wai.Middleware.Jsonp
7+import Network.Wai.Middleware.CleanPath
78import Network.Wai.Handler.SimpleServer
89
9−app :: Application
10−app req =
11− case unpack $ pathInfo req of
12− "/" -> return $ Response Status200 [] $ Right $ fromLBS
13− $ fromChunks $ flip map [1..10000] $ \i -> pack $
10+app :: [String] -> Application
11+app [] _ = return $ Response Status200 [] $ Right $ fromLBS
12+ $ fromChunks $ flip map [1..10000] $ \i -> pack $
1413 concat
1514 [ "<p>Just this same paragraph again. "
1615 , show i
1716 , "</p>"
1817 ]
19− "/test.html" -> return $ Response Status200 [] $ Left "test.html"
20− "/json" -> return $ Response Status200
21− [(ContentType, pack "application/json")]
22− $ Left "json"
23− _ -> return $ Response Status404 [] $ Left "../LICENSE"
18+app ["test.html"] _ = return $ Response Status200 [] $ Left "test.html"
19+app ["json"] _ =return $ Response Status200
20+ [(ContentType, pack "application/json")]
21+ $ Left "json"
22+app _ _ = return $ Response Status404 [] $ Left "../LICENSE"
2423
2524main :: IO ()
26−main = run 3000 $ jsonp $ gzip app
25+main = run 3000 $ jsonp $ gzip $ cleanPath app