@@ -109,7 +109,7 @@ import qualified Timeout as T
109109import Timeout (Manager, registerKillThread, pause, resume)
110110import Data.Word (Word8)
111111import Data.List (foldl')
112−import Control.Monad (forever)
112+import Control.Monad (forever, when)
113113import qualified Network.HTTP.Types as H
114114import qualified Data.CaseInsensitive as CI
115115import System.IO (hPutStrLn, stderr)
@@ -126,13 +126,29 @@ import qualified Paths_warp
126126warpVersion :: String
127127warpVersion = showVersion Paths_warp.version
128128
129+-- |
130+--
131+-- In order to provide slowloris protection, Warp provides timeout handlers. We
132+-- follow these rules:
133+--
134+-- * A timeout is created when a connection is opened.
135+--
136+-- * When all request headers are read, the timeout is tickled.
137+--
138+-- * Every time at least 2048 bytes of the request body are read, the timeout
139+-- is tickled.
140+--
141+-- * The timeout is paused while executing user code. This will apply to both
142+-- the application itself, and a ResponseSource response. The timeout is
143+-- resumed as soon as we return from user code.
144+--
145+-- * Every time data is successfully sent to the client, the timeout is tickled.
129146data Connection = Connection
130147 { connSendMany :: [B.ByteString] -> IO ()
131148 , connSendAll :: B.ByteString -> IO ()
132149 , connSendFile :: FilePath -> Integer -> Integer -> IO () -> IO () -- ^ offset, length
133− , connSink :: T.Handle -> C.Sink B.ByteString IO ()
134150 , connClose :: IO ()
135− , connSource :: T.Handle -> C.Source IO B.ByteString
151+ , connRecv :: IO B.ByteString
136152 }
137153
138154socketConnection :: Socket -> Connection
@@ -140,9 +156,8 @@ socketConnection s = Connection
140156 { connSendMany = Sock.sendMany s
141157 , connSendAll = Sock.sendAll s
142158 , connSendFile = \fp off len act -> sendfile s fp (PartOfFile off len) act
143− , connSink = flip sinkSocket s
144159 , connClose = sClose s
145− , connSource = \th -> C.Source $ return $ sourceSocket th bytesPerRead s
160+ , connRecv = Sock.recv s bytesPerRead
146161 }
147162
148163
@@ -423,6 +438,8 @@ sendResponse th req conn r = sendResponse' r
423438 connSendMany conn $ L.toChunks $ toLazyByteString $
424439 headers version s lengthyHeaders False
425440
441+ T.tickle th
442+
426443 if not (hasBody s req) then return isPersist else do
427444 case mpart of
428445 Nothing -> connSendFile conn fp 0 cl (T.tickle th)
@@ -461,10 +478,11 @@ sendResponse th req conn r = sendResponse' r
461478 -- FIXME perhaps alloca a buffer per thread and reuse that in all
462479 -- functions below. Should lessen greatly the GC burden (I hope)
463480 response
464− | not (hasBody s req) = do
465− liftIO $ connSendMany conn
466− $ L.toChunks $ toLazyByteString
467− $ headers' False
481+ | not (hasBody s req) = liftIO $ do
482+ connSendMany conn
483+ $ L.toChunks $ toLazyByteString
484+ $ headers' False
485+ T.tickle th
468486 return (checkPersist req)
469487 | otherwise = do
470488 let src =
@@ -492,34 +510,29 @@ parseHeaderNoAttr s =
492510 else rest
493511 in (CI.mk k, rest')
494512
495−sourceSocket :: T.Handle -> Int -> Socket -> C.PreparedSource IO ByteString
496−sourceSocket th len socket = C.PreparedSource
513+connSource :: Connection -> T.Handle -> C.PreparedSource IO ByteString
514+connSource Connection { connRecv = recv } th = C.PreparedSource
497515 { C.sourcePull = do
498− bs <- liftIO $ Sock.recv socket len
499− liftIO $ T.tickle th
500− return $ if S.null bs
501− then C.Closed
502− else C.Open bs
516+ bs <- liftIO recv
517+ if S.null bs
518+ then return C.Closed
519+ else do
520+ when (S.length bs >= 2048) $ liftIO $ T.tickle th
521+ return (C.Open bs)
503522 , C.sourceClose = return ()
504523 }
505524
506−------ The functions below are not warp-specific and could be split out into a
507−--separate package.
508−
509−sinkSocket :: T.Handle
510− -> Socket
511− -> C.Sink B.ByteString IO ()
512−sinkSocket th sock = C.Sink $ return $ C.SinkData
525+-- | Use 'connSendAll' to send this data while respecting timeout rules.
526+connSink :: Connection -> T.Handle -> C.Sink B.ByteString IO ()
527+connSink Connection { connSendAll = send } th = C.Sink $ return $ C.SinkData
513528 { C.sinkPush = push
514529 , C.sinkClose = close
515530 }
516531 where
517− close = do
518− liftIO (T.resume th)
519− return ()
532+ close = liftIO (T.resume th)
520533 push x = do
521534 liftIO $ T.resume th
522− liftIO $ Sock.sendAll sock x
535+ liftIO $ send x
523536 liftIO $ T.pause th
524537 return $ C.Processing
525538 -- We pause timeouts before passing control back to user code. This ensures
@@ -527,6 +540,9 @@ sinkSocket th sock = C.Sink $ return $ C.SinkData
527540 -- also make sure to resume the timeout after the completion of user code
528541 -- so that we can kill idle connections.
529542
543+------ The functions below are not warp-specific and could be split out into a
544+--separate package.
545+
530546-- | Various Warp server settings. This is purposely kept as an abstract data
531547-- type so that new settings can be added without breaking backwards
532548-- compatibility. In order to create a 'Settings' value, use 'defaultSettings'