@@ -153,9 +153,10 @@ stripTrailingSlash "" = ""
153stripTrailingSlash (x:xs) = x : stripTrailingSlash xs
153stripTrailingSlash (x:xs) = x : stripTrailingSlash xs
155checkPieces :: FilePath -- ^ static file prefix
155checkPieces :: FilePath -- ^ static file prefix
156+ -> [FilePath] -- ^ List of default index files. Cannot contain slashes.
156 -> [String] -- ^ parsed request
157 -> [String] -- ^ parsed request
157 -> IO CheckPieces
158 -> IO CheckPieces
158−checkPieces prefix pieces
159+checkPieces prefix indices pieces
159 | any unsafe pieces = return Forbidden
160 | any unsafe pieces = return Forbidden
160 | anyButLast null pieces =
161 | anyButLast null pieces =
161 return $ Redirect $ filterButLast (not . null) pieces
162 return $ Redirect $ filterButLast (not . null) pieces
@@ -173,10 +174,27 @@ checkPieces prefix pieces
173 (True, False) -> return $ Redirect $ init pieces
174 (True, False) -> return $ Redirect $ init pieces
174 (False, _) -> do
175 (False, _) -> do
175 de <- doesDirectoryExist fp
176 de <- doesDirectoryExist fp
179+ x <- checkIndices fp indices
181+ Just index -> return $ Redirect $ setLast pieces index
176− case (de, isFolder) of
183+ if isFolder
177− (True, True) -> return $ DirectoryResponse fp
184+ then return $ DirectoryResponse fp
178− (True, False) -> return $ Redirect $ pieces ++ [""]
185+ else return $ Redirect $ pieces ++ [""]
179− (False, _) -> return NotFound
186+ else return NotFound
189+ setLast [""] x = [x]
190+ setLast (a:b) x = a : setLast b x
191+ checkIndices _ [] = return Nothing
192+ checkIndices fp (i:is) = do
193+ let fp' = fp ++ '/' : i
194+ fe <- doesFileExist fp'
196+ then return $ Just i
197+ else checkIndices fp is
181type Listing = FilePath -> IO L.ByteString
199type Listing = FilePath -> IO L.ByteString
@@ -190,7 +208,7 @@ data StaticSettings = StaticSettings
190staticApp :: StaticSettings -> W.Application
208staticApp :: StaticSettings -> W.Application
191staticApp (StaticSettings folder indices mlisting getmime) req = liftIO $ do
209staticApp (StaticSettings folder indices mlisting getmime) req = liftIO $ do
192 let pieces = decodePathInfo $ S8.unpack $ W.pathInfo req
210 let pieces = decodePathInfo $ S8.unpack $ W.pathInfo req
193− cp <- checkPieces folder pieces
211+ cp <- checkPieces folder indices pieces
194 case cp of
212 case cp of
195 Redirect pieces' -> do
213 Redirect pieces' -> do
196 let loc = S8.pack $ '/' : encodePathInfo pieces' []
214 let loc = S8.pack $ '/' : encodePathInfo pieces' []
@@ -204,29 +222,20 @@ staticApp (StaticSettings folder indices mlisting getmime) req = liftIO $ do
204 NotFound -> return $ W.responseLBS W.status404
222 NotFound -> return $ W.responseLBS W.status404
205 [ ("Content-Type", "text/plain")
223 [ ("Content-Type", "text/plain")
206 ] "File not found"
224 ] "File not found"
207− FileResponse fp -> sendfile fp
225+ FileResponse fp -> do
226+ mimetype <- getmime fp
227+ filesize <- fileSize `fmap` getFileStatus fp
228+ return $ W.ResponseFile W.status200
229+ [ ("Content-Type", mimetype)
230+ , ("Content-Length", S8.pack $ show filesize)
208− DirectoryResponse fp -> sendfolder fp indices
232+ DirectoryResponse fp ->
210− sendfolder fp (i:is) = do
211− let fp' = fp ++ '/' : i
212− fe <- doesFileExist fp'
215− else sendfolder fp is
217− case mlisting of
233+ case mlisting of
218− Just listing -> do
234+ Just listing -> do
219− lbs <- listing fp
235+ lbs <- listing fp
220− return $ W.responseLBS W.status200
236+ return $ W.responseLBS W.status200
221− [ ("Content-Type", "text/html")
237+ [ ("Content-Type", "text/html")
223− Nothing -> return $ W.responseLBS W.status403
239+ Nothing -> return $ W.responseLBS W.status403
224− [ ("Content-Type", "text/plain")
240+ [ ("Content-Type", "text/plain")
225− ] "Directory listings disabled"
241+ ] "Directory listings disabled"
227− mimetype <- getmime fp
228− filesize <- fileSize `fmap` getFileStatus fp
229− return $ W.ResponseFile W.status200
230− [ ("Content-Type", mimetype)
231− , ("Content-Length", S8.pack $ show filesize)