@@ -9,7 +9,6 @@ module Network.Wai.Handler.Warp.Request (
99 , headerLines
1010 , pauseTimeoutKey
1111 , getFileInfoKey
12− , getClientCertificateKey
1312 , NoKeepAliveRequest (..)
1413 ) where
1514
@@ -22,7 +21,6 @@ import qualified Data.CaseInsensitive as CI
2221import qualified Data.IORef as I
2322import Data.Typeable (Typeable)
2423import qualified Data.Vault.Lazy as Vault
25−import Data.X509
2624import qualified Network.HTTP.Types as H
2725import Network.Socket (SockAddr)
2826import Network.Wai
@@ -38,7 +36,13 @@ import Network.Wai.Handler.Warp.Header
3836import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)
3937import Network.Wai.Handler.Warp.ReadInt
4038import Network.Wai.Handler.Warp.RequestHeader
41−import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)
39+import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath)
40+
41+----------------------------------------------------------------
42+
43+-- FIXME come up with good values here
44+maxTotalHeaderLength :: Int
45+maxTotalHeaderLength = 50 * 1024
4246
4347----------------------------------------------------------------
4448
@@ -62,7 +66,7 @@ recvRequest :: Bool -- ^ first request on this connection?
6266 -- Body producing action used for flushing the request body
6367
6468recvRequest firstRequest settings conn ii th addr src transport = do
65− hdrlines <- headerLines (settingsMaxTotalHeaderLength settings) firstRequest src
69+ hdrlines <- headerLines firstRequest src
6670 (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
6771 let idxhdr = indexRequestHeader hdr
6872 expect = idxhdr ! fromEnum ReqExpect
@@ -72,7 +76,6 @@ recvRequest firstRequest settings conn ii th addr src transport = do
7276 rawPath = if settingsNoParsePath settings then unparsedPath else path
7377 vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
7478 $ Vault.insert getFileInfoKey (getFileInfo ii)
75− $ Vault.insert getClientCertificateKey (tlsClientCertificate transport)
7679 Vault.empty
7780 (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te
7881 -- body producing function which will produce '100-continue', if needed
@@ -101,8 +104,8 @@ recvRequest firstRequest settings conn ii th addr src transport = do
101104
102105----------------------------------------------------------------
103106
104−headerLines :: Int -> Bool -> Source -> IO [ByteString]
105−headerLines maxTotalHeaderLength firstRequest src = do
107+headerLines :: Bool -> Source -> IO [ByteString]
108+headerLines firstRequest src = do
106109 bs <- readSource src
107110 if S.null bs
108111 -- When we're working on a keep-alive connection and trying to
@@ -110,7 +113,7 @@ headerLines maxTotalHeaderLength firstRequest src = do
110113 -- lack of data as a real exception. See the http1 function in
111114 -- the Run module for more details.
112115 then if firstRequest then throwIO ConnectionClosedByPeer else throwIO NoKeepAliveRequest
113− else push maxTotalHeaderLength src (THStatus 0 id id) bs
116+ else push src (THStatus 0 id id) bs
114117
115118data NoKeepAliveRequest = NoKeepAliveRequest
116119 deriving (Show, Typeable)
@@ -220,8 +223,8 @@ close :: Sink ByteString IO a
220223close = throwIO IncompleteHeaders
221224-}
222225
223−push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]
224−push maxTotalHeaderLength src (THStatus len lines prepend) bs'
226+push :: Source -> THStatus -> ByteString -> IO [ByteString]
227+push src (THStatus len lines prepend) bs'
225228 -- Too many bytes
226229 | len > maxTotalHeaderLength = throwIO OverLargeHeader
227230 | otherwise = push' mnl
@@ -249,13 +252,13 @@ push maxTotalHeaderLength src (THStatus len lines prepend) bs'
249252 push' Nothing = do
250253 bst <- readSource' src
251254 when (S.null bst) $ throwIO IncompleteHeaders
252− push maxTotalHeaderLength src status bst
255+ push src status bst
253256 where
254257 len' = len + bsLen
255258 prepend' = S.append bs
256259 status = THStatus len' lines prepend'
257260 -- Found a newline, but next line continues as a multiline header
258− push' (Just (end, True)) = push maxTotalHeaderLength src status rest
261+ push' (Just (end, True)) = push src status rest
259262 where
260263 rest = S.drop (end + 1) bs
261264 prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)
@@ -274,12 +277,12 @@ push maxTotalHeaderLength src (THStatus len lines prepend) bs'
274277 in if start < bsLen then
275278 -- more bytes in this chunk, push again
276279 let bs'' = SU.unsafeDrop start bs
277− in push maxTotalHeaderLength src status bs''
280+ in push src status bs''
278281 else do
279282 -- no more bytes in this chunk, ask for more
280283 bst <- readSource' src
281284 when (S.null bs) $ throwIO IncompleteHeaders
282− push maxTotalHeaderLength src status bst
285+ push src status bst
283286 where
284287 start = end + 1 -- start of next chunk
285288 line = SU.unsafeTake (checkCR bs end) bs
@@ -297,7 +300,3 @@ pauseTimeoutKey = unsafePerformIO Vault.newKey
297300getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)
298301getFileInfoKey = unsafePerformIO Vault.newKey
299302{-# NOINLINE getFileInfoKey #-}
300−
301−getClientCertificateKey :: Vault.Key (Maybe CertificateChain)
302−getClientCertificateKey = unsafePerformIO Vault.newKey
303−{-# NOINLINE getClientCertificateKey #-}