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