module Network.HTTP.Lucu.StaticFile
( staticFile
, handleStaticFile
, staticDir
, handleStaticDir
, generateETagFromFile
)
where
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Time.Clock.POSIX
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.Format
import Network.HTTP.Lucu.MIMEType.Guess
import Network.HTTP.Lucu.Resource
import Network.HTTP.Lucu.Resource.Tree
import Network.HTTP.Lucu.Response
import Network.HTTP.Lucu.Utils
import System.Posix.Files
staticFile :: FilePath -> ResourceDef
staticFile path
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = False
, resGet = Just $! handleStaticFile path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
, resDelete = Nothing
}
handleStaticFile :: FilePath -> Resource ()
handleStaticFile path
= path `seq`
do exists <- liftIO $ fileExist path
if exists then
do stat <- liftIO $ getFileStatus path
if isRegularFile stat then
do readable <- liftIO $ fileAccess path True False False
unless readable
$ abort Forbidden [] Nothing
tag <- liftIO $ generateETagFromFile path
lastMod <- return $ posixSecondsToUTCTime $ fromRational $ toRational $ modificationTime stat
foundEntity tag lastMod
conf <- getConfig
case guessTypeByFileName (cnfExtToMIMEType conf) path of
Nothing -> return ()
Just mime -> setContentType mime
(liftIO $ B.readFile path) >>= outputLBS
else
abort Forbidden [] Nothing
else
foundNoEntity Nothing
generateETagFromFile :: FilePath -> IO ETag
generateETagFromFile path
= path `seq`
do stat <- getFileStatus path
let inode = fromEnum $! fileID stat
size = fromEnum $! fileSize stat
lastMod = fromEnum $! modificationTime stat
tag = fmtHex False 0 inode
++ "-" ++
fmtHex False 0 size
++ "-" ++
fmtHex False 0 lastMod
return $! strongETag tag
staticDir :: FilePath -> ResourceDef
staticDir path
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = True
, resGet = Just $! handleStaticDir path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
, resDelete = Nothing
}
handleStaticDir :: FilePath -> Resource ()
handleStaticDir basePath
= basePath `seq`
do extraPath <- getPathInfo
securityCheck extraPath
let path = basePath ++ "/" ++ joinWith "/" extraPath
handleStaticFile path
where
securityCheck :: Monad m => [String] -> m ()
securityCheck pathElems
= pathElems `seq`
when (any (== "..") pathElems) $ fail ("security error: "
++ joinWith "/" pathElems)