@@ -3,53 +3,50 @@
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 (Socket)
25−import Network.Socket (Socket, close, accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))
28+import Network.Socket (close, 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)
38+import Network.Wai.Handler.Warp.IORef
45import Network.Wai.Handler.Warp.ReadInt
39import Network.Wai.Handler.Warp.ReadInt
46import Network.Wai.Handler.Warp.Recv
40import Network.Wai.Handler.Warp.Recv
47import Network.Wai.Handler.Warp.Request
41import Network.Wai.Handler.Warp.Request
48import Network.Wai.Handler.Warp.Response
42import Network.Wai.Handler.Warp.Response
49import Network.Wai.Handler.Warp.SendFile
43import Network.Wai.Handler.Warp.SendFile
50import Network.Wai.Handler.Warp.Settings
44import Network.Wai.Handler.Warp.Settings
45+import qualified Network.Wai.Handler.Warp.Timeout as T
51import Network.Wai.Handler.Warp.Types
46import Network.Wai.Handler.Warp.Types
52−
47+import Network.Wai.Internal (ResponseReceived (ResponseReceived))
48+import System.Environment (getEnvironment)
49+import System.Timeout (timeout)
54#if WINDOWS
51#if WINDOWS
55import Network.Wai.Handler.Warp.Windows
52import Network.Wai.Handler.Warp.Windows
@@ -58,40 +55,28 @@ import Network.Socket (fdSocket)
60-- | Creating 'Connection' for plain HTTP based on a given socket.
57-- | Creating 'Connection' for plain HTTP based on a given socket.
61−socketConnection :: Settings -> Socket -> IO Connection
58+socketConnection :: Socket -> IO Connection
62−#if MIN_VERSION_network(3,1,1)
63−socketConnection set s = do
65−socketConnection _ s = do
59+socketConnection s = do
67 bufferPool <- newBufferPool
60 bufferPool <- newBufferPool
68 writeBuf <- allocateBuffer bufferSize
61 writeBuf <- allocateBuffer bufferSize
69 let sendall = Sock.sendAll s
62 let sendall = Sock.sendAll s
70− isH2 <- newIORef False -- HTTP/1.x
71 return Connection {
63 return Connection {
72 connSendMany = Sock.sendMany s
64 connSendMany = Sock.sendMany s
73 , connSendAll = sendall
65 , connSendAll = sendall
74 , connSendFile = sendFile s writeBuf bufferSize sendall
66 , 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
67 , connClose = close s
87 , connFree = freeBuffer writeBuf
68 , connFree = freeBuffer writeBuf
88 , connRecv = receive s bufferPool
69 , connRecv = receive s bufferPool
89 , connRecvBuf = receiveBuf s
70 , connRecvBuf = receiveBuf s
90 , connWriteBuffer = writeBuf
71 , connWriteBuffer = writeBuf
91 , connBufferSize = bufferSize
72 , connBufferSize = bufferSize
75+#if __GLASGOW_HASKELL__ < 702
76+allowInterrupt :: IO ()
77+allowInterrupt = unblock $ return ()
95-- | Run an 'Application' on the given port.
80-- | Run an 'Application' on the given port.
96-- This calls 'runSettings' with 'defaultSettings'.
81-- This calls 'runSettings' with 'defaultSettings'.
97run :: Port -> Application -> IO ()
82run :: Port -> Application -> IO ()
@@ -104,7 +89,7 @@ run p = runSettings defaultSettings { settingsPort = p }
104-- Since 3.0.9
89-- Since 3.0.9
105runEnv :: Port -> Application -> IO ()
90runEnv :: Port -> Application -> IO ()
106runEnv p app = do
91runEnv p app = do
107− mp <- lookupEnv "PORT"
92+ mp <- lookup "PORT" <$> getEnvironment
109 maybe (run p app) runReadPort mp
94 maybe (run p app) runReadPort mp
@@ -151,7 +136,7 @@ runSettingsSocket set socket app = do
151 setSocketCloseOnExec s
136 setSocketCloseOnExec s
152 -- NoDelay causes an error for AF_UNIX.
137 -- NoDelay causes an error for AF_UNIX.
153 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
138 setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return ()
154− conn <- socketConnection set s
139+ conn <- socketConnection s
155 return (conn, sa)
140 return (conn, sa)
157 closeListenSocket = close socket
142 closeListenSocket = close socket
@@ -192,15 +177,15 @@ runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Transport),
192runSettingsConnectionMakerSecure set getConnMaker app = do
177runSettingsConnectionMakerSecure set getConnMaker app = do
193 settingsBeforeMainLoop set
178 settingsBeforeMainLoop set
194 counter <- newCounter
179 counter <- newCounter
195− withII $ acceptConnection set getConnMaker app counter
180+ withII0 $ acceptConnection set getConnMaker app counter
197− withII action =
182+ withII0 action =
198 withTimeoutManager $ \tm ->
183 withTimeoutManager $ \tm ->
199 D.withDateCache $ \dc ->
184 D.withDateCache $ \dc ->
200 F.withFdCache fdCacheDurationInSeconds $ \fdc ->
185 F.withFdCache fdCacheDurationInSeconds $ \fdc ->
201 I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
186 I.withFileInfoCache fdFileInfoDurationInSeconds $ \fic -> do
202− let ii = InternalInfo tm dc fdc fic
187+ let ii0 = InternalInfo0 tm dc fdc fic
203− action ii
188+ action ii0
205 !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
190 !fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
206 !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
191 !fdFileInfoDurationInSeconds = settingsFileInfoCacheDuration set * 1000000
@@ -229,18 +214,13 @@ acceptConnection :: Settings
229 -> IO (IO (Connection, Transport), SockAddr)
214 -> IO (IO (Connection, Transport), SockAddr)
230 -> Application
215 -> Application
231 -> Counter
216 -> Counter
232− -> InternalInfo
217+ -> InternalInfo0
234−acceptConnection set getConnMaker app counter ii = do
219+acceptConnection set getConnMaker app counter ii0 = do
235 -- First mask all exceptions in acceptLoop. This is necessary to
220 -- First mask all exceptions in acceptLoop. This is necessary to
236 -- ensure that no async exception is throw between the call to
221 -- ensure that no async exception is throw between the call to
237 -- acceptNewConnection and the registering of connClose.
222 -- acceptNewConnection and the registering of connClose.
239− -- acceptLoop can be broken by closing the listing socket.
240 void $ mask_ acceptLoop
223 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
224 gracefulShutdown set counter
246 acceptLoop = do
226 acceptLoop = do
@@ -258,7 +238,7 @@ acceptConnection set getConnMaker app counter ii = do
258 case mx of
238 case mx of
259 Nothing -> return ()
239 Nothing -> return ()
260 Just (mkConn, addr) -> do
240 Just (mkConn, addr) -> do
261− fork set mkConn addr app counter ii
241+ fork set mkConn addr app counter ii0
262 acceptLoop
242 acceptLoop
264 acceptNewConnection = do
244 acceptNewConnection = do
@@ -281,55 +261,65 @@ fork :: Settings
281 -> SockAddr
261 -> SockAddr
282 -> Application
262 -> Application
283 -> Counter
263 -> Counter
284− -> InternalInfo
264+ -> InternalInfo0
286−fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
266+fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
287− -- Call the user-supplied on exception code if any
267+ -- Allocate a new IORef indicating whether the connection has been
288− -- exceptions are thrown.
268+ -- closed, to avoid double-freeing a connection
289− handle (settingsOnException set Nothing) $
269+ withClosedRef $ \ref ->
290− -- Run the connection maker to get a new connection, and ensure
271+ -- Run the connection maker to get a new connection, and ensure
291− -- that the connection is closed. If the mkConn call throws an
272+ -- that the connection is closed. If the mkConn call throws an
292− -- exception, we will leak the connection. If the mkConn call is
273+ -- exception, we will leak the connection. If the mkConn call is
293− -- vulnerable to attacks (e.g., Slowloris), we do nothing to
274+ -- vulnerable to attacks (e.g., Slowloris), we do nothing to
294− -- protect the server. It is therefore vital that mkConn is well
275+ -- protect the server. It is therefore vital that mkConn is well
295− -- vetted.
276+ -- vetted.
297− -- We grab the connection before registering timeouts since the
278+ -- We grab the connection before registering timeouts since the
298− -- timeouts will be useless during connection creation, due to the
279+ -- timeouts will be useless during connection creation, due to the
299− -- fact that async exceptions are still masked.
280+ -- fact that async exceptions are still masked.
300− bracket mkConn cleanUp (serve unmask)
302− cleanUp (conn, _) = connClose conn `finally` connFree conn
281+ bracket mkConn (\(conn, _) -> closeConn ref conn `finally` connFree conn)
282+ $ \(conn, transport) ->
304 -- We need to register a timeout handler for this thread, and
284 -- We need to register a timeout handler for this thread, and
305− -- cancel that handler as soon as we exit.
285+ -- cancel that handler as soon as we exit. We additionally close
306− serve unmask (conn, transport) = bracket register cancel $ \th -> do
286+ -- the connection immediately in case the child thread catches the
287+ -- async exception or performs some long-running cleanup action.
288+ bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn)) T.cancel $ \th ->
290+ let ii1 = toInternalInfo1 ii0 th
307− -- We now have fully registered a connection close handler in
291+ -- We now have fully registered a connection close handler
308− -- the case of all exceptions, so it is safe to once again
292+ -- in the case of all exceptions, so it is safe to one
309− -- allow async exceptions.
293+ -- again allow async exceptions.
310− unmask .
294+ in unmask .
295+ -- Call the user-supplied on exception code if any
296+ -- exceptions are thrown.
297+ handle (settingsOnException set Nothing) .
311− -- Call the user-supplied code for connection open and
299+ -- Call the user-supplied code for connection open and close events
313− bracket (onOpen addr) (onClose addr) $ \goingon ->
300+ bracket (onOpen addr) (onClose addr) $ \goingon ->
314− -- Actually serve this connection. bracket with closeConn
302+ -- Actually serve this connection.
315− -- above ensures the connection is closed.
303+ -- bracket with closeConn above ensures the connection is closed.
316− when goingon $ serveConnection conn ii th addr transport set app
304+ when goingon $ serveConnection conn ii1 addr transport set app
318− register = T.registerKillThread (timeoutManager ii) (connClose conn)
306+ withClosedRef inner = newIORef False >>= inner
319− cancel = T.cancel
307+
308+ closeConn ref conn = do
309+ isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
310+ unless isClosed $ connClose conn
321 onOpen adr = increase counter >> settingsOnOpen set adr
312 onOpen adr = increase counter >> settingsOnOpen set adr
322 onClose adr _ = decrease counter >> settingsOnClose set adr
313 onClose adr _ = decrease counter >> settingsOnClose set adr
324serveConnection :: Connection
315serveConnection :: Connection
325− -> InternalInfo
316+ -> InternalInfo1
327 -> SockAddr
317 -> SockAddr
328 -> Transport
318 -> Transport
329 -> Settings
319 -> Settings
330 -> Application
320 -> Application
332−serveConnection conn ii th origAddr transport settings app = do
322+serveConnection conn ii1 origAddr transport settings app = do
333 -- fixme: Upgrading to HTTP/2 should be supported.
323 -- fixme: Upgrading to HTTP/2 should be supported.
334 (h2,bs) <- if isHTTP2 transport then
324 (h2,bs) <- if isHTTP2 transport then
335 return (True, "")
325 return (True, "")
@@ -339,39 +329,19 @@ serveConnection conn ii th origAddr transport settings app = do
339 return (True, bs0)
329 return (True, bs0)
341 return (False, bs0)
331 return (False, bs0)
342− istatus <- newIORef False
343 if settingsHTTP2Enabled settings && h2 then do
332 if settingsHTTP2Enabled settings && h2 then do
344− rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
333+ 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
334 -- fixme: origAddr
356− setConnHTTP2 conn True
357− http2 conn transport ii origAddr settings recvN sendBS app
335+ http2 conn ii1 origAddr transport settings recvN app
337+ istatus <- newIORef False
359 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
338 src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))
360 writeIORef istatus True
339 writeIORef istatus True
361 leftoverSource src bs
340 leftoverSource src bs
362 addr <- getProxyProtocolAddr src
341 addr <- getProxyProtocolAddr src
363− http1 True addr istatus src `E.catch` \e ->
342+ 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
343+ sendErrorResponse addr istatus e
373− throwIO e
344+ throwIO (e :: SomeException)
376 getProxyProtocolAddr src =
346 getProxyProtocolAddr src =
377 case settingsProxyProtocol settings of
347 case settingsProxyProtocol settings of
@@ -413,40 +383,36 @@ serveConnection conn ii th origAddr transport settings app = do
414 decodeAscii = map (chr . fromEnum) . S.unpack
384 decodeAscii = map (chr . fromEnum) . S.unpack
386+ th = threadHandle1 ii1
416 shouldSendErrorResponse se
388 shouldSendErrorResponse se
417 | Just ConnectionClosedByPeer <- fromException se = False
389 | Just ConnectionClosedByPeer <- fromException se = False
418 | otherwise = True
390 | otherwise = True
420− sendErrorResponse req istatus e = do
392+ sendErrorResponse addr istatus e = do
421 status <- readIORef istatus
393 status <- readIORef istatus
422− if shouldSendErrorResponse e && status
394+ when (shouldSendErrorResponse e && status) $ do
423− then do
395+ let ii = toInternalInfo ii1 0 -- dummy
396+ dreq = dummyreq addr
424− sendResponse settings conn ii th req defaultIndexRequestHeader (return S.empty) (errorResponse e)
397+ void $ sendResponse settings conn ii dreq defaultIndexRequestHeader (return S.empty) (errorResponse e)
427 dummyreq addr = defaultRequest { remoteHost = addr }
399 dummyreq addr = defaultRequest { remoteHost = addr }
429 errorResponse e = settingsOnExceptionResponse settings e
401 errorResponse e = settingsOnExceptionResponse settings e
431− http1 firstRequest addr istatus src = do
403+ http1 addr istatus src = do
432− (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport
404+ (req', mremainingRef, idxhdr, nextBodyFlush, ii) <- recvRequest settings conn ii1 addr src
405+ let req = req' { isSecure = isTransportSecure transport }
433− keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush
406+ keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii
434 `E.catch` \e -> do
407 `E.catch` \e -> do
408+ -- Call the user-supplied exception handlers, passing the request.
409+ sendErrorResponse addr istatus e
435 settingsOnException settings (Just req) e
410 settingsOnException settings (Just req) e
436 -- Don't throw the error again to prevent calling settingsOnException twice.
411 -- Don't throw the error again to prevent calling settingsOnException twice.
437 return False
412 return False
413+ 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
415+ processRequest istatus src req mremainingRef idxhdr nextBodyFlush ii = do
450 -- Let the application run for as long as it wants
416 -- Let the application run for as long as it wants
451 T.pause th
417 T.pause th
@@ -454,38 +420,30 @@ serveConnection conn ii th origAddr transport settings app = do
454 -- creating the request, we need to make sure that we don't get
420 -- creating the request, we need to make sure that we don't get
455 -- an async exception before calling the ResponseSource.
421 -- an async exception before calling the ResponseSource.
456 keepAliveRef <- newIORef $ error "keepAliveRef not filled"
422 keepAliveRef <- newIORef $ error "keepAliveRef not filled"
457− r <- E.try $ app req $ \res -> do
423+ _ <- app req $ \res -> do
458 T.resume th
424 T.resume th
459 -- FIXME consider forcing evaluation of the res here to
425 -- FIXME consider forcing evaluation of the res here to
460 -- send more meaningful error messages to the user.
426 -- send more meaningful error messages to the user.
461 -- However, it may affect performance.
427 -- However, it may affect performance.
462 writeIORef istatus False
428 writeIORef istatus False
463− keepAlive <- sendResponse settings conn ii th req idxhdr (readSource src) res
429+ keepAlive <- sendResponse settings conn ii req idxhdr (readSource src) res
464 writeIORef keepAliveRef keepAlive
430 writeIORef keepAliveRef keepAlive
465 return ResponseReceived
431 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
432 keepAlive <- readIORef keepAliveRef
477 -- We just send a Response and it takes a time to
434 -- We just send a Response and it takes a time to
478 -- receive a Request again. If we immediately call recv,
435 -- receive a Request again. If we immediately call recv,
479− -- it is likely to fail and cause the IO manager to do some work.
436+ -- it is likely to fail and the IO manager works.
480− -- It is very costly, so we yield to another Haskell
437+ -- It is very costly. So, we yield to another Haskell
481 -- thread hoping that the next Request will arrive
438 -- thread hoping that the next Request will arrive
482 -- when this Haskell thread will be re-scheduled.
439 -- when this Haskell thread will be re-scheduled.
483 -- This improves performance at least when
440 -- This improves performance at least when
484 -- the number of cores is small.
441 -- the number of cores is small.
485 Conc.yield
442 Conc.yield
487− if keepAlive
444+ if not keepAlive then
488− then
445+ return False
489 -- If there is an unknown or large amount of data to still be read
447 -- 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
448 -- from the request body, simple drop this connection instead of
491 -- reading it all in to satisfy a keep-alive request.
449 -- reading it all in to satisfy a keep-alive request.
@@ -511,21 +469,6 @@ serveConnection conn ii th origAddr transport settings app = do
512 return False
470 return False
513 Nothing -> tryKeepAlive
471 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 ()
473flushEntireBody :: IO ByteString -> IO ()
531flushEntireBody src =
474flushEntireBody src =
@@ -558,35 +501,12 @@ wrappedRecv Connection { connRecv = recv } th istatus slowlorisSize = do
558 when (S.length bs >= slowlorisSize) $ T.tickle th
501 when (S.length bs >= slowlorisSize) $ T.tickle th
559 return bs
502 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
504-- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs
579setSocketCloseOnExec :: Socket -> IO ()
505setSocketCloseOnExec :: Socket -> IO ()
580#if WINDOWS
506#if WINDOWS
581setSocketCloseOnExec _ = return ()
507setSocketCloseOnExec _ = 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
509+setSocketCloseOnExec socket = F.setFileCloseOnExec $ fromIntegral $ fdSocket socket
592gracefulShutdown :: Settings -> Counter -> IO ()
512gracefulShutdown :: Settings -> Counter -> IO ()