7 -- | Handling static files on the filesystem.
8 module Network.HTTP.Lucu.StaticFile
14 import Control.Monad.Unicode
15 import Control.Monad.Trans
16 import Data.ByteString (ByteString)
17 import qualified Data.ByteString.Lazy.Char8 as LBS
18 import Data.Monoid.Unicode
20 import qualified Data.Text as T
21 import qualified Data.Text.Encoding as T
22 import Network.HTTP.Lucu.Abortion
23 import Network.HTTP.Lucu.Config
24 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
25 import Network.HTTP.Lucu.MIMEType.Guess
26 import Network.HTTP.Lucu.MIMEType.TH
27 import Network.HTTP.Lucu.Resource
28 import Network.HTTP.Lucu.Resource.Internal
29 import Network.HTTP.Lucu.Response
30 import Network.HTTP.Lucu.Utils
31 import Prelude.Unicode
32 import System.Directory
33 import System.FilePath
35 -- | @'staticFile' fpath@ is a 'Resource' which serves the file at
36 -- @fpath@ on the filesystem.
37 staticFile ∷ FilePath → Resource
40 resGet = Just $ handleStaticFile True path
41 , resHead = Just $ handleStaticFile False path
44 octetStream ∷ MIMEType
45 octetStream = [mimeType| application/octet-stream |]
47 handleStaticFile ∷ Bool → FilePath → Rsrc ()
48 handleStaticFile sendContent path
49 = do isDir ← liftIO $ doesDirectoryExist path
52 $ mkAbortion Forbidden [] Nothing
54 isFile ← liftIO $ doesFileExist path
58 perms ← liftIO $ getPermissions path
59 unless (readable perms)
61 $ mkAbortion Forbidden [] Nothing
63 lastMod ← liftIO $ getLastModified path
64 foundTimeStamp lastMod
67 case guessTypeByFileName (cnfExtToMIMEType conf) path of
68 Nothing → setContentType octetStream
69 Just mime → setContentType mime
72 $ liftIO (LBS.readFile path) ≫= putChunks
74 -- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
75 -- and its subdirectories on the filesystem to the resource tree.
77 -- Note that 'staticDir' currently doesn't have a directory-listing
78 -- capability. Requesting the content of a directory will end up being
79 -- replied with /403 Forbidden/.
80 staticDir ∷ FilePath → Resource
83 resGet = Just $ handleStaticDir True path
84 , resHead = Just $ handleStaticDir False path
87 -- TODO: implement directory listing.
88 handleStaticDir ∷ Bool → FilePath → Rsrc ()
89 handleStaticDir sendContent basePath
90 = do extraPath ← getPathInfo
91 securityCheck extraPath
92 let path = basePath </> joinPath (map dec8 extraPath)
93 handleStaticFile sendContent path
95 dec8 ∷ ByteString → String
96 dec8 = T.unpack ∘ T.decodeUtf8
98 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
99 securityCheck pathElems
100 = when (any (≡ "..") pathElems)
101 $ fail ("security error: " ⧺ show pathElems)