diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-10 21:55:59 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-10 21:55:59 -0400 |
commit | d19bbd29d8f473eae1aa1fa76c22e5374922c108 (patch) | |
tree | ffb8391884b271a822f1e031d1051219093b267a /Assistant/Threads | |
parent | a41255723c55d0046e8a9953a7ebaef9d2196bb5 (diff) |
pairing probably works now (untested)
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/PairListener.hs | 63 |
1 files changed, 36 insertions, 27 deletions
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs index 8b1cac2ba..e0ed1217a 100644 --- a/Assistant/Threads/PairListener.hs +++ b/Assistant/Threads/PairListener.hs @@ -10,7 +10,9 @@ module Assistant.Threads.PairListener where import Assistant.Common import Assistant.Pairing import Assistant.Pairing.Network +import Assistant.Pairing.MakeRemote import Assistant.ThreadedMonad +import Assistant.ScanRemotes import Assistant.DaemonStatus import Assistant.WebApp import Assistant.WebApp.Types @@ -25,8 +27,8 @@ import qualified Data.Text as T thisThread :: ThreadName thisThread = "PairListener" -pairListenerThread :: ThreadState -> DaemonStatusHandle -> UrlRenderer -> NamedThread -pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do +pairListenerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> UrlRenderer -> NamedThread +pairListenerThread st dstatus scanremotes urlrenderer = thread $ withSocketsDo $ do sock <- multicastReceiver (multicastAddress $ IPv4Addr undefined) pairingPort go sock where @@ -47,15 +49,16 @@ pairListenerThread st dstatus urlrenderer = thread $ withSocketsDo $ do dispatch Nothing = noop dispatch (Just m@(PairMsg v)) = do - verified <- maybe False (verify v . inProgressSecret) - . pairingInProgress - <$> getDaemonStatus dstatus + pip <- pairingInProgress <$> getDaemonStatus dstatus + let verified = maybe False (verify v . inProgressSecret) pip case pairMsgStage m of PairReq -> pairReqReceived verified dstatus urlrenderer m - PairAck -> pairAckReceived verified dstatus m - PairDone -> pairDoneReceived verified dstatus m + PairAck -> pairAckReceived verified pip st dstatus scanremotes m + PairDone -> pairDoneReceived verified pip st dstatus scanremotes m -{- Pair request alerts from the same host combine, +{- Show an alert when a PairReq is seen. + - + - Pair request alerts from the same host combine, - so repeated requests do not add additional alerts. -} pairReqReceived :: Bool -> DaemonStatusHandle -> UrlRenderer -> PairMsg -> IO () pairReqReceived True _ _ _ = noop -- ignore out own PairReq @@ -69,12 +72,11 @@ pairReqReceived False dstatus urlrenderer msg = do , buttonAction = Just onclick } where - v = fromPairMsg msg - (_, pairdata) = verifiableVal v + pairdata = pairMsgData msg repo = concat [ remoteUserName pairdata , "@" - , fromMaybe (showAddr $ remoteAddress pairdata) + , fromMaybe (showAddr $ pairMsgAddr msg) (remoteHostName pairdata) , ":" , (remoteDirectory pairdata) @@ -90,27 +92,34 @@ pairReqReceived False dstatus urlrenderer msg = do , alertData = [UnTensed $ T.pack $ "pair request with " ++ repo ++ " in progress"] } -{- When a valid PairAck is seen, a host has successfully paired with - - us, and we should finish pairing with them. Then send a single PairDone. +{- When a verified PairAck is seen, a host is ready to pair with us, and has + - already configured our ssh key. Stop sending PairReqs, finish the pairing, + - and send a few PairDones. - - - A stale PairAck might also be seen, after we've finished pairing. + - TODO: 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. -} -pairAckReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO () -pairAckReceived False _ _ = noop -- not verified -pairAckReceived True dstatus msg = error "TODO" +pairAckReceived :: Bool -> Maybe PairingInProgress -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> IO () +pairAckReceived False _ _ _ _ _ = noop -- not verified +pairAckReceived True Nothing _ _ _ _ = noop -- not in progress +pairAckReceived True (Just pip) st dstatus scanremotes msg = do + stopSending dstatus pip + finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip) + startSending dstatus pip $ multicastPairMsg + (Just 10) (inProgressSecret pip) PairDone (inProgressPairData pip) -{- If we get a valid PairDone, and are sending PairAcks, we can stop - - sending them, as the message has been received. +{- If we get a verified PairDone, the host has accepted our PairAck, and + - has paired with us. Stop sending PairAcks, and finish pairing with them. - - - Also, now is the time to remove the pair request alert, as pairing is - - over. Do that even if the PairDone cannot be validated, as we might - - be a third host that did not participate in the pairing. - - Note: This does allow a bad actor to squelch pairing on a network - - by sending bogus PairDones. + - TODO: Should third-party hosts remove their pair request alert when they + - see a PairDone? How to tell if a PairDone matches with the PairReq + - that brought up the alert? Cannot verify it without the secret.. -} -pairDoneReceived :: Bool -> DaemonStatusHandle -> PairMsg -> IO () -pairDoneReceived False _ _ = noop -- not verified -pairDoneReceived True dstatus msg = error "TODO" +pairDoneReceived :: Bool -> Maybe PairingInProgress -> ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PairMsg -> IO () +pairDoneReceived False _ _ _ _ _ = noop -- not verified +pairDoneReceived True Nothing _ _ _ _ = noop -- not in progress +pairDoneReceived True (Just pip) st dstatus scanremotes msg = do + stopSending dstatus pip + finishedPairing st dstatus scanremotes msg (inProgressSshKeyPair pip) |