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 octetStream = mkMIMEType "application" "octet-stream"
51 handleStaticFile ∷ Bool → FilePath → Resource ()
52 handleStaticFile sendContent path
53 = do exists ← liftIO $ fileExist path
55 $ foundNoEntity Nothing
57 readable ← liftIO $ fileAccess path True False False
59 $ abort Forbidden [] Nothing
61 stat ← liftIO $ getFileStatus path
62 when (isDirectory stat)
63 $ abort Forbidden [] Nothing
65 tag ← liftIO $ generateETagFromFile path
66 let lastMod = posixSecondsToUTCTime
69 $ modificationTime stat
70 foundEntity tag lastMod
73 case guessTypeByFileName (cnfExtToMIMEType conf) path of
74 Nothing → setContentType octetStream
75 Just mime → setContentType mime
78 $ liftIO (LBS.readFile path) ≫= putChunks
80 -- |@'generateETagFromFile' fpath@ generates a strong entity tag from
81 -- a file. The file doesn't necessarily have to be a regular file; it
82 -- may be a FIFO or a device file. The tag is made of inode ID, size
83 -- and modification time.
85 -- Note that the tag is not strictly strong because the file could be
86 -- modified twice at a second without changing inode ID or size, but
87 -- it's not really possible to generate a strictly strong ETag from a
88 -- file as we don't want to simply grab the entire file and use it as
89 -- an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
90 -- increase strictness, but it's too inefficient if the file is really
91 -- large (say, 1 TiB).
92 generateETagFromFile ∷ FilePath → IO ETag
93 generateETagFromFile path
94 = do stat ← getFileStatus path
95 let inode = fileID stat
97 lastMod = fromEnum $ modificationTime stat
98 tag = A.fromAsciiBuilder
101 ⊕ BB.fromByteString "-"
103 ⊕ BB.fromByteString "-"
104 ⊕ BT.integral lastMod
105 return $ strongETag tag
107 -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
108 -- @dir@ and its subdirectories on the filesystem to the
109 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
111 -- Note that 'staticDir' currently doesn't have a directory-listing
112 -- capability. Requesting the content of a directory will end up being
113 -- replied with /403 Forbidden/.
114 staticDir ∷ FilePath → ResourceDef
118 , resGet = Just $ handleStaticDir True path
119 , resHead = Just $ handleStaticDir False path
122 -- TODO: implement directory listing.
123 handleStaticDir ∷ Bool → FilePath → Resource ()
124 handleStaticDir sendContent basePath
125 = do extraPath ← getPathInfo
126 securityCheck extraPath
127 let path = basePath </> joinPath (map dec8 extraPath)
128 handleStaticFile sendContent path
130 dec8 ∷ ByteString → String
131 dec8 = T.unpack ∘ T.decodeUtf8
133 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
134 securityCheck pathElems
135 = when (any (≡ "..") pathElems)
136 $ fail ("security error: " ⧺ show pathElems)