staticFile

[Lucu.git] / Network / HTTP / Lucu / StaticFile.hs

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index cbbed1e8e44bdbb44f88ef0a3019ad5137b67217..89b783281b12bbfdf526fabcdc545c856e68ecec 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,13 +1,70 @@
 module Network.HTTP.Lucu.StaticFile
-    (
+    ( staticFile       -- FilePath -> ResourceDef
+    , handleStaticFile -- FilePath -> Resource ()
     )
     where
 
+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.MIMEType.Guess
+import           Network.HTTP.Lucu.Resource
+import           Network.HTTP.Lucu.Resource.Tree
+import           Network.HTTP.Lucu.Response
+import           System.Directory
+import           System.Posix.Files
+import           Text.Printf
+
 
 staticFile :: FilePath -> ResourceDef
 staticFile path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = False
-      , resGet
-          = Just $ do 
\ No newline at end of file
+      , resGet              = Just $ handleStaticFile path
+      , resHead             = Nothing
+      , resPost             = Nothing
+      , resPut              = Nothing
+      , resDelete           = Nothing
+      }
+
+
+handleStaticFile :: FilePath -> Resource ()
+handleStaticFile path
+    = do exist <- liftIO $ fileExist path
+         if exist then
+             -- 存在はした。讀めるかどうかは知らない。
+             do readable <- liftIO $ fileAccess path True False False
+                unless readable
+                           -- 讀めない
+                           $ abort Forbidden [] Nothing
+
+                -- 讀める
+                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
+
+                -- 實際にファイルを讀んで送る
+                (liftIO $ B.readFile path) >>= outputBS
+           else
+             foundNoEntity Nothing
+
+
+-- inode-size-lastmod
+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