X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=f9e2513d47d2d865d4067f4f21e49b9a8ac972e9;hb=32a6ebbb18856ab1203e8a114414f235c2abe22b;hp=e710fc90ec62beb0e9cf22164a5c65c92d134b9a;hpb=b340a77fa7bd051dd13a41d0a5b1ad30220bc6b6;p=Lucu.git diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs index e710fc9..f9e2513 100644 --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} +-- | Handling static files on the filesystem. module Network.HTTP.Lucu.StaticFile ( staticFile , handleStaticFile @@ -8,25 +13,30 @@ module Network.HTTP.Lucu.StaticFile , generateETagFromFile ) where - -import Control.Monad -import Control.Monad.Trans +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 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 +import Data.Monoid.Unicode +import qualified Data.Text 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.Guess +import Network.HTTP.Lucu.Resource +import Network.HTTP.Lucu.Resource.Tree +import Network.HTTP.Lucu.Response +import Prelude.Unicode +import System.FilePath +import System.Posix.Files + +-- | @'staticFile' fpath@ is a 'ResourceDef' which serves the file at +-- @fpath@ on the filesystem. +staticFile ∷ FilePath → ResourceDef staticFile path = ResourceDef { resUsesNativeThread = False @@ -38,39 +48,47 @@ staticFile path , resDelete = Nothing } - -handleStaticFile :: FilePath -> Resource () +-- | Computation of @'handleStaticFile' fpath@ serves the file at +-- @fpath@ on the filesystem. The '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 'ResTree', you had +-- better use 'staticFile' rather than this. +handleStaticFile ∷ FilePath → Resource () handleStaticFile path - = do isFile <- liftIO $ doesFileExist path - if isFile then + = do exists ← liftIO $ fileExist path + if exists then -- 存在はした。讀めるかどうかは知らない。 - do readable <- liftIO $ fileAccess path True False False - unless readable + do stat ← liftIO $ getFileStatus path + if isRegularFile stat 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 + -- 讀める + tag ← liftIO $ generateETagFromFile path + let lastMod = posixSecondsToUTCTime + $ fromRational + $ toRational + $ modificationTime stat + foundEntity tag lastMod + + -- MIME Type を推定 + conf ← getConfig + case guessTypeByFileName (cnfExtToMIMEType conf) path of + Nothing → return () + Just mime → setContentType mime + + -- 實際にファイルを讀んで送る + liftIO (B.readFile path) ≫= output else - foundNoEntity Nothing + abort Forbidden [] Nothing + else + foundNoEntity Nothing --- |Computation @'generateETagFromFile' fpath@ generates a strong +-- |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. @@ -82,16 +100,24 @@ handleStaticFile path -- 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 ∷ 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 + = 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 'ResTree'. +staticDir ∷ FilePath → ResourceDef staticDir path = ResourceDef { resUsesNativeThread = False @@ -103,16 +129,22 @@ staticDir path , resDelete = Nothing } - -handleStaticDir :: FilePath -> Resource () +-- | Computation of @'handleStaticDir' dir@ maps all files in @dir@ +-- and its subdirectories on the filesystem to the 'ResTree'. The +-- '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 'ResTree', +-- you had better use 'staticDir' rather than this. +handleStaticDir ∷ FilePath → Resource () handleStaticDir basePath - = do extraPath <- getPathInfo + = do extraPath ← getPathInfo securityCheck extraPath - let path = basePath ++ "/" ++ joinWith "/" extraPath + let path = basePath joinPath (map T.unpack extraPath) handleStaticFile path where - securityCheck :: Monad m => [String] -> m () securityCheck pathElems - = when (any (== "..") pathElems) $ fail ("security error: " - ++ joinWith "/" pathElems) + = when (any (≡ "..") pathElems) + $ fail ("security error: " ⧺ show pathElems) +-- TODO: implement directory listing.