filter out our own pairing requests
Due to being multicast, requests sent by one thread are received by the listener in another thread.
This commit is contained in:
parent
61ee1e1660
commit
5401b9f249
2 changed files with 12 additions and 4 deletions
|
@ -47,7 +47,10 @@ type UserName = String
|
||||||
|
|
||||||
{- A pairing that is in progress has a secret, and a thread that is
|
{- A pairing that is in progress has a secret, and a thread that is
|
||||||
- broadcasting pairing requests. -}
|
- broadcasting pairing requests. -}
|
||||||
data PairingInProgress = PairingInProgress Secret ThreadId
|
data PairingInProgress = PairingInProgress
|
||||||
|
{ inProgressSecret :: Secret
|
||||||
|
, inProgressThreadId :: ThreadId
|
||||||
|
}
|
||||||
|
|
||||||
data SomeAddr = IPv4Addr HostAddress | IPv6Addr HostAddress6
|
data SomeAddr = IPv4Addr HostAddress | IPv6Addr HostAddress6
|
||||||
deriving (Ord, Eq, Read, Show)
|
deriving (Ord, Eq, Read, Show)
|
||||||
|
|
|
@ -39,13 +39,18 @@ pairListenerThread st dstatus = thread $ withSocketsDo $ do
|
||||||
chunksz = 1024
|
chunksz = 1024
|
||||||
|
|
||||||
dispatch Nothing = noop
|
dispatch Nothing = noop
|
||||||
dispatch (Just (PairReqM (PairReq r))) = void $ do
|
dispatch (Just (PairReqM (PairReq v))) = unlessM (mypair v) $ do
|
||||||
let pairdata = verifiableVal r
|
let pairdata = verifiableVal v
|
||||||
let repo = remoteUserName pairdata ++ "@" ++
|
let repo = remoteUserName pairdata ++ "@" ++
|
||||||
fromMaybe (showAddr $ remoteAddress pairdata)
|
fromMaybe (showAddr $ remoteAddress pairdata)
|
||||||
(remoteHostName pairdata)
|
(remoteHostName pairdata)
|
||||||
let msg = repo ++ " is sending a pair request."
|
let msg = repo ++ " is sending a pair request."
|
||||||
{- Pair request alerts from the same host combine,
|
{- Pair request alerts from the same host combine,
|
||||||
- so repeated requests do not add additional alerts. -}
|
- so repeated requests do not add additional alerts. -}
|
||||||
addAlert dstatus $ pairRequestAlert repo msg
|
void $ addAlert dstatus $ pairRequestAlert repo msg
|
||||||
dispatch (Just (PairAckM _)) = noop -- TODO
|
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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue