diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Pairing.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/PairListener.hs | 28 |
2 files changed, 21 insertions, 9 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index 4736c4396..bb1384a15 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -28,7 +28,7 @@ data PairStage | PairAck {- "I saw your PairAck; you can stop sending them." -} | PairDone - deriving (Eq, Read, Show, Ord) + deriving (Eq, Read, Show, Ord, Enum) newtype PairMsg = PairMsg (Verifiable (PairStage, PairData, SomeAddr)) deriving (Eq, Read, Show) diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index 0d3be4660..cd95ab5a4 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -43,20 +43,32 @@ pairListenerThread urlrenderer = namedThread "PairListener" $ do (pip, verified) <- verificationCheck m =<< (pairingInProgress <$> getDaemonStatus) let wrongstage = maybe False (\p -> pairMsgStage m <= inProgressPairStage p) pip - case (wrongstage, sane, pairMsgStage m) of - -- ignore our own messages, and - -- out of order messages - (_, False, _) -> go reqs cache sock - (True, _, _) -> go reqs cache sock - (_, _, PairReq) -> if m `elem` reqs + let fromus = maybe False (\p -> remoteSshPubKey (pairMsgData m) == remoteSshPubKey (inProgressPairData p)) pip + case (wrongstage, fromus, sane, pairMsgStage m) of + (_, True, _, _) -> do + debug ["ignoring message that looped back"] + go reqs cache sock + (_, _, False, _) -> go reqs cache sock + -- PairReq starts a pairing process, so a + -- new one is always heeded, even if + -- some other pairing is in process. + (_, _, _, PairReq) -> if m `elem` reqs then go reqs (invalidateCache m cache) sock else do pairReqReceived verified urlrenderer m go (m:take 10 reqs) (invalidateCache m cache) sock - (_, _, PairAck) -> do + (True, _, _, _) -> do + debug + ["ignoring out of order message" + , show (pairMsgStage m) + , "expected" + , show (succ . inProgressPairStage <$> pip) + ] + go reqs cache sock + (_, _, _, PairAck) -> do cache' <- pairAckReceived verified pip m cache go reqs cache' sock - (_, _, PairDone) -> do + (_,_ , _, PairDone) -> do pairDoneReceived verified pip m go reqs cache sock |