@@ -3,53 +3,49 @@
3{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE PackageImports #-}
4{-# LANGUAGE PackageImports #-}
5{-# LANGUAGE PatternGuards #-}
5{-# LANGUAGE PatternGuards #-}
6−{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TupleSections #-}
7{-# LANGUAGE TupleSections #-}
9−{-# LANGUAGE ViewPatterns #-}
10{-# OPTIONS_GHC -fno-warn-deprecations #-}
8{-# OPTIONS_GHC -fno-warn-deprecations #-}
12module Network.Wai.Handler.Warp.Run where
10module Network.Wai.Handler.Warp.Run where
14−import "iproute" Data.IP (toHostAddress, toHostAddress6)
12+#if __GLASGOW_HASKELL__ < 709
13+import Control.Applicative ((<$>))
15import Control.Arrow (first)
15import Control.Arrow (first)
16import qualified Control.Concurrent as Conc (yield)
16import qualified Control.Concurrent as Conc (yield)
17import Control.Exception as E
17import Control.Exception as E
18+import Control.Monad (when, unless, void)
19+import Data.ByteString (ByteString)
18import qualified Data.ByteString as S
20import qualified Data.ByteString as S
19import Data.Char (chr)
21import Data.Char (chr)
22+import "iproute" Data.IP (toHostAddress, toHostAddress6)
20import Data.IORef (IORef, newIORef, readIORef, writeIORef)
23import Data.IORef (IORef, newIORef, readIORef, writeIORef)
21import Data.Streaming.Network (bindPortTCP)
24import Data.Streaming.Network (bindPortTCP)
22import Foreign.C.Error (Errno(..), eCONNABORTED)
25import Foreign.C.Error (Errno(..), eCONNABORTED)
23import GHC.IO.Exception (IOException(..))
26import GHC.IO.Exception (IOException(..))
24−import qualified Network.HTTP2 as H2
27+import Network (sClose, Socket)
25−import Network.Socket (Socket, close, accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))
28+import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))
26−#if MIN_VERSION_network(3,1,1)
27−import Network.Socket (gracefulClose)
29import qualified Network.Socket.ByteString as Sock
29import qualified Network.Socket.ByteString as Sock
30import Network.Wai
30import Network.Wai
31−import Network.Wai.Internal (ResponseReceived (ResponseReceived))
32−import System.Environment (lookupEnv)
33−import qualified System.TimeManager as T
34−import System.Timeout (timeout)
36import Network.Wai.Handler.Warp.Buffer
31import Network.Wai.Handler.Warp.Buffer
37import Network.Wai.Handler.Warp.Counter
32import Network.Wai.Handler.Warp.Counter
38import qualified Network.Wai.Handler.Warp.Date as D
33import qualified Network.Wai.Handler.Warp.Date as D
39import qualified Network.Wai.Handler.Warp.FdCache as F
34import qualified Network.Wai.Handler.Warp.FdCache as F
40import qualified Network.Wai.Handler.Warp.FileInfoCache as I
35import qualified Network.Wai.Handler.Warp.FileInfoCache as I
41−import Network.Wai.Handler.Warp.HTTP2 (http2)
36+import Network.Wai.Handler.Warp.HTTP2 (http2, isHTTP2)
42−import Network.Wai.Handler.Warp.HTTP2.Types (isHTTP2)
43import Network.Wai.Handler.Warp.Header
37import Network.Wai.Handler.Warp.Header
44−import Network.Wai.Handler.Warp.Imports hiding (readInt)
45import Network.Wai.Handler.Warp.ReadInt
38import Network.Wai.Handler.Warp.ReadInt
46import Network.Wai.Handler.Warp.Recv
39import Network.Wai.Handler.Warp.Recv
47import Network.Wai.Handler.Warp.Request
40import Network.Wai.Handler.Warp.Request
48import Network.Wai.Handler.Warp.Response
41import Network.Wai.Handler.Warp.Response
49import Network.Wai.Handler.Warp.SendFile
42import Network.Wai.Handler.Warp.SendFile
50import Network.Wai.Handler.Warp.Settings
43import Network.Wai.Handler.Warp.Settings
44+import qualified Network.Wai.Handler.Warp.Timeout as T
51import Network.Wai.Handler.Warp.Types
45import Network.Wai.Handler.Warp.Types
52−
46+import Network.Wai.Internal (ResponseReceived (ResponseReceived))
47+import System.Environment (getEnvironment)
48+import System.Timeout (timeout)
54#if WINDOWS
50#if WINDOWS
55import Network.Wai.Handler.Warp.Windows
51import Network.Wai.Handler.Warp.Windows
@@ -58,40 +54,27 @@ import Network.Socket (fdSocket)
60-- | Creating 'Connection' for plain HTTP based on a given socket.
56-- | Creating 'Connection' for plain HTTP based on a given socket.
61−socketConnection :: Settings -> Socket -> IO Connection
57+socketConnection :: Socket -> IO Connection
62−#if MIN_VERSION_network(3,1,1)
63−socketConnection set s = do
65−socketConnection _ s = do
58+socketConnection s = do
67 bufferPool <- newBufferPool
59 bufferPool <- newBufferPool
68 writeBuf <- allocateBuffer bufferSize
60 writeBuf <- allocateBuffer bufferSize
69 let sendall = Sock.sendAll s
61 let sendall = Sock.sendAll s
70− isH2 <- newIORef False -- HTTP/1.x
71 return Connection {
62 return Connection {
72 connSendMany = Sock.sendMany s
63 connSendMany = Sock.sendMany s
73 , connSendAll = sendall
64 , connSendAll = sendall
74 , connSendFile = sendFile s writeBuf bufferSize sendall
65 , connSendFile = sendFile s writeBuf bufferSize sendall
75−#if MIN_VERSION_network(3,1,1)
78− let tm = if h2 then settingsGracefulCloseTimeout2 set
79− else settingsGracefulCloseTimeout1 set
83− gracefulClose s tm `E.catch` \(E.SomeException _) -> return ()
85− , connClose = close s
87− , connFree = freeBuffer writeBuf
66+ , connClose = sClose s >> freeBuffer writeBuf
88 , connRecv = receive s bufferPool
67 , connRecv = receive s bufferPool
89 , connRecvBuf = receiveBuf s
68 , connRecvBuf = receiveBuf s
90 , connWriteBuffer = writeBuf
69 , connWriteBuffer = writeBuf
91 , connBufferSize = bufferSize
70 , connBufferSize = bufferSize
73+#if __GLASGOW_HASKELL__ < 702
74+allowInterrupt :: IO ()
75+allowInterrupt = unblock $ return ()
95-- | Run an 'Application' on the given port.
78-- | Run an 'Application' on the given port.
96-- This calls 'runSettings' with 'defaultSettings'.
79-- This calls 'runSettings' with 'defaultSettings'.
97run :: Port -> Application -> IO ()
80run :: Port -> Application -> IO ()
@@ -104,7 +87,7 @@ run p = runSettings defaultSettings { settingsPort = p }
104-- Since 3.0.9
87-- Since 3.0.9
105runEnv :: Port -> Application -> IO ()
88runEnv :: Port -> Application -> IO ()
106runEnv p app = do
89runEnv p app = do
107− mp <- lookupEnv "PORT"
90+ mp <- lookup "PORT" <$> getEnvironment
109 maybe (run p app) runReadPort mp
92 maybe (run p app) runReadPort mp
@@ -121,7 +104,7 @@ runSettings :: Settings -> Application -> IO ()
121runSettings set app = withSocketsDo $
104runSettings set app = withSocketsDo $
123 (bindPortTCP (settingsPort set) (settingsHost set))
106 (bindPortTCP (settingsPort set) (settingsHost set))
125 (\socket -> do
108 (\socket -> do
126 setSocketCloseOnExec socket
109 setSocketCloseOnExec socket
127 runSettingsSocket set socket app)
110 runSettingsSocket set socket app)
@@ -151,10 +134,10 @@ runSettingsSocket set socket app = do
151 setSocketCloseOnExec s
134 setSocketCloseOnExec s
152 -- NoDelay causes an error for AF_UNIX.
135 -- NoDelay causes an error for AF_UNIX.
153 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
136 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
154− conn <- socketConnection set s
137+ conn <- socketConnection s
155 return (conn, sa)
138 return (conn, sa)
157− closeListenSocket = close socket
140+ closeListenSocket = sClose socket
159-- | The connection setup action would be expensive. A good example
142-- | The connection setup action would be expensive. A good example
160-- is initialization of TLS.
143-- is initialization of TLS.
@@ -192,15 +175,15 @@ runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport),
192runSettingsConnectionMakerSecure set getConnMaker app = do
175runSettingsConnectionMakerSecure set getConnMaker app = do
193 settingsBeforeMainLoop set
176 settingsBeforeMainLoop set
194 counter <- newCounter
177 counter <- newCounter
195− withII $ acceptConnection set getConnMaker app counter
178+ withII0 $ acceptConnection set getConnMaker app counter
197− withII action =
180+ withII0 action =
198 withTimeoutManager $ \tm ->
181 withTimeoutManager $ \tm ->
199 D.withDateCache $ \dc ->
182 D.withDateCache $ \dc ->
200 F.withFdCache fdCacheDurationInSeconds $ \fdc ->
183 F.withFdCache fdCacheDurationInSeconds $ \fdc ->
201 I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
184 I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
202− let ii = InternalInfo tm dc fdc fic
185+ let ii0 = InternalInfo0 tm dc fdc fic
203− action ii
186+ action ii0
205 !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
188 !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
206 !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
189 !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
@@ -229,18 +212,13 @@ acceptConnection :: Settings
229 -> IO (IO (Connection, Transport), SockAddr)
212 -> IO (IO (Connection, Transport), SockAddr)
230 -> Application
213 -> Application
231 -> Counter
214 -> Counter
232− -> InternalInfo
215+ -> InternalInfo0
234−acceptConnection set getConnMaker app counter ii = do
217+acceptConnection set getConnMaker app counter ii0 = do
235 -- First mask all exceptions in acceptLoop. This is necessary to
218 -- First mask all exceptions in acceptLoop. This is necessary to
236 -- ensure that no async exception is throw between the call to
219 -- ensure that no async exception is throw between the call to
237 -- acceptNewConnection and the registering of connClose.
220 -- acceptNewConnection and the registering of connClose.
239− -- acceptLoop can be broken by closing the listing socket.
240 void $ mask_ acceptLoop
221 void $ mask_ acceptLoop
241− -- In some cases, we want to stop Warp here without graceful shutdown.
242− -- So, async exceptions are allowed here.
243− -- That's why `finally` is not used.
244 gracefulShutdown set counter
222 gracefulShutdown set counter
246 acceptLoop = do
224 acceptLoop = do
@@ -258,7 +236,7 @@ acceptConnection set getConnMaker app counter ii = do
258 case mx of
236 case mx of
259 Nothing -> return ()
237 Nothing -> return ()
260 Just (mkConn, addr) -> do
238 Just (mkConn, addr) -> do
261− fork set mkConn addr app counter ii
239+ fork set mkConn addr app counter ii0
262 acceptLoop
240 acceptLoop
264 acceptNewConnection = do
242 acceptNewConnection = do
@@ -281,55 +259,54 @@ fork :: Settings
281 -> SockAddr
259 -> SockAddr
282 -> Application
260 -> Application
283 -> Counter
261 -> Counter
284− -> InternalInfo
262+ -> InternalInfo0
286−fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
264+fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
287− -- Call the user-supplied on exception code if any
288− -- exceptions are thrown.
289− handle (settingsOnException set Nothing) $
290− -- Run the connection maker to get a new connection, and ensure
265+ -- Run the connection maker to get a new connection, and ensure
291− -- that the connection is closed. If the mkConn call throws an
266+ -- that the connection is closed. If the mkConn call throws an
292− -- exception, we will leak the connection. If the mkConn call is
267+ -- exception, we will leak the connection. If the mkConn call is
293− -- vulnerable to attacks (e.g., Slowloris), we do nothing to
268+ -- vulnerable to attacks (e.g., Slowloris), we do nothing to
294− -- protect the server. It is therefore vital that mkConn is well
269+ -- protect the server. It is therefore vital that mkConn is well
295− -- vetted.
270+ -- vetted.
297− -- We grab the connection before registering timeouts since the
272+ -- We grab the connection before registering timeouts since the
298− -- timeouts will be useless during connection creation, due to the
273+ -- timeouts will be useless during connection creation, due to the
299− -- fact that async exceptions are still masked.
274+ -- fact that async exceptions are still masked.
300− bracket mkConn cleanUp (serve unmask)
275+ bracket mkConn closeConn $ \(conn, transport) ->
302− cleanUp (conn, _) = connClose conn `finally` connFree conn
304 -- We need to register a timeout handler for this thread, and
277 -- We need to register a timeout handler for this thread, and
305 -- cancel that handler as soon as we exit.
278 -- cancel that handler as soon as we exit.
306− serve unmask (conn, transport) = bracket register cancel $ \th -> do
279+ bracket (T.registerKillThread (timeoutManager0 ii0)) T.cancel $ \th ->
281+ let ii1 = toInternalInfo1 ii0 th
307− -- We now have fully registered a connection close handler in
282+ -- We now have fully registered a connection close handler
308− -- the case of all exceptions, so it is safe to once again
283+ -- in the case of all exceptions, so it is safe to one
309− -- allow async exceptions.
284+ -- again allow async exceptions.
310− unmask .
285+ in unmask .
286+ -- Call the user-supplied on exception code if any
287+ -- exceptions are thrown.
288+ handle (settingsOnException set Nothing) .
311− -- Call the user-supplied code for connection open and
290+ -- Call the user-supplied code for connection open and close events
313− bracket (onOpen addr) (onClose addr) $ \goingon ->
291+ bracket (onOpen addr) (onClose addr) $ \goingon ->
314− -- Actually serve this connection. bracket with closeConn
293+ -- Actually serve this connection.
315− -- above ensures the connection is closed.
294+ -- bracket with closeConn above ensures the connection is closed.
316− when goingon $ serveConnection conn ii th addr transport set app
295+ when goingon $ serveConnection conn ii1 addr transport set app
318− register = T.registerKillThread (timeoutManager ii) (connClose conn)
297+ closeConn (conn, _transport) = connClose conn
321 onOpen adr = increase counter >> settingsOnOpen set adr
299 onOpen adr = increase counter >> settingsOnOpen set adr
322 onClose adr _ = decrease counter >> settingsOnClose set adr
300 onClose adr _ = decrease counter >> settingsOnClose set adr
324serveConnection :: Connection
302serveConnection :: Connection
325− -> InternalInfo
303+ -> InternalInfo1
327 -> SockAddr
304 -> SockAddr
328 -> Transport
305 -> Transport
329 -> Settings
306 -> Settings
330 -> Application
307 -> Application
332−serveConnection conn ii th origAddr transport settings app = do
309+serveConnection conn ii1 origAddr transport settings app = do
333 -- fixme: Upgrading to HTTP/2 should be supported.
310 -- fixme: Upgrading to HTTP/2 should be supported.
334 (h2,bs) <- if isHTTP2 transport then
311 (h2,bs) <- if isHTTP2 transport then
335 return (True, "")
312 return (True, "")
@@ -339,39 +316,19 @@ serveConnection conn ii th origAddr transport settings app = do
339 return (True, bs0)
316 return (True, bs0)
341 return (False, bs0)
318 return (False, bs0)
342− istatus <- newIORef False
343 if settingsHTTP2Enabled settings && h2 then do
319 if settingsHTTP2Enabled settings && h2 then do
344− rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
320+ recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
345− -- This thread becomes the sender in http2 library.
346− -- In the case of event source, one request comes and one
347− -- worker gets busy. But it is likely that the receiver does
348− -- not receive any data at all while the sender is sending
349− -- output data from the worker. It's not good enough to tickle
350− -- the time handler in the receiver only. So, we should tickle
351− -- the time handler in both the receiver and the sender.
352− let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN
353− sendBS x = connSendAll conn x >> T.tickle th
354 -- fixme: origAddr
321 -- fixme: origAddr
356− setConnHTTP2 conn True
357− http2 conn transport ii origAddr settings recvN sendBS app
322+ http2 conn ii1 origAddr transport settings recvN app
324+ istatus <- newIORef False
359 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
325 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
360 writeIORef istatus True
326 writeIORef istatus True
361 leftoverSource src bs
327 leftoverSource src bs
362 addr <- getProxyProtocolAddr src
328 addr <- getProxyProtocolAddr src
363− http1 True addr istatus src `E.catch` \e ->
329+ http1 addr istatus src `E.catch` \e -> do
366− -- See comment below referencing
367− -- https://github.com/yesodweb/wai/issues/618
368− | Just NoKeepAliveRequest <- fromException e -> return ()
370− | Just (BadFirstLine _) <- fromException e -> return ()
372− _ <- sendErrorResponse (dummyreq addr) istatus e
330+ sendErrorResponse addr istatus e
373− throwIO e
331+ throwIO (e :: SomeException)
376 getProxyProtocolAddr src =
333 getProxyProtocolAddr src =
377 case settingsProxyProtocol settings of
334 case settingsProxyProtocol settings of
@@ -413,40 +370,36 @@ serveConnection conn ii th origAddr transport settings app = do
414 decodeAscii = map (chr . fromEnum) . S.unpack
371 decodeAscii = map (chr . fromEnum) . S.unpack
373+ th = threadHandle1 ii1
416 shouldSendErrorResponse se
375 shouldSendErrorResponse se
417 | Just ConnectionClosedByPeer <- fromException se = False
376 | Just ConnectionClosedByPeer <- fromException se = False
418 | otherwise = True
377 | otherwise = True
420− sendErrorResponse req istatus e = do
379+ sendErrorResponse addr istatus e = do
421 status <- readIORef istatus
380 status <- readIORef istatus
422− if shouldSendErrorResponse e && status
381+ when (shouldSendErrorResponse e && status) $ do
423− then do
382+ let ii = toInternalInfo ii1 0 -- dummy
383+ dreq = dummyreq addr
424− sendResponse settings conn ii th req defaultIndexRequestHeader (return S.empty) (errorResponse e)
384+ void $ sendResponse settings conn ii dreq defaultIndexRequestHeader (return S.empty) (errorResponse e)
427 dummyreq addr = defaultRequest { remoteHost = addr }
386 dummyreq addr = defaultRequest { remoteHost = addr }
429 errorResponse e = settingsOnExceptionResponse settings e
388 errorResponse e = settingsOnExceptionResponse settings e
431− http1 firstRequest addr istatus src = do
390+ http1 addr istatus src = do
432− (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport
391+ (req', mremainingRef, idxhdr, nextBodyFlush, ii) <- recvRequest settings conn ii1 addr src
392+ let req = req' { isSecure = isTransportSecure transport }
433− keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush
393+ keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii
434 `E.catch` \e -> do
394 `E.catch` \e -> do
395+ -- Call the user-supplied exception handlers, passing the request.
396+ sendErrorResponse addr istatus e
435 settingsOnException settings (Just req) e
397 settingsOnException settings (Just req) e
436 -- Don't throw the error again to prevent calling settingsOnException twice.
398 -- Don't throw the error again to prevent calling settingsOnException twice.
437 return False
399 return False
400+ when keepAlive $ http1 addr istatus src
439− -- When doing a keep-alive connection, the other side may just
440− -- close the connection. We don't want to treat that as an
441− -- exceptional situation, so we pass in False to http1 (which
442− -- in turn passes in False to recvRequest), indicating that
443− -- this is not the first request. If, when trying to read the
444− -- request headers, no data is available, recvRequest will
445− -- throw a NoKeepAliveRequest exception, which we catch here
446− -- and ignore. See: https://github.com/yesodweb/wai/issues/618
447− when keepAlive $ http1 False addr istatus src
449− processRequest istatus src req mremainingRef idxhdr nextBodyFlush = do
402+ processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii = do
450 -- Let the application run for as long as it wants
403 -- Let the application run for as long as it wants
451 T.pause th
404 T.pause th
@@ -454,38 +407,30 @@ serveConnection conn ii th origAddr transport settings app = do
454 -- creating the request, we need to make sure that we don't get
407 -- creating the request, we need to make sure that we don't get
455 -- an async exception before calling the ResponseSource.
408 -- an async exception before calling the ResponseSource.
456 keepAliveRef <- newIORef $ error "keepAliveRef not filled"
409 keepAliveRef <- newIORef $ error "keepAliveRef not filled"
457− r <- E.try $ app req $ \res -> do
410+ _ <- app req $ \res -> do
458 T.resume th
411 T.resume th
459 -- FIXME consider forcing evaluation of the res here to
412 -- FIXME consider forcing evaluation of the res here to
460 -- send more meaningful error messages to the user.
413 -- send more meaningful error messages to the user.
461 -- However, it may affect performance.
414 -- However, it may affect performance.
462 writeIORef istatus False
415 writeIORef istatus False
463− keepAlive <- sendResponse settings conn ii th req idxhdr (readSource src) res
416+ keepAlive <- sendResponse settings conn ii req idxhdr (readSource src) res
464 writeIORef keepAliveRef keepAlive
417 writeIORef keepAliveRef keepAlive
465 return ResponseReceived
418 return ResponseReceived
467− Right ResponseReceived -> return ()
468− Left e@(SomeException _)
469− | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e'
471− keepAlive <- sendErrorResponse req istatus e
472− settingsOnException settings (Just req) e
473− writeIORef keepAliveRef keepAlive
475 keepAlive <- readIORef keepAliveRef
419 keepAlive <- readIORef keepAliveRef
477 -- We just send a Response and it takes a time to
421 -- We just send a Response and it takes a time to
478 -- receive a Request again. If we immediately call recv,
422 -- receive a Request again. If we immediately call recv,
479− -- it is likely to fail and cause the IO manager to do some work.
423+ -- it is likely to fail and the IO manager works.
480− -- It is very costly, so we yield to another Haskell
424+ -- It is very costly. So, we yield to another Haskell
481 -- thread hoping that the next Request will arrive
425 -- thread hoping that the next Request will arrive
482 -- when this Haskell thread will be re-scheduled.
426 -- when this Haskell thread will be re-scheduled.
483 -- This improves performance at least when
427 -- This improves performance at least when
484 -- the number of cores is small.
428 -- the number of cores is small.
485 Conc.yield
429 Conc.yield
487− if keepAlive
431+ if not keepAlive then
488− then
432+ return False
489 -- If there is an unknown or large amount of data to still be read
434 -- If there is an unknown or large amount of data to still be read
490 -- from the request body, simple drop this connection instead of
435 -- from the request body, simple drop this connection instead of
491 -- reading it all in to satisfy a keep-alive request.
436 -- reading it all in to satisfy a keep-alive request.
@@ -511,21 +456,6 @@ serveConnection conn ii th origAddr transport settings app = do
512 return False
457 return False
513 Nothing -> tryKeepAlive
458 Nothing -> tryKeepAlive
517− checkTLS = case transport of
518− TCP -> return () -- direct
519− tls -> unless (tls12orLater tls) $ goaway conn H2.InadequateSecurity "Weak TLS"
520− tls12orLater tls = tlsMajorVersion tls == 3 && tlsMinorVersion tls >= 3
522−-- connClose must not be called here since Run:fork calls it
523−goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()
524−goaway Connection{..} etype debugmsg = connSendAll bytestream
526− einfo = H2.encodeInfo id 0
527− frame = H2.GoAwayFrame 0 etype debugmsg
528− bytestream = H2.encodeFrame einfo frame
530flushEntireBody :: IO ByteString -> IO ()
460flushEntireBody :: IO ByteString -> IO ()
531flushEntireBody src =
461flushEntireBody src =
@@ -558,35 +488,12 @@ wrappedRecv Connection { connRecv = recv } th istatus slowlorisSize = do
558 when (S.length bs >= slowlorisSize) $ T.tickle th
488 when (S.length bs >= slowlorisSize) $ T.tickle th
559 return bs
489 return bs
561−wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString)
562−wrappedRecvN th istatus slowlorisSize readN bufsize = do
564− unless (S.null bs) $ do
565− writeIORef istatus True
566− -- TODO: think about the slowloris protection in HTTP2: current code
567− -- might open a slow-loris attack vector. Rather than timing we should
568− -- consider limiting the per-client connections assuming that in HTTP2
569− -- we should allow only few connections per host (real-world
570− -- deployments with large NATs may be trickier).
571− when (S.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th
574−-- | Set flag FileCloseOnExec flag on a socket (on Unix)
576-- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs
491-- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs
579setSocketCloseOnExec :: Socket -> IO ()
492setSocketCloseOnExec :: Socket -> IO ()
580#if WINDOWS
493#if WINDOWS
581setSocketCloseOnExec _ = return ()
494setSocketCloseOnExec _ = return ()
583−setSocketCloseOnExec socket = do
584−#if MIN_VERSION_network(3,0,0)
585− fd <- fdSocket socket
587− let fd = fdSocket socket
589− F.setFileCloseOnExec $ fromIntegral fd
496+setSocketCloseOnExec socket = F.setFileCloseOnExec $ fromIntegral $ fdSocket socket
592gracefulShutdown :: Settings -> Counter -> IO ()
499gracefulShutdown :: Settings -> Counter -> IO ()