X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=39ff39c41ded5da08304e33b1f5cc97f9651bb5e;hp=ffda4cf8dbbbc0a6f0bb41b9536dfb30ec2d2d1c;hb=46ea3a688edea377e83794d1387f3f2d203bb0c6;hpb=64129c18cf0eeb0e96d83882be14a8d96f4c2892

diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index ffda4cf..39ff39c 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -8,35 +8,28 @@
 module Network.HTTP.Lucu.StaticFile
     ( staticFile
     , staticDir
-
-    , generateETagFromFile
     )
     where
-import qualified Blaze.ByteString.Builder.ByteString as BB
-import qualified Blaze.Text.Int as BT
 import Control.Monad
 import Control.Monad.Unicode
 import Control.Monad.Trans
-import qualified Data.Ascii as A
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as LBS
-import Data.Monoid.Unicode
 import Data.String
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import Data.Time.Clock.POSIX
 import Network.HTTP.Lucu.Abortion
 import Network.HTTP.Lucu.Config
-import Network.HTTP.Lucu.ETag
 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
 import Network.HTTP.Lucu.MIMEType.Guess
 import Network.HTTP.Lucu.MIMEType.TH
 import Network.HTTP.Lucu.Resource
 import Network.HTTP.Lucu.Resource.Internal
 import Network.HTTP.Lucu.Response
+import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
+import System.Directory
 import System.FilePath
-import System.Posix.Files
 
 -- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at
 -- @fpath@ on the filesystem.
@@ -52,27 +45,17 @@ octetStream = [mimeType| application/octet-stream |]
 
 handleStaticFile ∷ Bool → FilePath → Resource ()
 handleStaticFile sendContent path
-    = do exists ← liftIO $ fileExist path
+    = do exists ← liftIO $ doesFileExist path
          unless exists
              foundNoEntity'
 
-         readable ← liftIO $ fileAccess path True False False
-         unless readable
-             $ abort
-             $ mkAbortion Forbidden [] Nothing
-
-         stat ← liftIO $ getFileStatus path
-         when (isDirectory stat)
+         perms ← liftIO $ getPermissions path
+         unless (readable perms)
              $ abort
              $ mkAbortion Forbidden [] Nothing
 
-         -- FIXME: Forget about ETags of a static file.
-         tag  ← liftIO $ generateETagFromFile path
-         let lastMod = posixSecondsToUTCTime
-                       $ fromRational
-                       $ toRational
-                       $ modificationTime stat
-         foundEntity tag lastMod
+         lastMod ← liftIO $ getLastModified path
+         foundTimeStamp lastMod
 
          conf ← getConfig
          case guessTypeByFileName (cnfExtToMIMEType conf) path of
@@ -82,33 +65,6 @@ handleStaticFile sendContent path
          when sendContent
              $ liftIO (LBS.readFile path) ≫= putChunks
 
--- |@'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 strictly strong ETag from a
--- file as 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   = fileID   stat
-             size    = fileSize stat
-             lastMod = fromEnum $ modificationTime stat
-             tag     = A.fromAsciiBuilder
-                       $ A.unsafeFromBuilder
-                       $ BT.integral inode
-                       ⊕ BB.fromByteString "-"
-                       ⊕ BT.integral size
-                       ⊕ BB.fromByteString "-"
-                       ⊕ BT.integral lastMod
-         return $ strongETag tag
-
 -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in
 -- @dir@ and its subdirectories on the filesystem to the
 -- 'Network.HTTP.Lucu.Resource.Tree.ResTree'.