staticDir

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

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 89b783281b12bbfdf526fabcdc545c856e68ecec..e5443409d2f65b0e1639622aae1d334eceff96db 100644 (file)
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,6 +1,9 @@
 module Network.HTTP.Lucu.StaticFile
     ( staticFile       -- FilePath -> ResourceDef
     , handleStaticFile -- FilePath -> Resource ()
+
+    , staticDir       -- FilePath -> ResourceDef
+    , handleStaticDir -- FilePath -> Resource ()
     )
     where
 
@@ -15,6 +18,7 @@ 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
@@ -35,8 +39,8 @@ staticFile path
 
 handleStaticFile :: FilePath -> Resource ()
 handleStaticFile path
-    = do exist <- liftIO $ fileExist path
-         if exist then
+    = do isFile <- liftIO $ doesFileExist path
+         if isFile then
              -- 存在はした。讀めるかどうかは知らない。
              do readable <- liftIO $ fileAccess path True False False
                 unless readable
@@ -57,7 +61,11 @@ handleStaticFile path
                 -- 實際にファイルを讀んで送る
                 (liftIO $ B.readFile path) >>= outputBS
            else
-             foundNoEntity Nothing
+             do isDir <- liftIO $ doesDirectoryExist path
+                if isDir then
+                    abort Forbidden [] Nothing
+                  else
+                    foundNoEntity Nothing
 
 
 -- inode-size-lastmod
@@ -68,3 +76,24 @@ generateETagFromFile path
              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