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