responding to pair requests *almost* works

This commit is contained in:
Joey Hess 2012-09-10 17:53:51 -04:00
parent b573d91aa2
commit c20d6f4189
9 changed files with 189 additions and 122 deletions

View file

@ -46,15 +46,20 @@ pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do
chunksz = 1024
dispatch Nothing = noop
dispatch (Just m) = case pairMsgStage m of
PairReq -> pairReqAlert dstatus urlrenderer m
PairAck -> pairAckAlert dstatus m
PairDone -> pairDoneAlert dstatus m
dispatch (Just m@(PairMsg v)) = do
verified <- maybe False (verify v . inProgressSecret)
. pairingInProgress
<$> getDaemonStatus dstatus
case pairMsgStage m of
PairReq -> pairReqReceived verified dstatus urlrenderer m
PairAck -> pairAckReceived verified dstatus m
PairDone -> pairDoneReceived verified dstatus m
{- Pair request alerts from the same host combine,
- so repeated requests do not add additional alerts. -}
pairReqAlert :: DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
pairReqReceived :: Bool -> DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO ()
pairReqReceived True _ _ _ = noop -- ignore out own PairReq
pairReqReceived False dstatus urlrenderer msg = do
url <- renderUrl urlrenderer (FinishPairR msg) []
void $ addAlert dstatus $ pairRequestReceivedAlert repo
(repo ++ " is sending a pair request.") $
@ -74,11 +79,6 @@ pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
, ":"
, (remoteDirectory pairdata)
]
{- Filter out our own pair request, by checking if we
- can verify using its secret. -}
myreq = maybe False (verified v . inProgressSecret)
. pairingInProgress
<$> getDaemonStatus dstatus
{- Remove the button when it's clicked, and change the
- alert to be in progress. This alert cannot be entirely
- removed since more pair request messages are coming in
@ -91,15 +91,16 @@ pairReqAlert dstatus urlrenderer msg = unlessM myreq $ do
}
{- When a valid PairAck is seen, a host has successfully paired with
- us, and we should finish pairing with them. Then send a PairDone.
- us, and we should finish pairing with them. Then send a single PairDone.
-
- A stale PairAck might also be seen, after we've finished pairing.
- Perhaps our PairDone was not received. To handle this, we keep
- a list of recently finished pairings, and re-send PairDone in
- response to stale PairAcks for them.
-}
pairAckAlert :: DaemonStatusHandle -> PairMsg -> IO ()
pairAckAlert dstatus msg = error "TODO"
pairAckReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO ()
pairAckReceived False _ _ = noop -- not verified
pairAckReceived True dstatus msg = error "TODO"
{- If we get a valid PairDone, and are sending PairAcks, we can stop
- sending them, as the message has been received.
@ -110,5 +111,6 @@ pairAckAlert dstatus msg = error "TODO"
- Note: This does allow a bad actor to squelch pairing on a network
- by sending bogus PairDones.
-}
pairDoneAlert :: DaemonStatusHandle -> PairMsg -> IO ()
pairDoneAlert dstatus msg = error "TODO"
pairDoneReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO ()
pairDoneReceived False _ _ = noop -- not verified
pairDoneReceived True dstatus msg = error "TODO"