diff options
| -rw-r--r-- | Assistant/Pairing.hs | 5 | ||||
| -rw-r--r-- | Assistant/Threads/PairListener.hs | 11 |
2 files changed, 12 insertions, 4 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index eced43793..a157e28f8 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -47,7 +47,10 @@ type UserName = String {- A pairing that is in progress has a secret, and a thread that is - broadcasting pairing requests. -} -data PairingInProgress = PairingInProgress Secret ThreadId +data PairingInProgress = PairingInProgress + { inProgressSecret :: Secret + , inProgressThreadId :: ThreadId + } data SomeAddr = IPv4Addr HostAddress | IPv6Addr HostAddress6 deriving (Ord, Eq, Read, Show) diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index bb9ab6d0f..58d8fd969 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -39,13 +39,18 @@ pairListenerThread st dstatus = thread $ withSocketsDo $ do chunksz = 1024 dispatch Nothing = noop - dispatch (Just (PairReqM (PairReq r))) = void $ do - let pairdata = verifiableVal r + dispatch (Just (PairReqM (PairReq v))) = unlessM (mypair v) $ do + let pairdata = verifiableVal v let repo = remoteUserName pairdata ++ "@" ++ fromMaybe (showAddr $ remoteAddress pairdata) (remoteHostName pairdata) let msg = repo ++ " is sending a pair request." {- Pair request alerts from the same host combine, - so repeated requests do not add additional alerts. -} - addAlert dstatus $ pairRequestAlert repo msg + void $ addAlert dstatus $ pairRequestAlert repo msg dispatch (Just (PairAckM _)) = noop -- TODO + + {- Filter out our own pair requests, by checking if we + - can verify using the secrets of any of them. -} + mypair v = any (verified v . inProgressSecret) . pairingInProgress + <$> getDaemonStatus dstatus |