git.iko.soy/typeable/wai
on master help sign in
Code cleanup
130be2bMichael Snoyman
Network/Wai/Handler/Warp.hs+6−38
compare with master
unifiedsplit
@@ -41,12 +41,11 @@ module Network.Wai.Handler.Warp
41 , sendResponse
41 , sendResponse
42 , parseRequest
42 , parseRequest
43#if TEST
43#if TEST
44− , takeLineMax
45 , takeHeaders
44 , takeHeaders
46#endif
45#endif
47 ) where
46 ) where
48
47
49−import Prelude hiding (catch)
48+import Prelude hiding (catch, lines)
50import Network.Wai
49import Network.Wai
51import qualified System.IO
50import qualified System.IO
52
51
@@ -181,9 +180,7 @@ parseRequest port remoteHost' = do
181 parseRequest' port headers' remoteHost'
180 parseRequest' port headers' remoteHost'
182
181
183-- FIXME come up with good values here
182-- FIXME come up with good values here
184−maxHeaders, maxHeaderLength, bytesPerRead, maxTotalHeaderLength :: Int
183+bytesPerRead, maxTotalHeaderLength :: Int
185−maxHeaders = 30
186−maxHeaderLength = 1024
187bytesPerRead = 4096
184bytesPerRead = 4096
188maxTotalHeaderLength = 50 * 1024
185maxTotalHeaderLength = 50 * 1024
189
186
@@ -399,38 +396,6 @@ enumSocket th len socket =
399------ The functions below are not warp-specific and could be split out into a
396------ The functions below are not warp-specific and could be split out into a
400--separate package.
397--separate package.
401
398
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−
434iterSocket :: T.Handle
399iterSocket :: T.Handle
435 -> Socket
400 -> Socket
436 -> E.Iteratee B.ByteString IO ()
401 -> E.Iteratee B.ByteString IO ()
@@ -463,6 +428,7 @@ defaultSettings = Settings
463 go :: InvalidRequest -> IO ()
428 go :: InvalidRequest -> IO ()
464 go _ = return ()
429 go _ = return ()
465
430
431+takeHeaders :: E.Iteratee ByteString IO [ByteString]
466takeHeaders = do
432takeHeaders = do
467 !x <- forceHead
433 !x <- forceHead
468 takeHeaders' 0 id id x
434 takeHeaders' 0 id id x
@@ -515,13 +481,15 @@ takeHeaders' !len !lines !prepend !bs = do
515 {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more
481 {-# SCC "takeHeaders'.takeMore" #-} takeHeaders' len' lines' id more
516{-# INLINE takeHeaders' #-}
482{-# INLINE takeHeaders' #-}
517
483
484+forceHead :: E.Iteratee ByteString IO ByteString
518forceHead = do
485forceHead = do
519− !mx <- E.head
486+ !mx <- EL.head
520 case mx of
487 case mx of
521 !Nothing -> E.throwError IncompleteHeaders
488 !Nothing -> E.throwError IncompleteHeaders
522 Just !x -> return x
489 Just !x -> return x
523{-# INLINE forceHead #-}
490{-# INLINE forceHead #-}
524
491
492+checkCR :: ByteString -> Int -> Int
525checkCR bs pos =
493checkCR bs pos =
526 let !p = pos - 1
494 let !p = pos - 1
527 in if '\r' == B.index bs p
495 in if '\r' == B.index bs p
runtests.hs+2−35
@@ -5,7 +5,7 @@ import Test.Framework (defaultMain, testGroup, Test)
5import Test.Framework.Providers.HUnit
5import Test.Framework.Providers.HUnit
6import Test.HUnit hiding (Test)
6import Test.HUnit hiding (Test)
7
7
8−import Network.Wai.Handler.Warp (takeLineMax, takeHeaders, InvalidRequest (..))
8+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
9import Data.Enumerator (run_, ($$), enumList, run)
9import Data.Enumerator (run_, ($$), enumList, run)
10import Control.Exception (fromException)
10import Control.Exception (fromException)
11
11
@@ -14,54 +14,21 @@ main = defaultMain [testSuite]
14
14
15testSuite :: Test
15testSuite :: Test
16testSuite = testGroup "Text.Hamlet"
16testSuite = testGroup "Text.Hamlet"
17− [ testCase "takeLineMax safe" caseTakeLineMaxSafe
18− , testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
17+ [ testCase "takeUntilBlank safe" caseTakeUntilBlankSafe
19− , testCase "takeLineMax unsafe" caseTakeLineMaxUnsafe
20− , testCase "takeLineMax incomplete" caseTakeLineMaxIncomplete
21 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
18 , testCase "takeUntilBlank too many lines" caseTakeUntilBlankTooMany
22 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
19 , testCase "takeUntilBlank too large" caseTakeUntilBlankTooLarge
23 ]
20 ]
24
21
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−
35caseTakeUntilBlankSafe = do
22caseTakeUntilBlankSafe = do
36 x <- run_ $ (enumList 1 ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ takeHeaders
23 x <- run_ $ (enumList 1 ["f", "oo\n", "bar\nbaz\n\r\n"]) $$ takeHeaders
37 x @?= ["foo", "bar", "baz"]
24 x @?= ["foo", "bar", "baz"]
38
25
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−
49assertException x (Left se) =
26assertException x (Left se) =
50 case fromException se of
27 case fromException se of
51 Just e -> e @?= x
28 Just e -> e @?= x
52 Nothing -> assertFailure "Not an exception"
29 Nothing -> assertFailure "Not an exception"
53assertException _ _ = assertFailure "Not an exception"
30assertException _ _ = assertFailure "Not an exception"
54
31
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−
65caseTakeUntilBlankTooMany = do
32caseTakeUntilBlankTooMany = do
66 x <- run $ (enumList 1 $ repeat "f\n") $$ takeHeaders
33 x <- run $ (enumList 1 $ repeat "f\n") $$ takeHeaders
67 assertException OverLargeHeader x
34 assertException OverLargeHeader x