X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=7c2ce5c4d455602c133cdfcc4669f937532f6674;hp=12cf78b0729c760c82e6f35faa08909f6d53b876;hb=3d017dd65ddede9a11c5b7a34a91e04340e67bc4;hpb=e1e74c8f81ccbc57bf5a09987b0a9dd42648f020

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 12cf78b..7c2ce5c 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -13,6 +13,7 @@ module Network.HTTP.Lucu.StaticFile
 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
@@ -22,7 +23,6 @@ import           Network.HTTP.Lucu.Resource
 import           Network.HTTP.Lucu.Resource.Tree
 import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
-import           System.Directory
 import           System.Posix.Files
 
 
@@ -53,33 +53,33 @@ staticFile path
 handleStaticFile :: FilePath -> Resource ()
 handleStaticFile path
     = path `seq`
-      do isFile <- liftIO $ doesFileExist path
-         if isFile then
+      do exists <- liftIO $ fileExist path
+         if exists then
              -- 存在はした。讀めるかどうかは知らない。
-             do readable <- liftIO $ fileAccess path True False False
-                unless readable
+             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 $ toEnum $ fromEnum $ modificationTime stat
+                       foundEntity tag lastMod
 
-                -- 讀める
-                tag      <- liftIO $ generateETagFromFile path
-                lastMod  <- liftIO $ getModificationTime path
-                foundEntity tag lastMod
+                       -- MIME Type を推定
+                       conf <- getConfig
+                       case guessTypeByFileName (cnfExtToMIMEType conf) path of
+                         Nothing   -> return ()
+                         Just mime -> setContentType mime
 
-                -- MIME Type を推定
-                conf <- getConfig
-                case guessTypeByFileName (cnfExtToMIMEType conf) path of
-                  Nothing   -> return ()
-                  Just mime -> setContentType mime
-
-                -- 實際にファイルを讀んで送る
-                (liftIO $ B.readFile path) >>= outputLBS
-           else
-             do isDir <- liftIO $ doesDirectoryExist path
-                if isDir then
-                    abort Forbidden [] Nothing
+                       -- 實際にファイルを讀んで送る
+                       (liftIO $ B.readFile path) >>= outputLBS
                   else
-                    foundNoEntity Nothing
+                    abort Forbidden [] Nothing
+           else
+             foundNoEntity Nothing
+
 
 -- |Computation of @'generateETagFromFile' fpath@ generates a strong
 -- entity tag from a file. The file doesn't necessarily have to be a