X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=12cf78b0729c760c82e6f35faa08909f6d53b876;hb=0dc3d31312a12f2b085242841b29eb0d96e9c4ac;hp=b84c9cb0ad1fe678ea48ddf66f0a32d4477a2230;hpb=0b4db5681e3b0b27357a87316822ea3671f8c174;p=Lucu.git

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index b84c9cb..12cf78b 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -13,10 +13,10 @@ module Network.HTTP.Lucu.StaticFile
 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
@@ -24,7 +24,6 @@ import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
 import           System.Directory
 import           System.Posix.Files
-import           Text.Printf
 
 
 -- | @'staticFile' fpath@ is a
@@ -35,7 +34,7 @@ staticFile path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = False
-      , resGet              = Just $ handleStaticFile path
+      , resGet              = Just $! handleStaticFile path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
@@ -53,7 +52,8 @@ staticFile path
 -- '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
@@ -73,7 +73,7 @@ handleStaticFile path
                   Just mime -> setContentType mime
 
                 -- 實際にファイルを讀んで送る
-                (liftIO $ B.readFile path) >>= outputBS
+                (liftIO $ B.readFile path) >>= outputLBS
            else
              do isDir <- liftIO $ doesDirectoryExist path
                 if isDir then
@@ -95,11 +95,17 @@ handleStaticFile path
 -- 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
@@ -110,7 +116,7 @@ staticDir path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = True
-      , resGet              = Just $ handleStaticDir path
+      , resGet              = Just $! handleStaticDir path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
@@ -129,7 +135,8 @@ staticDir path
 -- 'staticDir' instead of this.
 handleStaticDir :: FilePath -> Resource ()
 handleStaticDir basePath
-    = do extraPath <- getPathInfo
+    = basePath `seq`
+      do extraPath <- getPathInfo
          securityCheck extraPath
          let path = basePath ++ "/" ++ joinWith "/" extraPath
 
@@ -137,5 +144,6 @@ handleStaticDir basePath
     where
       securityCheck :: Monad m => [String] -> m ()
       securityCheck pathElems
-          = when (any (== "..") pathElems) $ fail ("security error: "
+          = pathElems `seq`
+            when (any (== "..") pathElems) $ fail ("security error: "
                                                    ++ joinWith "/" pathElems)