7 -- | Handling static files on the filesystem.
8 module Network.HTTP.Lucu.StaticFile
12 , generateETagFromFile
15 import qualified Blaze.ByteString.Builder.ByteString as BB
16 import qualified Blaze.Text.Int as BT
18 import Control.Monad.Unicode
19 import Control.Monad.Trans
20 import qualified Data.Ascii as A
21 import Data.ByteString (ByteString)
22 import qualified Data.ByteString.Lazy.Char8 as LBS
23 import Data.Monoid.Unicode
25 import qualified Data.Text as T
26 import qualified Data.Text.Encoding as T
27 import Data.Time.Clock.POSIX
28 import Network.HTTP.Lucu.Abortion
29 import Network.HTTP.Lucu.Config
30 import Network.HTTP.Lucu.ETag
31 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
32 import Network.HTTP.Lucu.MIMEType.Guess
33 import Network.HTTP.Lucu.MIMEType.TH
34 import Network.HTTP.Lucu.Resource
35 import Network.HTTP.Lucu.Resource.Internal
36 import Network.HTTP.Lucu.Response
37 import Prelude.Unicode
38 import System.FilePath
39 import System.Posix.Files
41 -- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
42 -- @fpath@ on the filesystem.
43 staticFile ∷ FilePath → ResourceDef
46 resGet = Just $ handleStaticFile True path
47 , resHead = Just $ handleStaticFile False path
50 octetStream ∷ MIMEType
51 octetStream = [mimeType| application/octet-stream |]
53 handleStaticFile ∷ Bool → FilePath → Resource ()
54 handleStaticFile sendContent path
55 = do exists ← liftIO $ fileExist path
59 readable ← liftIO $ fileAccess path True False False
62 $ mkAbortion Forbidden [] Nothing
64 stat ← liftIO $ getFileStatus path
65 when (isDirectory stat)
67 $ mkAbortion Forbidden [] Nothing
69 tag ← liftIO $ generateETagFromFile path
70 let lastMod = posixSecondsToUTCTime
73 $ modificationTime stat
74 foundEntity tag lastMod
77 case guessTypeByFileName (cnfExtToMIMEType conf) path of
78 Nothing → setContentType octetStream
79 Just mime → setContentType mime
82 $ liftIO (LBS.readFile path) ≫= putChunks
84 -- |@'generateETagFromFile' fpath@ generates a strong entity tag from
85 -- a file. The file doesn't necessarily have to be a regular file; it
86 -- may be a FIFO or a device file. The tag is made of inode ID, size
87 -- 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 strictly strong ETag from a
92 -- file as we don't want to simply grab the entire file and use it as
93 -- 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
98 = do stat ← getFileStatus path
99 let inode = fileID stat
101 lastMod = fromEnum $ modificationTime stat
102 tag = A.fromAsciiBuilder
103 $ A.unsafeFromBuilder
105 ⊕ BB.fromByteString "-"
107 ⊕ BB.fromByteString "-"
108 ⊕ BT.integral lastMod
109 return $ strongETag tag
111 -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
112 -- @dir@ and its subdirectories on the filesystem to the
113 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
115 -- Note that 'staticDir' currently doesn't have a directory-listing
116 -- capability. Requesting the content of a directory will end up being
117 -- replied with /403 Forbidden/.
118 staticDir ∷ FilePath → ResourceDef
122 , resGet = Just $ handleStaticDir True path
123 , resHead = Just $ handleStaticDir False path
126 -- TODO: implement directory listing.
127 handleStaticDir ∷ Bool → FilePath → Resource ()
128 handleStaticDir sendContent basePath
129 = do extraPath ← getPathInfo
130 securityCheck extraPath
131 let path = basePath </> joinPath (map dec8 extraPath)
132 handleStaticFile sendContent path
134 dec8 ∷ ByteString → String
135 dec8 = T.unpack ∘ T.decodeUtf8
137 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
138 securityCheck pathElems
139 = when (any (≡ "..") pathElems)
140 $ fail ("security error: " ⧺ show pathElems)