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
19 import qualified Data.Text as T
20 import qualified Data.Text.Encoding as T
21 import Network.HTTP.Lucu.Abortion
22 import Network.HTTP.Lucu.Config
23 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
24 import Network.HTTP.Lucu.MIMEType.Guess
25 import Network.HTTP.Lucu.MIMEType.TH
26 import Network.HTTP.Lucu.Resource
27 import Network.HTTP.Lucu.Resource.Internal
28 import Network.HTTP.Lucu.Response
29 import Network.HTTP.Lucu.Utils
30 import Prelude.Unicode
31 import System.Directory
32 import System.FilePath
34 -- | @'staticFile' fpath@ is a 'Resource' which serves the file at
35 -- @fpath@ on the filesystem.
36 staticFile ∷ FilePath → Resource
39 resGet = Just $ handleStaticFile True path
40 , resHead = Just $ handleStaticFile False path
43 octetStream ∷ MIMEType
44 octetStream = [mimeType| application/octet-stream |]
46 handleStaticFile ∷ Bool → FilePath → Rsrc ()
47 handleStaticFile sendContent path
48 = do isDir ← liftIO $ doesDirectoryExist path
51 $ mkAbortion Forbidden [] Nothing
53 isFile ← liftIO $ doesFileExist path
57 perms ← liftIO $ getPermissions path
58 unless (readable perms)
60 $ mkAbortion Forbidden [] Nothing
62 lastMod ← liftIO $ getLastModified path
63 foundTimeStamp lastMod
66 case guessTypeByFileName (cnfExtToMIMEType conf) path of
67 Nothing → setContentType octetStream
68 Just mime → setContentType mime
71 $ liftIO (LBS.readFile path) ≫= putChunks
73 -- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
74 -- and its subdirectories on the filesystem to the
75 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
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
84 , resGet = Just $ handleStaticDir True path
85 , resHead = Just $ handleStaticDir False path
88 -- TODO: implement directory listing.
89 handleStaticDir ∷ Bool → FilePath → Rsrc ()
90 handleStaticDir sendContent basePath
91 = do extraPath ← getPathInfo
92 securityCheck extraPath
93 let path = basePath </> joinPath (map dec8 extraPath)
94 handleStaticFile sendContent path
96 dec8 ∷ ByteString → String
97 dec8 = T.unpack ∘ T.decodeUtf8
99 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
100 securityCheck pathElems
101 = when (any (≡ "..") pathElems)
102 $ fail ("security error: " ⧺ show pathElems)