git.iko.soy/distributed-process
on master help sign in
Don't close connection on asynchronous exception

In modifyRemoteState we put the remote state in closed state when any exception occured. This is incorrect, however. If a thread that is trying to send gets killed, that doesn't necessary mean that the connection is now broken. Now we close the remote endpoint only if an IO exception occurs.

commitd71429526ecd1f3d978f0d8dd70b298cf1e3cb66 authorEdsko de Vries <edsko@well-typed.com> dateThu 24 May 2012, 12:57 (14 years ago) parent330718e
2 files changed+13−10
compare with master
unifiedsplit
network-transport/src/Network/Transport/Internal.hs+2−2 network-transport/src/Network/Transport/TCP.hs+11−8
network-transport/src/Network/Transport/Internal.hs+2−2
@@ -9,9 +9,9 @@ module Network.Transport.Internal ( -- * Encoders/decoders
99 , mapIOException
1010 , tryIO
1111 , tryToEnum
12− -- * Replicated functionality from "base"
12+ -- * Replicated functionality from "base"
1313 , void
14− , forkIOWithUnmask
14+ , forkIOWithUnmask
1515 -- * Debugging
1616 , tlog
1717 ) where
network-transport/src/Network/Transport/TCP.hs+11−8
@@ -84,6 +84,7 @@ import Control.Exception ( IOException
8484 , mask
8585 , mask_
8686 , onException
87+ , fromException
8788 )
8889import Data.IORef (IORef, newIORef, writeIORef, readIORef)
8990import Data.ByteString (ByteString)
@@ -542,7 +543,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
542543 -- TODO: should we signal on resolved here?
543544 tryCloseSocket (remoteSocket conn)
544545 return RemoteEndPointClosed
545− RemoteEndPointClosed ->
546+ RemoteEndPointClosed ->
546547 return RemoteEndPointClosed
547548
548549-- | Special case of 'apiConnect': connect an endpoint to itself
@@ -1031,7 +1032,7 @@ remoteStateIdentity =
10311032 , caseClosed = return RemoteEndPointClosed
10321033 }
10331034
1034−-- | Like modifyMVar, but if an exception occurs don't restore the remote
1035+-- | Like modifyMVar, but if an I/O exception occurs don't restore the remote
10351036-- endpoint to its original value but close it instead
10361037modifyRemoteState :: EndPointPair
10371038 -> RemoteStatePatternMatch (RemoteState, a)
@@ -1046,8 +1047,11 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10461047 Right (st', a) -> do
10471048 putMVar theirState st'
10481049 return a
1049− Left ex ->
1050− handleException ex vst
1050+ Left ex -> do
1051+ case fromException ex of
1052+ Just ioEx -> handleIOException ioEx vst
1053+ Nothing -> putMVar theirState st
1054+ throw ex
10511055 -- The other cases are less interesting, because unless the endpoint is
10521056 -- in Valid state we're not supposed to do any IO on it
10531057 RemoteEndPointClosing resolved vst -> do
@@ -1069,8 +1073,8 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10691073 theirState :: MVar RemoteState
10701074 theirState = remoteState theirEndPoint
10711075
1072− handleException :: SomeException -> ValidRemoteEndPointState -> IO a
1073− handleException ex vst = do
1076+ handleIOException :: IOException -> ValidRemoteEndPointState -> IO ()
1077+ handleIOException ex vst = do
10741078 tryCloseSocket (remoteSocket vst)
10751079 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
10761080 putMVar theirState RemoteEndPointClosed
@@ -1078,7 +1082,6 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10781082 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
10791083 err = TransportError code (show ex)
10801084 writeChan (localChannel ourEndPoint) $ ErrorEvent err
1081− throwIO ex
10821085
10831086-- | Like 'modifyRemoteState' but without a return value
10841087modifyRemoteState_ :: EndPointPair
@@ -1330,7 +1333,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13301333
13311334 -- Close the socket (if we don't have any outgoing connections)
13321335 closeSocket :: N.Socket -> IO Bool
1333− closeSocket sock = do
1336+ closeSocket sock =
13341337 modifyMVar theirState $ \st ->
13351338 case st of
13361339 RemoteEndPointInvalid _ ->