6 -- | Handling static files on the filesystem.
7 module Network.HTTP.Lucu.StaticFile
11 , generateETagFromFile
14 import qualified Blaze.ByteString.Builder.ByteString as BB
15 import qualified Blaze.Text.Int as BT
17 import Control.Monad.Unicode
18 import Control.Monad.Trans
19 import qualified Data.Ascii as A
20 import Data.ByteString (ByteString)
21 import qualified Data.ByteString.Lazy.Char8 as LBS
22 import Data.Monoid.Unicode
24 import qualified Data.Text as T
25 import qualified Data.Text.Encoding as T
26 import Data.Time.Clock.POSIX
27 import Network.HTTP.Lucu.Abortion
28 import Network.HTTP.Lucu.Config
29 import Network.HTTP.Lucu.ETag
30 import Network.HTTP.Lucu.MIMEType
31 import Network.HTTP.Lucu.MIMEType.Guess
32 import Network.HTTP.Lucu.Resource
33 import Network.HTTP.Lucu.Resource.Internal
34 import Network.HTTP.Lucu.Response
35 import Prelude.Unicode
36 import System.FilePath
37 import System.Posix.Files
39 -- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
40 -- @fpath@ on the filesystem.
41 staticFile ∷ FilePath → ResourceDef
44 resGet = Just $ handleStaticFile True path
45 , resHead = Just $ handleStaticFile False path
48 octetStream ∷ MIMEType
49 {-# NOINLINE octetStream #-}
50 octetStream = parseMIMEType "application/octet-stream"
52 handleStaticFile ∷ Bool → FilePath → Resource ()
53 handleStaticFile sendContent path
54 = do exists ← liftIO $ fileExist path
58 readable ← liftIO $ fileAccess path True False False
61 $ mkAbortion Forbidden [] Nothing
63 stat ← liftIO $ getFileStatus path
64 when (isDirectory stat)
66 $ mkAbortion Forbidden [] Nothing
68 tag ← liftIO $ generateETagFromFile path
69 let lastMod = posixSecondsToUTCTime
72 $ modificationTime stat
73 foundEntity tag lastMod
76 case guessTypeByFileName (cnfExtToMIMEType conf) path of
77 Nothing → setContentType octetStream
78 Just mime → setContentType mime
81 $ liftIO (LBS.readFile path) ≫= putChunks
83 -- |@'generateETagFromFile' fpath@ generates a strong entity tag from
84 -- a file. The file doesn't necessarily have to be a regular file; it
85 -- may be a FIFO or a device file. The tag is made of inode ID, size
86 -- and modification time.
88 -- Note that the tag is not strictly strong because the file could be
89 -- modified twice at a second without changing inode ID or size, but
90 -- it's not really possible to generate a strictly strong ETag from a
91 -- file as we don't want to simply grab the entire file and use it as
92 -- an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
93 -- increase strictness, but it's too inefficient if the file is really
94 -- large (say, 1 TiB).
95 generateETagFromFile ∷ FilePath → IO ETag
96 generateETagFromFile path
97 = do stat ← getFileStatus path
98 let inode = fileID stat
100 lastMod = fromEnum $ modificationTime stat
101 tag = A.fromAsciiBuilder
102 $ A.unsafeFromBuilder
104 ⊕ BB.fromByteString "-"
106 ⊕ BB.fromByteString "-"
107 ⊕ BT.integral lastMod
108 return $ strongETag tag
110 -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
111 -- @dir@ and its subdirectories on the filesystem to the
112 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
114 -- Note that 'staticDir' currently doesn't have a directory-listing
115 -- capability. Requesting the content of a directory will end up being
116 -- replied with /403 Forbidden/.
117 staticDir ∷ FilePath → ResourceDef
121 , resGet = Just $ handleStaticDir True path
122 , resHead = Just $ handleStaticDir False path
125 -- TODO: implement directory listing.
126 handleStaticDir ∷ Bool → FilePath → Resource ()
127 handleStaticDir sendContent basePath
128 = do extraPath ← getPathInfo
129 securityCheck extraPath
130 let path = basePath </> joinPath (map dec8 extraPath)
131 handleStaticFile sendContent path
133 dec8 ∷ ByteString → String
134 dec8 = T.unpack ∘ T.decodeUtf8
136 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
137 securityCheck pathElems
138 = when (any (≡ "..") pathElems)
139 $ fail ("security error: " ⧺ show pathElems)