1 module Network.HTTP.Lucu.StaticFile
2 ( staticFile -- FilePath -> ResourceDef
3 , handleStaticFile -- FilePath -> Resource ()
5 , staticDir -- FilePath -> ResourceDef
6 , handleStaticDir -- FilePath -> Resource ()
11 import Control.Monad.Trans
12 import qualified Data.ByteString.Lazy.Char8 as B
13 import Data.ByteString.Lazy.Char8 (ByteString)
14 import Network.HTTP.Lucu.Abortion
15 import Network.HTTP.Lucu.Config
16 import Network.HTTP.Lucu.ETag
17 import Network.HTTP.Lucu.MIMEType.Guess
18 import Network.HTTP.Lucu.Resource
19 import Network.HTTP.Lucu.Resource.Tree
20 import Network.HTTP.Lucu.Response
21 import Network.HTTP.Lucu.Utils
22 import System.Directory
23 import System.Posix.Files
27 staticFile :: FilePath -> ResourceDef
30 resUsesNativeThread = False
32 , resGet = Just $ handleStaticFile path
40 handleStaticFile :: FilePath -> Resource ()
42 = do isFile <- liftIO $ doesFileExist path
44 -- 存在はした。讀めるかどうかは知らない。
45 do readable <- liftIO $ fileAccess path True False False
48 $ abort Forbidden [] Nothing
51 tag <- liftIO $ generateETagFromFile path
52 lastMod <- liftIO $ getModificationTime path
53 foundEntity tag lastMod
57 case guessTypeByFileName (cnfExtToMIMEType conf) path of
59 Just mime -> setContentType mime
62 (liftIO $ B.readFile path) >>= outputBS
64 do isDir <- liftIO $ doesDirectoryExist path
66 abort Forbidden [] Nothing
72 generateETagFromFile :: FilePath -> IO ETag
73 generateETagFromFile path
74 = do stat <- getFileStatus path
75 let inode = fromEnum $ fileID stat
76 size = fromEnum $ fileSize stat
77 lastmod = fromEnum $ modificationTime stat
78 return $ strongETag $ printf "%x-%x-%x" inode size lastmod
81 staticDir :: FilePath -> ResourceDef
84 resUsesNativeThread = False
86 , resGet = Just $ handleStaticDir path
94 handleStaticDir :: FilePath -> Resource ()
95 handleStaticDir basePath
96 = do extraPath <- getPathInfo
97 securityCheck extraPath
98 let path = basePath ++ "/" ++ joinWith "/" extraPath
100 handleStaticFile path
102 securityCheck :: Monad m => [String] -> m ()
103 securityCheck pathElems
104 = when (any (== "..") pathElems) $ fail ("security error: "
105 ++ joinWith "/" pathElems)