summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2012-03-23 14:04:53 (GMT)
committerhdiff <hdiff@luite.com>2012-03-23 14:04:53 (GMT)
commit98ea9f29a51d336a85f2e6b21523274dc7b9ffb5 (patch)
tree8a0e64963d92e9b42514f8eb1302c912662f1a1d
parent33552224f652fc800af34a49726710db4f36ba7f (diff)
version 1.3.0.11.3.0.1
-rw-r--r--Network/HTTP/Conduit/Response.hs2
-rw-r--r--http-conduit.cabal2
-rw-r--r--test/main.hs24
3 files changed, 24 insertions, 4 deletions
diff --git a/Network/HTTP/Conduit/Response.hs b/Network/HTTP/Conduit/Response.hs
index d7e2340..bf54b66 100644
--- a/Network/HTTP/Conduit/Response.hs
+++ b/Network/HTTP/Conduit/Response.hs
@@ -113,7 +113,7 @@ checkHeaderLength :: MonadResource m
=> Int
-> C.Sink S8.ByteString m a
-> C.Sink S8.ByteString m a
-checkHeaderLength len _
+checkHeaderLength len C.Processing{}
| len <= 0 = C.SinkM $ liftIO $ throwIO OverlongHeaders
checkHeaderLength len (C.Processing pushI closeI) = C.Processing
(\bs -> checkHeaderLength
diff --git a/http-conduit.cabal b/http-conduit.cabal
index f46fe7f..2edd860 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -1,5 +1,5 @@
name: http-conduit
-version: 1.3.0
+version: 1.3.0.1
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
diff --git a/test/main.hs b/test/main.hs
index a544d6b..794dfc2 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,12 +1,13 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Test.Hspec.Monadic
+import qualified Data.ByteString as S
import Test.Hspec.HUnit ()
import Test.HUnit
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Conduit
-import Control.Concurrent (forkIO, killThread)
+import Control.Concurrent (forkIO, killThread, threadDelay)
import Network.HTTP.Types
import Control.Exception.Lifted (try, SomeException)
import Network.HTTP.Conduit.ConnInfo
@@ -16,9 +17,11 @@ import Data.Conduit (($$))
import Control.Monad.Trans.Resource (register)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString.UTF8 (fromString)
-import Data.Conduit.List (sourceList)
+import Data.Conduit.List (sourceList, sinkNull)
import Data.CaseInsensitive (mk)
import Data.List (partition)
+import qualified Data.Conduit.List as CL
+import qualified Data.Conduit.Binary as CB
app :: Application
app req =
@@ -60,6 +63,7 @@ main = hspecX $ do
clearSocketsList
tid1 <- forkIO $ run 3002 app
tid2 <- forkIO $ run 3003 app
+ threadDelay 1000
withManager $ \manager -> do
let Just req1 = parseUrl "http://localhost:3002/"
let Just req2 = parseUrl "http://localhost:3003/"
@@ -73,6 +77,7 @@ main = hspecX $ do
describe "DOS protection" $ do
it "overlong headers" $ do
tid1 <- forkIO overLongHeaders
+ threadDelay 1000
withManager $ \manager -> do
_ <- register $ killThread tid1
let Just req1 = parseUrl "http://localhost:3004/"
@@ -80,9 +85,24 @@ main = hspecX $ do
case res1 of
Left e -> liftIO $ show (e :: SomeException) @?= show OverlongHeaders
_ -> error "Shouldn't have worked"
+ it "not overlong headers" $ do
+ tid1 <- forkIO notOverLongHeaders
+ threadDelay 1000
+ withManager $ \manager -> do
+ _ <- register $ killThread tid1
+ let Just req1 = parseUrl "http://localhost:3005/"
+ _ <- httpLbs req1 manager
+ return ()
overLongHeaders :: IO ()
overLongHeaders = runTCPServer (ServerSettings 3004 HostAny) $ \_ sink ->
src $$ sink
where
src = sourceList $ "HTTP/1.0 200 OK\r\nfoo: " : repeat "bar"
+
+notOverLongHeaders :: IO ()
+notOverLongHeaders = runTCPServer (ServerSettings 3005 HostAny) $ \src' sink -> do
+ src' $$ CL.drop 1
+ src $$ sink
+ where
+ src = sourceList $ [S.concat $ "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 16384\r\n\r\n" : ( take 16384 $ repeat "x")]