git.iko.soy/typeable/wai
on master help sign in
Merge pull request #1 from snoyberg/master
598d807Kazu Yamamoto
Network/Wai/Handler/Warp.hs+23−3
compare with master
unifiedsplit
@@ -39,6 +39,7 @@ module Network.Wai.Handler.Warp
39 , InvalidRequest (..)
39 , InvalidRequest (..)
40#if TEST
40#if TEST
41 , takeHeaders
41 , takeHeaders
42+ , readInt
42#endif
43#endif
43 ) where
44 ) where
44
45
@@ -81,6 +82,8 @@ import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
81import Data.Monoid (mappend, mconcat)
82import Data.Monoid (mappend, mconcat)
82import Network.Sendfile
83import Network.Sendfile
83
84
85+import qualified System.PosixCompat.Files as P
86+
84import Control.Monad.IO.Class (liftIO)
87import Control.Monad.IO.Class (liftIO)
85import qualified Timeout as T
88import qualified Timeout as T
86import Data.Word (Word8)
89import Data.Word (Word8)
@@ -296,17 +299,29 @@ hasBody s req = s /= (H.Status 204 "") && requestMethod req /= "HEAD"
296sendResponse :: T.Handle
299sendResponse :: T.Handle
297 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
300 -> Request -> H.HttpVersion -> Socket -> Response -> IO Bool
298sendResponse th req hv socket (ResponseFile s hs fp mpart) = do
301sendResponse th req hv socket (ResponseFile s hs fp mpart) = do
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)
299− Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs False
311+ Sock.sendMany socket $ L.toChunks $ toLazyByteString $ headers hv s hs' False
300 if hasBody s req
312 if hasBody s req
301 then do
313 then do
302 case mpart of
314 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)
304 Just part -> sendfile socket fp PartOfFile {
319 Just part -> sendfile socket fp PartOfFile {
305 rangeOffset = filePartOffset part
320 rangeOffset = filePartOffset part
306 , rangeLength = filePartByteCount part
321 , rangeLength = filePartByteCount part
307 } (T.tickle th)
322 } (T.tickle th)
308 T.tickle th
323 T.tickle th
309− return $ lookup "content-length" hs /= Nothing
324+ return True
310 else return True
325 else return True
311sendResponse th req hv socket (ResponseBuilder s hs b)
326sendResponse th req hv socket (ResponseBuilder s hs b)
312 | hasBody s req = do
327 | hasBody s req = do
@@ -497,3 +512,8 @@ checkCR bs pos =
497 then p
512 then p
498 else pos
513 else pos
499{-# INLINE checkCR #-}
514{-# 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 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2import Network.Wai
2import Network.Wai
3import Network.Wai.Handler.Warp
3import Network.Wai.Handler.Warp
4+import Network.HTTP.Types
4
5
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 @@
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4import Test.Framework (defaultMain, testGroup, Test)
4import Test.Framework (defaultMain, testGroup, Test)
5import Test.Framework.Providers.HUnit
5import Test.Framework.Providers.HUnit
6+import Test.Framework.Providers.QuickCheck2
6import Test.HUnit hiding (Test)
7import Test.HUnit hiding (Test)
7
8
8−import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
9+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
9import Data.Enumerator (run_, ($$), enumList, run)
10import Data.Enumerator (run_, ($$), enumList, run)
10import Control.Exception (fromException)
11import Control.Exception (fromException)
12+import qualified Data.ByteString.Char8 as S8
11
13
12main :: IO ()
14main :: IO ()
13main = defaultMain [testSuite]
15main = defaultMain [testSuite]
@@ -17,6 +19,9 @@ testSuite = testGroup "Text.Hamlet"
17 [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
19 [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
18 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
20 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
19 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
21 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
22+ , testProperty "takeInt" $ \i' ->
23+ let i = abs i'
24+ in i == readInt (S8.pack $ show i)
20 ]
25 ]
21
26
22caseTakeUntilBlankSafe = do
27caseTakeUntilBlankSafe = do
warp.cabal+1
@@ -25,6 +25,7 @@ Library
25 , simple-sendfile >= 0.1 && < 0.2
25 , simple-sendfile >= 0.1 && < 0.2
26 , http-types >= 0.6 && < 0.7
26 , http-types >= 0.6 && < 0.7
27 , case-insensitive >= 0.2 && < 0.3
27 , case-insensitive >= 0.2 && < 0.3
28+ , unix-compat >= 0.2 && < 0.3
28 if flag(network-bytestring)
29 if flag(network-bytestring)
29 build-depends: network >= 2.2.1 && < 2.2.3
30 build-depends: network >= 2.2.1 && < 2.2.3
30 , network-bytestring >= 0.1.3 && < 0.1.4
31 , network-bytestring >= 0.1.3 && < 0.1.4