git.iko.soy/typeable/wai
on master help sign in
Merge pull request #1 from snoyberg/master

Get file length when not provided

commit598d807bcca6ab8695da874883b5a919120d5f49 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 22 Jun 2011, 02:05 (15 years ago) parent921f7e3f6134fa
5 files changed+38−5
compare with master
unifiedsplit
Network/Wai/Handler/Warp.hs+23−3 file-nolen.hs+6 file.hs+2−1 runtests.hs+6−1 warp.cabal+1
Network/Wai/Handler/Warp.hs+23−3
@@ -39,6 +39,7 @@ module Network.Wai.Handler.Warp
3939 , InvalidRequest (..)
4040#if TEST
4141 , takeHeaders
42+ , readInt
4243#endif
4344 ) where
4445
@@ -81,6 +82,8 @@ import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
8182import Data.Monoid (mappend, mconcat)
8283import Network.Sendfile
8384
85+import qualified System.PosixCompat.Files as P
86+
8487import Control.Monad.IO.Class (liftIO)
8588import qualified Timeout as T
8689import Data.Word (Word8)
@@ -296,17 +299,29 @@ hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
296299sendResponse :: T.Handle
297300 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
298301sendResponse th req hv socket (ResponseFile s hs fp mpart) = do
299− Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
302+ (hs', cl) <-
303+ case (readInt `fmap` lookup "content-length" hs, mpart) of
304+ (Just cl, _) -> return (hs, cl)
305+ (Nothing, Nothing) -> do
306+ cl <- P.fileSize `fmap` P.getFileStatus fp
307+ return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
308+ (Nothing, Just part) -> do
309+ let cl = filePartByteCount part
310+ return (("Content-Length", B.pack $ show cl):hs, fromIntegral cl)
311+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs' False
300312 if hasBody s req
301313 then do
302314 case mpart of
303− Nothing -> sendfile socket fp EntireFile (T.tickle th)
315+ Nothing -> sendfile socket fp PartOfFile {
316+ rangeOffset = 0
317+ , rangeLength = cl
318+ } (T.tickle th)
304319 Just part -> sendfile socket fp PartOfFile {
305320 rangeOffset = filePartOffset part
306321 , rangeLength = filePartByteCount part
307322 } (T.tickle th)
308323 T.tickle th
309− return $ lookup "content-length" hs /= Nothing
324+ return True
310325 else return True
311326sendResponse th req hv socket (ResponseBuilder s hs b)
312327 | hasBody s req = do
@@ -497,3 +512,8 @@ checkCR bs pos =
497512 then p
498513 else pos
499514{-# INLINE checkCR #-}
515+
516+-- Note: This function produces garbage on invalid input. But serving an
517+-- invalid content-length is a bad idea, mkay?
518+readInt :: S.ByteString -> Integer
519+readInt = S.foldl' (\x w -> x * 10 + fromIntegral w - 48) 0
file-nolen.hsnew file+6
@@ -0,0 +1,6 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Network.Wai
3+import Network.Wai.Handler.Warp
4+import Network.HTTP.Types
5+
6+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain")] "test.txt" Nothing
file.hs+2−1
@@ -1,5 +1,6 @@
11{-# LANGUAGE OverloadedStrings #-}
22import Network.Wai
33import Network.Wai.Handler.Warp
4+import Network.HTTP.Types
45
5−main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain"), ("Content-Length", "16")] "test.txt"
6+main = run 3000 $ const $ return $ ResponseFile status200 [("Content-Type", "text/plain"), ("Content-Length", "16")] "test.txt" Nothing
runtests.hs+6−1
@@ -3,11 +3,13 @@
33{-# LANGUAGE OverloadedStrings #-}
44import Test.Framework (defaultMain, testGroup, Test)
55import Test.Framework.Providers.HUnit
6+import Test.Framework.Providers.QuickCheck2
67import Test.HUnit hiding (Test)
78
8−import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
9+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
910import Data.Enumerator (run_, ($$), enumList, run)
1011import Control.Exception (fromException)
12+import qualified Data.ByteString.Char8 as S8
1113
1214main :: IO ()
1315main = defaultMain [testSuite]
@@ -17,6 +19,9 @@ testSuite = testGroup "Text.Hamlet"
1719 [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
1820 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
1921 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
22+ , testProperty "takeInt" $ \i' ->
23+ let i = abs i'
24+ in i == readInt (S8.pack $ show i)
2025 ]
2126
2227caseTakeUntilBlankSafe = do
warp.cabal+1
@@ -25,6 +25,7 @@ Library
2525 , simple-sendfile >= 0.1 && < 0.2
2626 , http-types >= 0.6 && < 0.7
2727 , case-insensitive >= 0.2 && < 0.3
28+ , unix-compat >= 0.2 && < 0.3
2829 if flag(network-bytestring)
2930 build-depends: network >= 2.2.1 && < 2.2.3
3031 , network-bytestring >= 0.1.3 && < 0.1.4