git.iko.soy/typeable/wai
on master help sign in
Code cleanup
commit130be2b31891bcfc0ee9349ee306173856abab5a authorMichael Snoyman <michael@snoyman.com> dateFri 11 Feb 2011, 10:11 (16 years ago) parentaca7bfb
2 files changed+8−73
compare with master
unifiedsplit
Network/Wai/Handler/Warp.hs+6−38 runtests.hs+2−35
Network/Wai/Handler/Warp.hs+6−38
@@ -41,12 +41,11 @@ module Network.Wai.Handler.Warp
4141 , sendResponse
4242 , parseRequest
4343#if TEST
44− , takeLineMax
4544 , takeHeaders
4645#endif
4746 ) where
4847
49−import Prelude hiding (catch)
48+import Prelude hiding (catch, lines)
5049import Network.Wai
5150import qualified System.IO
5251
@@ -181,9 +180,7 @@ parseRequest port remoteHost' = do
181180 parseRequest' port headers' remoteHost'
182181
183182-- FIXME come up with good values here
184−maxHeaders, maxHeaderLength, bytesPerRead, maxTotalHeaderLength :: Int
185−maxHeaders = 30
186−maxHeaderLength = 1024
183+bytesPerRead, maxTotalHeaderLength :: Int
187184bytesPerRead = 4096
188185maxTotalHeaderLength = 50 * 1024
189186
@@ -399,38 +396,6 @@ enumSocket th len socket =
399396------ The functions below are not warp-specific and could be split out into a
400397--separate package.
401398
402−takeUntilBlank :: Int
403− -> ([ByteString] -> [ByteString])
404− -> E.Iteratee S.ByteString IO [ByteString]
405−takeUntilBlank count _
406− | count > maxHeaders = E.throwError TooManyHeaders
407−takeUntilBlank count front = do
408− l <- takeLineMax 0 id
409− if B.null l
410− then return $ front []
411− else takeUntilBlank (count + 1) $ front . (:) l
412−
413−takeLineMax :: Int
414− -> ([ByteString] -> [ByteString])
415− -> E.Iteratee ByteString IO ByteString
416−takeLineMax len front = do
417− mbs <- EL.head
418− case mbs of
419− Nothing -> E.throwError IncompleteHeaders
420− Just bs -> do
421− let (x, y) = S.breakByte 10 bs
422− x' = if S.length x > 0 && S.last x == 13
423− then S.init x
424− else x
425− let len' = len + B.length x
426− case () of
427− ()
428− | len' > maxHeaderLength -> E.throwError OverLargeHeader
429− | B.null y -> takeLineMax len' $ front . (:) x
430− | otherwise -> do
431− E.yield () $ E.Chunks [B.drop 1 y]
432− return $ B.concat $ front [x']
433−
434399iterSocket :: T.Handle
435400 -> Socket
436401 -> E.Iteratee B.ByteString IO ()
@@ -463,6 +428,7 @@ defaultSettings = Settings
463428 go :: InvalidRequest -> IO ()
464429 go _ = return ()
465430
431+takeHeaders :: E.Iteratee ByteString IO [ByteString]
466432takeHeaders = do
467433 !x <- forceHead
468434 takeHeaders' 0 id id x
@@ -515,13 +481,15 @@ takeHeaders' !len !lines !prepend !bs = do
515481 {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more
516482{-# INLINE takeHeaders' #-}
517483
484+forceHead :: E.Iteratee ByteString IO ByteString
518485forceHead = do
519− !mx <- E.head
486+ !mx <- EL.head
520487 case mx of
521488 !Nothing -> E.throwError IncompleteHeaders
522489 Just !x -> return x
523490{-# INLINE forceHead #-}
524491
492+checkCR :: ByteString -> Int -> Int
525493checkCR bs pos =
526494 let !p = pos - 1
527495 in if '\r' == B.index bs p
runtests.hs+2−35
@@ -5,7 +5,7 @@ import Test.Framework (defaultMain, testGroup, Test)
55import Test.Framework.Providers.HUnit
66import Test.HUnit hiding (Test)
77
8−import Network.Wai.Handler.Warp (takeLineMax, takeHeaders, InvalidRequest (..))
8+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
99import Data.Enumerator (run_, ($$), enumList, run)
1010import Control.Exception (fromException)
1111
@@ -14,54 +14,21 @@ main = defaultMain [testSuite]
1414
1515testSuite :: Test
1616testSuite = testGroup "Text.Hamlet"
17− [ testCase "takeLineMax safe" caseTakeLineMaxSafe
18− , testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
19− , testCase "takeLineMax unsafe" caseTakeLineMaxUnsafe
20− , testCase "takeLineMax incomplete" caseTakeLineMaxIncomplete
17+ [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
2118 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
2219 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
2320 ]
2421
25−caseTakeLineMaxSafe = do
26− x <- run_ $ (enumList 1 ["f", "oo\n\n", "bar\n\r\nbaz\n"]) $$ do
27− a <- takeLineMax 0 id
28− b <- takeLineMax 0 id
29− c <- takeLineMax 0 id
30− d <- takeLineMax 0 id
31− e <- takeLineMax 0 id
32− return (a, b, c, d, e)
33− x @?= ("foo", "", "bar", "", "baz")
34−
3522caseTakeUntilBlankSafe = do
3623 x <- run_ $ (enumList 1 ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ takeHeaders
3724 x @?= ["foo", "bar", "baz"]
3825
39−caseTakeLineMaxUnsafe = do
40− x <- run $ (enumList 1 $ repeat "abc") $$ do
41− a <- takeLineMax 0 id
42− b <- takeLineMax 0 id
43− c <- takeLineMax 0 id
44− d <- takeLineMax 0 id
45− e <- takeLineMax 0 id
46− return (a, b, c, d, e)
47− assertException OverLargeHeader x
48−
4926assertException x (Left se) =
5027 case fromException se of
5128 Just e -> e @?= x
5229 Nothing -> assertFailure "Not an exception"
5330assertException _ _ = assertFailure "Not an exception"
5431
55−caseTakeLineMaxIncomplete = do
56− x <- run $ (enumList 1 ["f", "oo\n\n", "bar\n\nbaz"]) $$ do
57− a <- takeLineMax 0 id
58− b <- takeLineMax 0 id
59− c <- takeLineMax 0 id
60− d <- takeLineMax 0 id
61− e <- takeLineMax 0 id
62− return (a, b, c, d, e)
63− assertException IncompleteHeaders x
64−
6532caseTakeUntilBlankTooMany = do
6633 x <- run $ (enumList 1 $ repeat "f\n") $$ takeHeaders
6734 assertException OverLargeHeader x