@@ -516,7 +516,8 @@ handleIncomingMessages node = go initConnectionState
516 . (incomingFrom theirAddr ^: Set.insert cid)
516 . (incomingFrom theirAddr ^: Set.insert cid)
519− else invalidRequest cid st
519+ else invalidRequest cid st $
520+ "attempt to connect with unsupported reliability " ++ show rel
520 NT.Received cid payload ->
521 NT.Received cid payload ->
521 case st ^. incomingAt cid of
522 case st ^. incomingAt cid of
522 Just (_, ToProc pid weakQueue) -> do
523 Just (_, ToProc pid weakQueue) -> do
@@ -549,7 +550,9 @@ handleIncomingMessages node = go initConnectionState
549 Just proc ->
550 Just proc ->
550 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
551 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
551 Nothing ->
552 Nothing ->
552− invalidRequest cid st
553+ -- incoming attempt to connect to unknown process - might
555+ go (incomingAt cid ^= Nothing $ st)
553 SendPortIdentifier chId -> do
556 SendPortIdentifier chId -> do
554 let lcid = sendPortLocalId chId
557 let lcid = sendPortLocalId chId
555 lpid = processLocalId (sendPortProcessId chId)
558 lpid = processLocalId (sendPortProcessId chId)
@@ -561,19 +564,28 @@ handleIncomingMessages node = go initConnectionState
561 Just channel ->
564 Just channel ->
562 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
565 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
563 Nothing ->
566 Nothing ->
564− invalidRequest cid st
567+ invalidRequest cid st $
568+ "incoming attempt to connect to unknown channel of"
569+ ++ " process " ++ show (sendPortProcessId chId)
565 Nothing ->
570 Nothing ->
566− invalidRequest cid st
571+ -- incoming attempt to connect to channel of unknown
572+ -- process - might be dead already
573+ go (incomingAt cid ^= Nothing $ st)
567 NodeIdentifier nid ->
574 NodeIdentifier nid ->
568 if nid == localNodeId node
575 if nid == localNodeId node
569 then go (incomingAt cid ^= Just (src, ToNode) $ st)
576 then go (incomingAt cid ^= Just (src, ToNode) $ st)
570− else invalidRequest cid st
577+ else invalidRequest cid st $
578+ "incoming attempt to connect to a different node -"
579+ ++ " I'm " ++ show (localNodeId node)
580+ ++ " but the remote peer wants to connect to "
571 Nothing ->
582 Nothing ->
572 invalidRequest cid st
583 invalidRequest cid st
584+ "message received from an unknown connection"
573 NT.ConnectionClosed cid ->
585 NT.ConnectionClosed cid ->
574 case st ^. incomingAt cid of
586 case st ^. incomingAt cid of
575 Nothing ->
587 Nothing ->
576− invalidRequest cid st
588+ invalidRequest cid st "closed unknown connection"
577 Just (src, _) -> do
589 Just (src, _) -> do
578 trace node (MxDisconnected cid src)
590 trace node (MxDisconnected cid src)
579 go ( (incomingAt cid ^= Nothing)
591 go ( (incomingAt cid ^= Nothing)
@@ -604,14 +616,16 @@ handleIncomingMessages node = go initConnectionState
604 -- and we just give up
616 -- and we just give up
605 fail "Cloud Haskell fatal error: received unexpected multicast"
617 fail "Cloud Haskell fatal error: received unexpected multicast"
607− invalidRequest :: NT.ConnectionId -> ConnectionState -> IO ()
619+ invalidRequest :: NT.ConnectionId -> ConnectionState -> String -> IO ()
608− invalidRequest cid st = do
620+ invalidRequest cid st msg = do
609 -- TODO: We should treat this as a fatal error on the part of the remote
621 -- TODO: We should treat this as a fatal error on the part of the remote
610 -- node. That is, we should report the remote node as having died, and we
622 -- node. That is, we should report the remote node as having died, and we
611 -- should close incoming connections (this requires a Transport layer
623 -- should close incoming connections (this requires a Transport layer
612 -- extension).
624 -- extension).
613− traceEventFmtIO node "" [(TraceStr " [network] invalid request: "),
625+ traceEventFmtIO node "" [ TraceStr $ " [network] invalid request"
626+ ++ " (" ++ msg ++ "): "
614− (Trace cid)]
627+ , (Trace cid)
615 go ( incomingAt cid ^= Nothing
629 go ( incomingAt cid ^= Nothing