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.Convertible.Base
19 import Data.Convertible.Instances.Text ()
20 import Data.Monoid.Unicode
22 import qualified Data.Text.Encoding as T
23 import Network.HTTP.Lucu.Abortion
24 import Network.HTTP.Lucu.Config
25 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
26 import Network.HTTP.Lucu.MIMEType.Guess
27 import Network.HTTP.Lucu.MIMEType.TH
28 import Network.HTTP.Lucu.Resource
29 import Network.HTTP.Lucu.Resource.Internal
30 import Network.HTTP.Lucu.Response
31 import Network.HTTP.Lucu.Utils
32 import Prelude.Unicode
33 import System.Directory
34 import System.FilePath
36 -- | @'staticFile' fpath@ is a 'Resource' which serves the file at
37 -- @fpath@ on the filesystem.
38 staticFile ∷ FilePath → Resource
41 resGet = Just $ handleStaticFile True path
42 , resHead = Just $ handleStaticFile False path
45 octetStream ∷ MIMEType
46 octetStream = [mimeType| application/octet-stream |]
48 handleStaticFile ∷ Bool → FilePath → Rsrc ()
49 handleStaticFile sendContent path
50 = do isDir ← liftIO $ doesDirectoryExist path
53 $ mkAbortion Forbidden [] Nothing
55 isFile ← liftIO $ doesFileExist path
59 perms ← liftIO $ getPermissions path
60 unless (readable perms)
62 $ mkAbortion Forbidden [] Nothing
64 lastMod ← liftIO $ getLastModified path
65 foundTimeStamp lastMod
68 case guessTypeByFileName (cnfExtToMIMEType conf) path of
69 Nothing → setContentType octetStream
70 Just mime → setContentType mime
73 $ liftIO (LBS.readFile path) ≫= putChunks
75 -- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
76 -- and its subdirectories on the filesystem to the resource tree. Thus
77 -- having 'Network.HTTP.Lucu.nonGreedy' 'staticDir' in a tree makes no
80 -- Note that 'staticDir' currently doesn't have a directory-listing
81 -- capability. Requesting the content of a directory will end up being
82 -- replied with /403 Forbidden/.
83 staticDir ∷ FilePath → Resource
86 resGet = Just $ handleStaticDir True path
87 , resHead = Just $ handleStaticDir False path
90 -- TODO: implement directory listing.
91 handleStaticDir ∷ Bool → FilePath → Rsrc ()
92 handleStaticDir sendContent basePath
93 = do extraPath ← getPathInfo
94 securityCheck extraPath
95 let path = basePath </> joinPath (map dec8 extraPath)
96 handleStaticFile sendContent path
98 dec8 ∷ ByteString → String
99 dec8 = cs ∘ T.decodeUtf8
101 securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
102 securityCheck pathElems
103 = when (any (≡ "..") pathElems)
104 $ fail ("security error: " ⧺ show pathElems)