X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FStaticFile.hs;h=82bc59b84db9706a688e1b69ab215a7bdfee1d51;hp=c227205a3759a6df79fbe2eb9498c2c46eba9fe0;hb=7bc27fc4e86df6cb4d269b42252de735247f8c57;hpb=7843dbf537dfefa583a8ee55b2a31a5e8a9c7c37 diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs index c227205..82bc59b 100644 --- a/Network/HTTP/Lucu/StaticFile.hs +++ b/Network/HTTP/Lucu/StaticFile.hs @@ -17,9 +17,12 @@ 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 (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 @@ -27,7 +30,7 @@ import Network.HTTP.Lucu.ETag import Network.HTTP.Lucu.MIMEType import Network.HTTP.Lucu.MIMEType.Guess import Network.HTTP.Lucu.Resource -import Network.HTTP.Lucu.Resource.Tree +import Network.HTTP.Lucu.Resource.Internal import Network.HTTP.Lucu.Response import Prelude.Unicode import System.FilePath @@ -72,7 +75,7 @@ handleStaticFile sendContent path Just mime → setContentType mime when sendContent - $ liftIO (B.readFile path) ≫= putChunk + $ 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 @@ -102,7 +105,8 @@ generateETagFromFile path return $ strongETag tag -- | @'staticDir' dir@ is a 'ResourceDef' which maps all files in --- @dir@ and its subdirectories on the filesystem to the 'ResTree'. +-- @dir@ and its subdirectories on the filesystem to the +-- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. -- -- Note that 'staticDir' currently doesn't have a directory-listing -- capability. Requesting the content of a directory will end up being @@ -115,15 +119,18 @@ staticDir path , resHead = Just $ handleStaticDir False path } +-- TODO: implement directory listing. handleStaticDir ∷ Bool → FilePath → Resource () handleStaticDir sendContent basePath = do extraPath ← getPathInfo securityCheck extraPath - let path = basePath joinPath (map T.unpack extraPath) - + let path = basePath joinPath (map dec8 extraPath) handleStaticFile sendContent path where - securityCheck pathElems - = when (any (≡ "..") pathElems) - $ fail ("security error: " ⧺ show pathElems) --- TODO: implement directory listing. + dec8 ∷ ByteString → String + dec8 = T.unpack ∘ T.decodeUtf8 + +securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m () +securityCheck pathElems + = when (any (≡ "..") pathElems) + $ fail ("security error: " ⧺ show pathElems)