]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/StaticFile.hs
Resource paths should not be assumed to be encoded in UTF-8. HTTP/1.1 says nothing...
[Lucu.git] / Network / HTTP / Lucu / StaticFile.hs
index c227205a3759a6df79fbe2eb9498c2c46eba9fe0..82bc59b84db9706a688e1b69ab215a7bdfee1d51 100644 (file)
@@ -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)