staticDir

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

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index cbbed1e8e44bdbb44f88ef0a3019ad5137b67217..e5443409d2f65b0e1639622aae1d334eceff96db 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,13 +1,99 @@
 module Network.HTTP.Lucu.StaticFile
-    (
+    ( staticFile       -- FilePath -> ResourceDef
+    , handleStaticFile -- FilePath -> Resource ()
+
+    , staticDir       -- FilePath -> ResourceDef
+    , handleStaticDir -- 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           Network.HTTP.Lucu.Utils
+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 isFile <- liftIO $ doesFileExist path
+         if isFile 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
+             do isDir <- liftIO $ doesDirectoryExist path
+                if isDir then
+                    abort Forbidden [] Nothing
+                  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
+
+
+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
+    = do extraPath <- getPathInfo
+         let path = basePath ++ "/" ++ joinWith "/" extraPath
+
+         handleStaticFile path