@@ -275,6 +275,12 @@ data ValidLocalEndPointState = ValidLocalEndPointState
275275-- closed; that is, we shouldn't do any 'send's on it (although 'recv' is
276276-- acceptable, of course -- as we are waiting for the remote endpoint to
277277-- confirm or deny the request).
278+--
279+-- INV-LOCK-ORDER: Remote endpoint must be locked before their local endpoints.
280+-- In other words: it is okay to call modifyMVar on a local endpoint inside a
281+-- modifyMVar on a remote endpoint, but not the other way around. In
282+-- particular, it is okay to call removeRemoteEndPoint inside
283+-- modifyRemoteState.
278284
279285data RemoteEndPoint = RemoteEndPoint
280286 { remoteAddress :: EndPointAddress
@@ -285,7 +291,7 @@ data RemoteEndPoint = RemoteEndPoint
285291data RemoteState =
286292 RemoteEndPointInvalid (TransportError ConnectErrorCode)
287293 | RemoteEndPointValid ValidRemoteEndPointState
288− | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
294+ | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
289295 | RemoteEndPointClosed
290296
291297data ValidRemoteEndPointState = ValidRemoteEndPointState
@@ -479,7 +485,7 @@ apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =
479485 liftM join . try . mapIOException sendFailed $
480486 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
481487 { caseInvalid = \_ ->
482− fail "apiSend RELY violation"
488+ relyViolation (ourEndPoint, theirEndPoint) "apiSend"
483489 , caseValid = \vst -> do
484490 alive <- readIORef connAlive
485491 if alive
@@ -533,6 +539,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
533539 tryCloseSocket (remoteSocket conn)
534540 return RemoteEndPointClosed
535541 RemoteEndPointClosing _ conn -> do
542+ -- TODO: should we signal on resolved here?
536543 tryCloseSocket (remoteSocket conn)
537544 return RemoteEndPointClosed
538545 RemoteEndPointClosed ->
@@ -939,9 +946,9 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
939946 LocalEndPointClosed ->
940947 throwIO (userError "Local endpoint closed")
941948 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
942− { caseInvalid = \_ -> fail "doRemoteRequest RELY violation"
949+ { caseInvalid = \_ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest"
943950 , caseValid = \vst -> sendOn vst [encodeInt32 header, encodeInt32 reqId]
944− , caseClosing = \_ -> fail "doRemoteRequest RELY violation"
951+ , caseClosing = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest"
945952 , caseClosed = throwIO (userError "Remote endpoint closed")
946953 }
947954 takeMVar reply
@@ -955,7 +962,7 @@ closeIfUnused (ourEndPoint, theirEndPoint) =
955962 then do
956963 sendOn vst [encodeInt32 CloseSocket]
957964 resolved <- newEmptyMVar
958− return $ RemoteEndPointClosing resolved vst
965+ return $ RemoteEndPointClosing resolved vst
959966 else
960967 return $ RemoteEndPointValid vst
961968 }
@@ -1065,38 +1072,14 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
10651072 handleException :: SomeException -> ValidRemoteEndPointState -> IO a
10661073 handleException ex vst = do
10671074 tryCloseSocket (remoteSocket vst)
1068− -- We need to remove the remote endpoint from the local endpoint before
1069− -- putting it in Closed state (by INV-CLOSE), but we don't want to hold
1070− -- two locks at the same time. So we put it in closing state first ..
1071− resolved <- newEmptyMVar
1072− putMVar theirState (RemoteEndPointClosing resolved vst)
1073− -- .. then remove it from the local endpoint ..
10741075 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1075− -- .. close it and notify the local endpoint we lost the connection ..
1076− mIncoming <- closeRemoteEndPoint
1077− forM_ mIncoming $ \incoming -> do
1078− let code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1079− err = TransportError code (show ex)
1080− writeChan (localChannel ourEndPoint) $ ErrorEvent err
1081− -- .. and finally rethrow the exception
1076+ putMVar theirState RemoteEndPointClosed
1077+ let incoming = IntSet.elems $ vst ^. remoteIncoming
1078+ code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1079+ err = TransportError code (show ex)
1080+ writeChan (localChannel ourEndPoint) $ ErrorEvent err
10821081 throwIO ex
10831082
1084− -- Returns the set of incoming connections if we closed the connection, or
1085− -- 'Nothing' if the endpoint was already closed
1086− closeRemoteEndPoint :: IO (Maybe [ConnectionId])
1087− closeRemoteEndPoint = do
1088− st <- takeMVar theirState
1089− case st of
1090− RemoteEndPointClosing resolved vst -> do
1091− putMVar resolved ()
1092− putMVar theirState RemoteEndPointClosed
1093− return . Just . IntSet.elems $ vst ^. remoteIncoming
1094− RemoteEndPointClosed -> do
1095− putMVar theirState RemoteEndPointClosed
1096− return Nothing
1097− _ ->
1098− fail "the impossible happened"
1099−
11001083-- | Like 'modifyRemoteState' but without a return value
11011084modifyRemoteState_ :: EndPointPair
11021085 -> RemoteStatePatternMatch RemoteState
@@ -1211,25 +1194,39 @@ handleConnectionRequest transport sock = handle handleException $ do
12111194--
12121195-- Returns only if the remote party closes the socket or if an error occurs.
12131196--
1214−-- RELY: The remote endpoint must be in RemoteEndPointValid or
1215−-- RemoteEndPointClosing state. If the latter, then the 'resolved' MVar
1216−-- associated with the closing state must be empty.
1197+-- RELY: The remote endpoint must not be invalid.
12171198-- GUARANTEE: May change the remote endpoint to RemoteEndPointClosed state.
12181199handleIncomingMessages :: EndPointPair -> IO ()
12191200handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1220− -- For efficiency sake we get the socket once and for all
1221− sock <- withMVar theirState $ \st ->
1201+ mSock <- withMVar theirState $ \st ->
12221202 case st of
1203+ RemoteEndPointInvalid _ ->
1204+ relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:initialization"
12231205 RemoteEndPointValid ep ->
1224− return (remoteSocket ep)
1206+ return . Just $ remoteSocket ep
12251207 RemoteEndPointClosing _ ep ->
1226− return (remoteSocket ep)
1227− _ ->
1228− error "handleIncomingMessages RELY violation"
1229−
1230− tryIO (go sock) >>= either (prematureExit sock) return
1208+ return . Just $ remoteSocket ep
1209+ RemoteEndPointClosed ->
1210+ -- The remote endpoint got closed before we got a chance to start
1211+ -- dealing with incoming messages
1212+ return Nothing
1213+
1214+ forM_ mSock $ \sock ->
1215+ tryIO (go sock) >>= either (prematureExit sock) return
12311216 where
12321217 -- Dispatch
1218+ --
1219+ -- If a recv throws an exception this will be caught top-level and
1220+ -- 'prematureExit' will be invoked. The same will happen if the remote
1221+ -- endpoint is put into a Closed (or Closing) state by a concurrent thread
1222+ -- (because a 'send' failed) -- the individual handlers below will throw a
1223+ -- user exception which is then caught and handled the same way as an
1224+ -- exception thrown by 'recv'.
1225+ --
1226+ -- Note: modifyRemoteState closes the socket before putting the remote
1227+ -- endpoint in closing state, so it is not possible that modifyRemoteState
1228+ -- puts the remote endpoint in Closing state only for it to be reset to
1229+ -- Valid by the RequestConnectionId handler below.
12331230 go :: N.Socket -> IO ()
12341231 go sock = do
12351232 connId <- recvInt32 sock
@@ -1262,6 +1259,8 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
12621259 newId <- getNextConnectionId ourEndPoint
12631260 modifyMVar_ theirState $ \st -> do
12641261 vst <- case st of
1262+ RemoteEndPointInvalid _ ->
1263+ relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:createNewConnection"
12651264 RemoteEndPointValid vst ->
12661265 return (remoteIncoming ^: IntSet.insert newId $ vst)
12671266 RemoteEndPointClosing resolved vst -> do
@@ -1273,8 +1272,8 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
12731272 -- to RemoteEndPointValid
12741273 putMVar resolved ()
12751274 return (remoteIncoming ^= IntSet.singleton newId $ vst)
1276− _ ->
1277− error "handleIncomingMessages RELY violation"
1275+ RemoteEndPointClosed ->
1276+ throw $ userError "Remote endpoint closed"
12781277 sendOn vst ( encodeInt32 ControlResponse
12791278 : encodeInt32 reqId
12801279 : prependLength [encodeInt32 newId]
@@ -1309,23 +1308,33 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13091308 -- because otherwise we should not decrement the reference count
13101309 closeConnection :: ConnectionId -> IO ()
13111310 closeConnection cid = do
1312− modifyMVar_ theirState $ \(RemoteEndPointValid vst) -> do
1313− unless (IntSet.member cid (vst ^. remoteIncoming)) $
1314− throwIO $ userError "Invalid CloseConnection"
1315− return ( RemoteEndPointValid
1316− . (remoteIncoming ^: IntSet.delete cid)
1317− $ vst
1318− )
1311+ modifyMVar_ theirState $ \st -> case st of
1312+ RemoteEndPointInvalid _ ->
1313+ relyViolation (ourEndPoint, theirEndPoint) "closeConnection"
1314+ RemoteEndPointValid vst -> do
1315+ unless (IntSet.member cid (vst ^. remoteIncoming)) $
1316+ throwIO $ userError "Invalid CloseConnection"
1317+ return ( RemoteEndPointValid
1318+ . (remoteIncoming ^: IntSet.delete cid)
1319+ $ vst
1320+ )
1321+ RemoteEndPointClosing _ _ ->
1322+ -- If the remote endpoint is in Closing state, that means that are as
1323+ -- far as we are concerned there are no incoming connections. This
1324+ -- means that a CloseConnection request at this point is invalid.
1325+ throwIO $ userError "Invalid CloseConnection request"
1326+ RemoteEndPointClosed ->
1327+ throwIO $ userError "Remote endpoint closed"
13191328 writeChan ourChannel (ConnectionClosed cid)
13201329 closeIfUnused (ourEndPoint, theirEndPoint)
13211330
13221331 -- Close the socket (if we don't have any outgoing connections)
13231332 closeSocket :: N.Socket -> IO Bool
13241333 closeSocket sock = do
1325− -- As in modifyRemoteState we put the remote state in Closing state
1326− -- before putting it in Closed state.
1327− canClose <- modifyMVar theirState $ \st ->
1334+ modifyMVar theirState $ \st ->
13281335 case st of
1336+ RemoteEndPointInvalid _ ->
1337+ relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:closeSocket"
13291338 RemoteEndPointValid vst -> do
13301339 -- We regard a CloseSocket message as an (optimized) way for the
13311340 -- remote endpoint to indicate that all its connections to us are
@@ -1338,29 +1347,18 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13381347 then do
13391348 -- Attempt to reply (but don't insist)
13401349 tryIO $ sendOn vst' [encodeInt32 CloseSocket]
1341− resolved <- newEmptyMVar
1342− return (RemoteEndPointClosing resolved vst', True)
1350+ tryCloseSocket sock
1351+ removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1352+ return (RemoteEndPointClosed, True)
13431353 else
13441354 return (RemoteEndPointValid vst', False)
1345− RemoteEndPointClosing _ _ ->
1346− return (st, True)
1347− _ ->
1348− error "handleIncomingConnections RELY violation"
1349−
1350− when canClose $ do
1351− removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1352− modifyMVar_ theirState $ \st -> do
1353− case st of
1354− RemoteEndPointClosing resolved _ ->
1355− putMVar resolved ()
1356− RemoteEndPointClosed ->
1357− return ()
1358− _ ->
1359− fail "Impossible case"
1360− return RemoteEndPointClosed
1361− tryCloseSocket sock
1362−
1363− return canClose
1355+ RemoteEndPointClosing resolved _ -> do
1356+ tryCloseSocket sock
1357+ removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1358+ putMVar resolved ()
1359+ return (RemoteEndPointClosed, True)
1360+ RemoteEndPointClosed ->
1361+ throw $ userError "Remote endpoint closed"
13641362
13651363 -- Read a message and output it on the endPoint's channel By rights we
13661364 -- should verify that the connection ID is valid, but this is unnecessary
@@ -1383,14 +1381,15 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
13831381 modifyMVar_ theirState $ \st ->
13841382 case st of
13851383 RemoteEndPointInvalid _ ->
1386− error "handleIncomingMessages RELY violation"
1384+ relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
13871385 RemoteEndPointValid vst -> do
13881386 let code = EventConnectionLost
13891387 (remoteAddress theirEndPoint)
13901388 (IntSet.elems $ vst ^. remoteIncoming)
13911389 writeChan ourChannel . ErrorEvent $ TransportError code (show err)
13921390 return RemoteEndPointClosed
1393− RemoteEndPointClosing _ _ ->
1391+ RemoteEndPointClosing resolved _ -> do
1392+ putMVar resolved ()
13941393 return RemoteEndPointClosed
13951394 RemoteEndPointClosed ->
13961395 return RemoteEndPointClosed
@@ -1461,3 +1460,17 @@ pendingCtrlRequestsAt ix = pendingCtrlRequests >>> DAC.intMapMaybe (fromIntegral
14611460localConnectionTo :: EndPointAddress
14621461 -> Accessor ValidLocalEndPointState (Maybe RemoteEndPoint)
14631462localConnectionTo addr = localConnections >>> DAC.mapMaybe addr
1463+
1464+-------------------------------------------------------------------------------
1465+-- Debugging --
1466+-------------------------------------------------------------------------------
1467+
1468+relyViolation :: EndPointPair -> String -> IO a
1469+relyViolation (ourEndPoint, theirEndPoint) str = do
1470+ elog (ourEndPoint, theirEndPoint) (str ++ " RELY violation")
1471+ fail (str ++ " RELY violation")
1472+
1473+elog :: EndPointPair -> String -> IO ()
1474+elog (ourEndPoint, theirEndPoint) msg = do
1475+ tid <- myThreadId
1476+ putStrLn $ show (localAddress ourEndPoint) ++ "/" ++ show (remoteAddress theirEndPoint) ++ "/" ++ show tid ++ ": " ++ msg