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