@@ -1,6 +1,7 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE CPP #-}
45---------------------------------------------------------
56-- |
67-- Module : Network.Wai.Handler.Warp
@@ -58,6 +59,7 @@ import Data.Monoid (mconcat)
5859import Network.Socket.SendFile (sendFile)
5960
6061import Control.Monad.IO.Class (liftIO)
62+import System.Timeout (timeout)
6163
6264run :: Port -> Application -> IO ()
6365run port = withSocketsDo .
@@ -102,10 +104,11 @@ parseRequest port remoteHost' = do
102104 parseRequest' port headers' remoteHost'
103105
104106-- FIXME come up with good values here
105−maxHeaders, maxHeaderLength, bytesPerRead :: Int
107+maxHeaders, maxHeaderLength, bytesPerRead, readTimeout :: Int
106108maxHeaders = 30
107109maxHeaderLength = 1024
108110bytesPerRead = 4096
111+readTimeout = 3000000
109112
110113takeUntilBlank :: Int
111114 -> ([ByteString] -> [ByteString])
@@ -146,6 +149,7 @@ data InvalidRequest =
146149 | TooManyHeaders
147150 | IncompleteHeaders
148151 | OverLargeHeader
152+ | SocketTimeout
149153 deriving (Show, Typeable)
150154instance Exception InvalidRequest
151155
@@ -310,8 +314,17 @@ iterSocket socket =
310314 go (E.Chunks cs) = liftIO (Sock.sendMany socket cs) >> E.continue go
311315
312316enumSocket len socket (E.Continue k) = do
317+#if NO_TIMEOUT_PROTECTION
313318 bs <- liftIO $ Sock.recv socket len
314− if S.length bs == 0
315− then E.continue k
316− else k (E.Chunks [bs]) >>== enumSocket len socket
319+ go bs
320+#else
321+ mbs <- liftIO $ timeout readTimeout $ Sock.recv socket len
322+ case mbs of
323+ Nothing -> E.throwError SocketTimeout
324+ Just bs -> go bs
325+#endif
326+ where
327+ go bs
328+ | S.length bs == 0 = E.continue k
329+ | otherwise = k (E.Chunks [bs]) >>== enumSocket len socket
317330enumSocket _ _ step = E.returnI step