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.Posix.Files
29 -- | @'staticFile' fpath@ is a
30 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
31 -- at @fpath@ on the filesystem.
32 staticFile :: FilePath -> ResourceDef
35 resUsesNativeThread = False
37 , resGet = Just $! handleStaticFile path
44 -- | Computation of @'handleStaticFile' fpath@ serves the file at
45 -- @fpath@ on the filesystem. The
46 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
47 -- Request/ state before the computation. It will be in the /Done/
48 -- state after the computation.
50 -- If you just want to place a static file on the
51 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
52 -- 'staticFile' instead of this.
53 handleStaticFile :: FilePath -> Resource ()
56 do exists <- liftIO $ fileExist path
58 -- 存在はした。讀めるかどうかは知らない。
59 do stat <- liftIO $ getFileStatus path
60 if isRegularFile stat then
61 do readable <- liftIO $ fileAccess path True False False
64 $ abort Forbidden [] Nothing
66 tag <- liftIO $ generateETagFromFile path
67 lastMod <- return $ posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
68 foundEntity tag lastMod
72 case guessTypeByFileName (cnfExtToMIMEType conf) path of
74 Just mime -> setContentType mime
77 (liftIO $ B.readFile path) >>= outputLBS
79 abort Forbidden [] Nothing
84 -- |Computation of @'generateETagFromFile' fpath@ generates a strong
85 -- entity tag from a file. The file doesn't necessarily have to be a
86 -- regular file; it may be a FIFO or a device file. The tag is made of
87 -- inode ID, size and modification time.
89 -- Note that the tag is not strictly strong because the file could be
90 -- modified twice at a second without changing inode ID or size, but
91 -- it's not really possible to generate a strict strong ETag from a
92 -- file since we don't want to simply grab the entire file and use it
93 -- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
94 -- increase strictness, but it's too inefficient if the file is really
95 -- large (say, 1 TiB).
96 generateETagFromFile :: FilePath -> IO ETag
97 generateETagFromFile path
99 do stat <- getFileStatus path
100 let inode = fromEnum $! fileID stat
101 size = fromEnum $! fileSize stat
102 lastMod = fromEnum $! modificationTime stat
103 tag = fmtHex False 0 inode
107 fmtHex False 0 lastMod
108 return $! strongETag tag
110 -- | @'staticDir' dir@ is a
111 -- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which maps all files
112 -- in @dir@ and its subdirectories on the filesystem to the
113 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
114 staticDir :: FilePath -> ResourceDef
117 resUsesNativeThread = False
119 , resGet = Just $! handleStaticDir path
123 , resDelete = Nothing
126 -- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
127 -- and its subdirectories on the filesystem to the
128 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The
129 -- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
130 -- Request/ state before the computation. It will be in the /Done/
131 -- state after the computation.
133 -- If you just want to place a static directory tree on the
134 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
135 -- 'staticDir' instead of this.
136 handleStaticDir :: FilePath -> Resource ()
137 handleStaticDir basePath
139 do extraPath <- getPathInfo
140 securityCheck extraPath
141 let path = basePath ++ "/" ++ joinWith "/" extraPath
143 handleStaticFile path
145 securityCheck :: Monad m => [String] -> m ()
146 securityCheck pathElems
148 when (any (== "..") pathElems) $ fail ("security error: "
149 ++ joinWith "/" pathElems)