X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=a83f285858411d50ff37d00137c8731651914643;hb=858129cb755aa09da2b7bd758efb8519f2c89103;hp=7937af9b6fee02996136d7335664f921af0c6932;hpb=32cb47e903c5fb1d35fe48dfa8e975464a3832e3;p=Lucu.git

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 7937af9..a83f285 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -1,9 +1,12 @@
+-- | Handling static files on the filesystem.
 module Network.HTTP.Lucu.StaticFile
-    ( staticFile       -- FilePath -> ResourceDef
-    , handleStaticFile -- FilePath -> Resource ()
+    ( staticFile
+    , handleStaticFile
 
-    , staticDir       -- FilePath -> ResourceDef
-    , handleStaticDir -- FilePath -> Resource ()
+    , staticDir
+    , handleStaticDir
+
+    , generateETagFromFile
     )
     where
 
@@ -14,6 +17,7 @@ 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
@@ -21,25 +25,36 @@ import           Network.HTTP.Lucu.Response
 import           Network.HTTP.Lucu.Utils
 import           System.Directory
 import           System.Posix.Files
-import           Text.Printf
 
 
+-- | @'staticFile' fpath@ is a
+-- 'Network.HTTP.Lucu.Resource.Tree.ResourceDef' which serves the file
+-- at @fpath@ on the filesystem.
 staticFile :: FilePath -> ResourceDef
 staticFile path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = False
-      , resGet              = Just $ handleStaticFile path
+      , resGet              = Just $! handleStaticFile path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
       , resDelete           = Nothing
       }
 
-
+-- | Computation of @'handleStaticFile' fpath@ serves the file at
+-- @fpath@ on the filesystem. The
+-- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
+-- Request/ state before the computation. It will be in the /Done/
+-- state after the computation.
+--
+-- If you just want to place a static file on the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
+-- '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
@@ -67,33 +82,62 @@ handleStaticFile path
                   else
                     foundNoEntity Nothing
 
-
--- inode-size-lastmod
+-- |Computation of @'generateETagFromFile' fpath@ generates a strong
+-- entity tag from a file. The file doesn't necessarily have to be a
+-- regular file; it may be a FIFO or a device file. The tag is made of
+-- inode ID, size and modification time.
+--
+-- Note that the tag is not strictly strong because the file could be
+-- modified twice at a second without changing inode ID or size, but
+-- it's not really possible to generate a strict strong ETag from a
+-- file since we don't want to simply grab the entire file and use it
+-- as an ETag. It is indeed possible to hash it with SHA-1 or MD5 to
+-- increase strictness, but it's too inefficient if the file is really
+-- 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
+-- in @dir@ and its subdirectories on the filesystem to the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.
 staticDir :: FilePath -> ResourceDef
 staticDir path
     = ResourceDef {
         resUsesNativeThread = False
       , resIsGreedy         = True
-      , resGet              = Just $ handleStaticDir path
+      , resGet              = Just $! handleStaticDir path
       , resHead             = Nothing
       , resPost             = Nothing
       , resPut              = Nothing
       , resDelete           = Nothing
       }
 
-
+-- | Computation of @'handleStaticDir' dir@ maps all files in @dir@
+-- and its subdirectories on the filesystem to the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The
+-- 'Network.HTTP.Lucu.Resource.Resource' must be in the /Examining
+-- Request/ state before the computation. It will be in the /Done/
+-- state after the computation.
+--
+-- If you just want to place a static directory tree on the
+-- 'Network.HTTP.Lucu.Resource.Tree.ResTree', you had better use
+-- 'staticDir' instead of this.
 handleStaticDir :: FilePath -> Resource ()
 handleStaticDir basePath
-    = do extraPath <- getPathInfo
+    = basePath `seq`
+      do extraPath <- getPathInfo
          securityCheck extraPath
          let path = basePath ++ "/" ++ joinWith "/" extraPath
 
@@ -101,5 +145,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)