git.iko.soy/typeable/wai
on master help sign in
Timeout manager closes the socket again and InvalidArgument is ignored in receive.
c121b70Kazu Yamamoto
warp/Network/Wai/Handler/Warp/Recv.hs+8−1
compare with master
unifiedsplit
@@ -17,7 +17,9 @@ import Foreign.C.Types
17import Foreign.ForeignPtr (withForeignPtr)
17import Foreign.ForeignPtr (withForeignPtr)
18import Foreign.Ptr (Ptr, castPtr, plusPtr)
18import Foreign.Ptr (Ptr, castPtr, plusPtr)
19import GHC.Conc (threadWaitRead)
19import GHC.Conc (threadWaitRead)
20+import qualified GHC.IO.Exception as E
20import Network.Socket (Socket)
21import Network.Socket (Socket)
22+import qualified System.IO.Error as E
21#if MIN_VERSION_network(3,1,0)
23#if MIN_VERSION_network(3,1,0)
22import Network.Socket (withFdSocket)
24import Network.Socket (withFdSocket)
23#else
25#else
@@ -95,7 +97,7 @@ spell init0 siz0 recv recvBuf
95 loop bss' siz'
97 loop bss' siz'
96
98
97receive :: Socket -> BufferPool -> Recv
99receive :: Socket -> BufferPool -> Recv
98−receive sock pool = withBufferPool pool $ \ (ptr, size) -> do
100+receive sock pool = E.handle handler $ withBufferPool pool $ \ (ptr, size) -> do
99#if MIN_VERSION_network(3,1,0)
101#if MIN_VERSION_network(3,1,0)
100 withFdSocket sock $ \fd -> do
102 withFdSocket sock $ \fd -> do
101#elif MIN_VERSION_network(3,0,0)
103#elif MIN_VERSION_network(3,0,0)
@@ -105,6 +107,11 @@ receive sock pool = withBufferPool pool $ \ (ptr, size) -> do
105#endif
107#endif
106 let size' = fromIntegral size
108 let size' = fromIntegral size
107 fromIntegral <$> receiveloop fd ptr size'
109 fromIntegral <$> receiveloop fd ptr size'
110+ where
111+ handler :: E.IOException -> IO ByteString
112+ handler e
113+ | E.ioeGetErrorType e == E.InvalidArgument = return ""
114+ | otherwise = E.throwIO e
108
115
109receiveBuf :: Socket -> RecvBuf
116receiveBuf :: Socket -> RecvBuf
110receiveBuf sock buf0 siz0 = do
117receiveBuf sock buf0 siz0 = do
warp/Network/Wai/Handler/Warp/Run.hs+1−1
@@ -311,7 +311,7 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask ->
311 -- above ensures the connection is closed.
311 -- above ensures the connection is closed.
312 when goingon $ serveConnection conn ii th addr transport set app
312 when goingon $ serveConnection conn ii th addr transport set app
313 where
313 where
314− register = T.registerKillThread (timeoutManager ii) (return ())
314+ register = T.registerKillThread (timeoutManager ii) (connClose conn)
315 cancel = T.cancel
315 cancel = T.cancel
316
316
317 onOpen adr = increase counter >> settingsOnOpen set adr
317 onOpen adr = increase counter >> settingsOnOpen set adr