on master help sign in
Merge PR #787
commit12b32a1466c074ceac00697bcb9c3b51ce0a00cb authorKazu Yamamoto <kazu@iij.ad.jp> dateFri 17 Jan 2020, 00:19 (7 years ago) parentb0b04bf1f20f76
2 files changed+18−20
warp/Network/Wai/Handler/Warp/Recv.hs+11−1 warp/Network/Wai/Handler/Warp/Run.hs+7−19
warp/Network/Wai/Handler/Warp/Recv.hs+11−1
@@ -17,7 +17,9 @@ import Foreign.C.Types
1717import Foreign.ForeignPtr (withForeignPtr)
1818import Foreign.Ptr (Ptr, castPtr, plusPtr)
1919import GHC.Conc (threadWaitRead)
20+import qualified GHC.IO.Exception as E
2021import Network.Socket (Socket)
22+import qualified System.IO.Error as E
2123#if MIN_VERSION_network(3,1,0)
2224import Network.Socket (withFdSocket)
2325#else
@@ -94,8 +96,11 @@ spell init0 siz0 recv recvBuf
9496 siz' = siz - len
9597 loop bss' siz'
9698
99+-- The timeout manager may close the socket.
100+-- In that case, an error of "Bad file descriptor" occurs.
101+-- We ignores it because we expect TimeoutThread.
97102receive :: Socket -> BufferPool -> Recv
98−receive sock pool = withBufferPool pool $ \ (ptr, size) -> do
103+receive sock pool = E.handle handler $ withBufferPool pool $ \ (ptr, size) -> do
99104#if MIN_VERSION_network(3,1,0)
100105 withFdSocket sock $ \fd -> do
101106#elif MIN_VERSION_network(3,0,0)
@@ -105,6 +110,11 @@ receive sock pool = withBufferPool pool $ \ (ptr, size) -> do
105110#endif
106111 let size' = fromIntegral size
107112 fromIntegral <$> receiveloop fd ptr size'
113+ where
114+ handler :: E.IOException -> IO ByteString
115+ handler e
116+ | E.ioeGetErrorType e == E.InvalidArgument = return ""
117+ | otherwise = E.throwIO e
108118
109119receiveBuf :: Socket -> RecvBuf
110120receiveBuf sock buf0 siz0 = do
warp/Network/Wai/Handler/Warp/Run.hs+7−19
@@ -17,7 +17,7 @@ import qualified Control.Concurrent as Conc (yield)
1717import Control.Exception as E
1818import qualified Data.ByteString as S
1919import Data.Char (chr)
20−import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef')
20+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
2121import Data.Streaming.Network (bindPortTCP)
2222import Foreign.C.Error (Errno(..), eCONNABORTED)
2323import GHC.IO.Exception (IOException(..))
@@ -282,10 +282,7 @@ fork :: Settings
282282fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
283283 -- Call the user-supplied on exception code if any
284284 -- exceptions are thrown.
285− handle (settingsOnException set Nothing) .
286− -- Allocate a new IORef indicating whether the connection has been
287− -- closed, to avoid double-freeing a connection
288− withClosedRef $ \ref ->
285+ handle (settingsOnException set Nothing) $
289286 -- Run the connection maker to get a new connection, and ensure
290287 -- that the connection is closed. If the mkConn call throws an
291288 -- exception, we will leak the connection. If the mkConn call is
@@ -296,21 +293,13 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
296293 -- We grab the connection before registering timeouts since the
297294 -- timeouts will be useless during connection creation, due to the
298295 -- fact that async exceptions are still masked.
299− bracket mkConn (cleanUp ref) (serve unmask ref)
296+ bracket mkConn cleanUp (serve unmask)
300297 where
301− withClosedRef inner = newIORef False >>= inner
302−
303− closeConn ref conn = do
304− isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
305− unless isClosed $ connClose conn
306−
307− cleanUp ref (conn, _) = closeConn ref conn `finally` connFree conn
298+ cleanUp (conn, _) = connClose conn `finally` connFree conn
308299
309300 -- We need to register a timeout handler for this thread, and
310− -- cancel that handler as soon as we exit. We additionally close
311− -- the connection immediately in case the child thread catches the
312− -- async exception or performs some long-running cleanup action.
313− serve unmask ref (conn, transport) = bracket register cancel $ \th -> do
301+ -- cancel that handler as soon as we exit.
302+ serve unmask (conn, transport) = bracket register cancel $ \th -> do
314303 -- We now have fully registered a connection close handler in
315304 -- the case of all exceptions, so it is safe to once again
316305 -- allow async exceptions.
@@ -322,8 +311,7 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
322311 -- above ensures the connection is closed.
323312 when goingon $ serveConnection conn ii th addr transport set app
324313 where
325− register = T.registerKillThread (timeoutManager ii)
326− (closeConn ref conn)
314+ register = T.registerKillThread (timeoutManager ii) (connClose conn)
327315 cancel = T.cancel
328316
329317 onOpen adr = increase counter >> settingsOnOpen set adr