5 -- | Handling static files on the filesystem.
6 module Network.HTTP.Lucu.StaticFile
13 , generateETagFromFile
16 import qualified Blaze.ByteString.Builder.ByteString as BB
17 import qualified Blaze.Text.Int as BT
19 import Control.Monad.Unicode
20 import Control.Monad.Trans
21 import qualified Data.Ascii as A
22 import qualified Data.ByteString.Lazy.Char8 as B
23 import Data.Monoid.Unicode
24 import qualified Data.Text as T
25 import Data.Time.Clock.POSIX
26 import Network.HTTP.Lucu.Abortion
27 import Network.HTTP.Lucu.Config
28 import Network.HTTP.Lucu.ETag
29 import Network.HTTP.Lucu.MIMEType.Guess
30 import Network.HTTP.Lucu.Resource
31 import Network.HTTP.Lucu.Resource.Tree
32 import Network.HTTP.Lucu.Response
33 import Prelude.Unicode
34 import System.FilePath
35 import System.Posix.Files
37 -- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
38 -- @fpath@ on the filesystem.
39 staticFile ∷ FilePath → ResourceDef
42 resUsesNativeThread = False
44 , resGet = Just $ handleStaticFile path
51 -- | Computation of @'handleStaticFile' fpath@ serves the file at
52 -- @fpath@ on the filesystem. The 'Resource' must be in the /Examining
53 -- Request/ state before the computation. It will be in the /Done/
54 -- state after the computation.
56 -- If you just want to place a static file on the 'ResTree', you had
57 -- better use 'staticFile' rather than this.
58 handleStaticFile ∷ FilePath → Resource ()
60 = do exists ← liftIO $ fileExist path
62 -- 存在はした。讀めるかどうかは知らない。
63 do stat ← liftIO $ getFileStatus path
64 if isRegularFile stat then
65 do readable ← liftIO $ fileAccess path True False False
68 $ abort Forbidden [] Nothing
70 tag ← liftIO $ generateETagFromFile path
71 let lastMod = posixSecondsToUTCTime
74 $ modificationTime stat
75 foundEntity tag lastMod
79 case guessTypeByFileName (cnfExtToMIMEType conf) path of
81 Just mime → setContentType mime
84 liftIO (B.readFile path) ≫= output
86 abort Forbidden [] Nothing
91 -- |Computation of @'generateETagFromFile' fpath@ generates a strong
92 -- entity tag from a file. The file doesn't necessarily have to be a
93 -- regular file; it may be a FIFO or a device file. The tag is made of
94 -- inode ID, size and modification time.
96 -- Note that the tag is not strictly strong because the file could be
97 -- modified twice at a second without changing inode ID or size, but
98 -- it's not really possible to generate a strict strong ETag from a
99 -- file since we don't want to simply grab the entire file and use it
100 -- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
101 -- increase strictness, but it's too inefficient if the file is really
102 -- large (say, 1 TiB).
103 generateETagFromFile ∷ FilePath → IO ETag
104 generateETagFromFile path
105 = do stat ← getFileStatus path
106 let inode = fileID stat
108 lastMod = fromEnum $ modificationTime stat
109 tag = A.fromAsciiBuilder
110 $ A.unsafeFromBuilder
112 ⊕ BB.fromByteString "-"
114 ⊕ BB.fromByteString "-"
115 ⊕ BT.integral lastMod
116 return $ strongETag tag
118 -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
119 -- @dir@ and its subdirectories on the filesystem to the 'ResTree'.
120 staticDir ∷ FilePath → ResourceDef
123 resUsesNativeThread = False
125 , resGet = Just $ handleStaticDir path
129 , resDelete = Nothing
132 -- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
133 -- and its subdirectories on the filesystem to the 'ResTree'. The
134 -- 'Resource' must be in the /Examining Request/ state before the
135 -- computation. It will be in the /Done/ state after the computation.
137 -- If you just want to place a static directory tree on the 'ResTree',
138 -- you had better use 'staticDir' rather than this.
139 handleStaticDir ∷ FilePath → Resource ()
140 handleStaticDir basePath
141 = do extraPath ← getPathInfo
142 securityCheck extraPath
143 let path = basePath </> joinPath (map T.unpack extraPath)
145 handleStaticFile path
147 securityCheck pathElems
148 = when (any (≡ "..") pathElems)
149 $ fail ("security error: " ⧺ show pathElems)
150 -- TODO: implement directory listing.