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 Network.HTTP.Lucu.Abortion
17 import Network.HTTP.Lucu.Config
18 import Network.HTTP.Lucu.ETag
19 import Network.HTTP.Lucu.Format
20 import Network.HTTP.Lucu.MIMEType.Guess
21 import Network.HTTP.Lucu.Resource
22 import Network.HTTP.Lucu.Resource.Tree
23 import Network.HTTP.Lucu.Response
24 import Network.HTTP.Lucu.Utils
25 import System.Directory
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 isFile <- liftIO $ doesFileExist path
58 -- 存在はした。讀めるかどうかは知らない。
59 do readable <- liftIO $ fileAccess path True False False
62 $ abort Forbidden [] Nothing
65 tag <- liftIO $ generateETagFromFile path
66 lastMod <- liftIO $ getModificationTime path
67 foundEntity tag lastMod
71 case guessTypeByFileName (cnfExtToMIMEType conf) path of
73 Just mime -> setContentType mime
76 (liftIO $ B.readFile path) >>= outputBS
78 do isDir <- liftIO $ doesDirectoryExist path
80 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)