import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString.Lazy.Char8 as B
-import Data.ByteString.Lazy.Char8 (ByteString)
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.Utils
import System.Directory
import System.Posix.Files
-import Text.Printf
-- | @'staticFile' fpath@ is a
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = False
- , resGet = Just $ handleStaticFile path
+ , resGet = Just $! handleStaticFile path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
-- 'staticFile' instead of this.
handleStaticFile :: FilePath -> Resource ()
handleStaticFile path
- = do isFile <- liftIO $ doesFileExist path
+ = path `seq`
+ do isFile <- liftIO $ doesFileExist path
if isFile then
-- 存在はした。讀めるかどうかは知らない。
do readable <- liftIO $ fileAccess path True False False
-- large (say, 1 TiB).
generateETagFromFile :: FilePath -> IO ETag
generateETagFromFile path
- = do stat <- getFileStatus path
- let inode = fromEnum $ fileID stat
- size = fromEnum $ fileSize stat
- lastmod = fromEnum $ modificationTime stat
- return $ strongETag $ printf "%x-%x-%x" inode size lastmod
+ = 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' dir@ is a
-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which maps all files
= ResourceDef {
resUsesNativeThread = False
, resIsGreedy = True
- , resGet = Just $ handleStaticDir path
+ , resGet = Just $! handleStaticDir path
, resHead = Nothing
, resPost = Nothing
, resPut = Nothing
-- 'staticDir' instead of this.
handleStaticDir :: FilePath -> Resource ()
handleStaticDir basePath
- = do extraPath <- getPathInfo
+ = basePath `seq`
+ do extraPath <- getPathInfo
securityCheck extraPath
let path = basePath ++ "/" ++ joinWith "/" extraPath
where
securityCheck :: Monad m => [String] -> m ()
securityCheck pathElems
- = when (any (== "..") pathElems) $ fail ("security error: "
+ = pathElems `seq`
+ when (any (== "..") pathElems) $ fail ("security error: "
++ joinWith "/" pathElems)