1 -- | Handling static files on the filesystem.
2 module Network.HTTP.Lucu.StaticFile
14 import Control.Monad.Trans
15 import qualified Data.ByteString.Lazy.Char8 as B
16 import Data.Time.Clock.POSIX
17 import Network.HTTP.Lucu.Abortion
18 import Network.HTTP.Lucu.Config
19 import Network.HTTP.Lucu.ETag
20 import Network.HTTP.Lucu.Format
21 import Network.HTTP.Lucu.MIMEType.Guess
22 import Network.HTTP.Lucu.Resource
23 import Network.HTTP.Lucu.Resource.Tree
24 import Network.HTTP.Lucu.Response
25 import Network.HTTP.Lucu.Utils
26 import System.FilePath.Posix
27 import System.Posix.Files
30 -- | @'staticFile' fpath@ is a
31 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
32 -- at @fpath@ on the filesystem.
33 staticFile :: FilePath -> ResourceDef
36 resUsesNativeThread = False
38 , resGet = Just $! handleStaticFile path
45 -- | Computation of @'handleStaticFile' fpath@ serves the file at
46 -- @fpath@ on the filesystem. The
47 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
48 -- Request/ state before the computation. It will be in the /Done/
49 -- state after the computation.
51 -- If you just want to place a static file on the
52 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
53 -- 'staticFile' instead of this.
54 handleStaticFile :: FilePath -> Resource ()
57 do exists <- liftIO $ fileExist path
59 -- 存在はした。讀めるかどうかは知らない。
60 do stat <- liftIO $ getFileStatus path
61 if isRegularFile stat then
62 do readable <- liftIO $ fileAccess path True False False
65 $ abort Forbidden [] Nothing
67 tag <- liftIO $ generateETagFromFile path
68 let lastMod = posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
69 foundEntity tag lastMod
73 case guessTypeByFileName (cnfExtToMIMEType conf) path of
75 Just mime -> setContentType mime
78 liftIO (B.readFile path) >>= outputLBS
80 abort Forbidden [] Nothing
85 -- |Computation of @'generateETagFromFile' fpath@ generates a strong
86 -- entity tag from a file. The file doesn't necessarily have to be a
87 -- regular file; it may be a FIFO or a device file. The tag is made of
88 -- inode ID, size and modification time.
90 -- Note that the tag is not strictly strong because the file could be
91 -- modified twice at a second without changing inode ID or size, but
92 -- it's not really possible to generate a strict strong ETag from a
93 -- file since we don't want to simply grab the entire file and use it
94 -- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
95 -- increase strictness, but it's too inefficient if the file is really
96 -- large (say, 1 TiB).
97 generateETagFromFile :: FilePath -> IO ETag
98 generateETagFromFile path
100 do stat <- getFileStatus path
101 let inode = fromEnum $! fileID stat
102 size = fromEnum $! fileSize stat
103 lastMod = fromEnum $! modificationTime stat
104 tag = fmtHex False 0 inode
108 fmtHex False 0 lastMod
109 return $! strongETag tag
111 -- | @'staticDir' dir@ is a
112 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which maps all files
113 -- in @dir@ and its subdirectories on the filesystem to the
114 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
115 staticDir :: FilePath -> ResourceDef
118 resUsesNativeThread = False
120 , resGet = Just $! handleStaticDir path
124 , resDelete = Nothing
127 -- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
128 -- and its subdirectories on the filesystem to the
129 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The
130 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
131 -- Request/ state before the computation. It will be in the /Done/
132 -- state after the computation.
134 -- If you just want to place a static directory tree on the
135 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
136 -- 'staticDir' instead of this.
137 handleStaticDir :: FilePath -> Resource ()
138 handleStaticDir !basePath
139 = do extraPath <- getPathInfo
140 securityCheck extraPath
141 let path = basePath </> joinPath extraPath
143 handleStaticFile path
145 securityCheck :: Monad m => [String] -> m ()
146 securityCheck !pathElems
147 = when (any (== "..") pathElems) $ fail ("security error: "
148 ++ joinWith "/" pathElems)
149 -- TODO: implement directory listing.