From df88c513343700b3ae297f9ebae09a61b083952f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 30 Apr 2013 13:22:55 -0400 Subject: [PATCH] add uuid to all xmpp messages (Except for the actual streaming of receive-pack through XMPP, which can only run once we've gotten an appropriate uuid in a push initiation message.) Pushes are now only initiated when the initiation message comes from a known uuid. This allows multiple distinct repositories to use the same xmpp address. Note: This probably breaks initial push after xmpp pairing, because at that point we may not know about the paired uuid, and so reject the push from it. It won't break in simple cases, because the annex-uuid of the remote is checked. However, when there are multiple clients behind a single xmpp address, only uuid of the first is recorded in annex-uuid, and so any pushes from the others will be rejected (unless the first remote pushes their uuids to us beforehand. --- Assistant/Sync.hs | 5 +++-- Assistant/Types/NetMessager.hs | 22 +++++++++++----------- Assistant/XMPP.hs | 22 +++++++++++++--------- Assistant/XMPP/Git.hs | 27 ++++++++++++++++----------- doc/design/assistant/xmpp.mdwn | 8 ++++---- 5 files changed, 47 insertions(+), 37 deletions(-) diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 727749c4ff..1b9de16566 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -113,7 +113,7 @@ pushToRemotes' now notifypushes remotes = do let (xmppremotes, normalremotes) = partition isXMPPRemote remotes ret <- go True branch g u normalremotes forM_ xmppremotes $ \r -> - sendNetMessage $ Pushing (getXMPPClientID r) CanPush + sendNetMessage $ Pushing (getXMPPClientID r) (CanPush u) return ret where go _ Nothing _ _ _ = return [] -- no branch, so nothing to do @@ -202,8 +202,9 @@ manualPull currentbranch remotes = do haddiverged <- liftAnnex Annex.Branch.forceUpdate forM_ normalremotes $ \r -> liftAnnex $ Command.Sync.mergeRemote r currentbranch + u <- liftAnnex getUUID forM_ xmppremotes $ \r -> - sendNetMessage $ Pushing (getXMPPClientID r) PushRequest + sendNetMessage $ Pushing (getXMPPClientID r) (PushRequest u) return (catMaybes failed, haddiverged) {- Start syncing a remote, using a background thread. -} diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index e0dcbbb56c..09a5580337 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -37,11 +37,11 @@ type ClientID = Text data PushStage -- indicates that we have data to push over the out of band network - = CanPush + = CanPush UUID -- request that a git push be sent over the out of band network - | PushRequest + | PushRequest UUID -- indicates that a push is starting - | StartingPush + | StartingPush UUID -- a chunk of output of git receive-pack | ReceivePackOutput SequenceNum ByteString -- a chuck of output of git send-pack @@ -58,8 +58,8 @@ type SequenceNum = Int {- NetMessages that are important (and small), and should be stored to be - resent when new clients are seen. -} isImportantNetMessage :: NetMessage -> Maybe ClientID -isImportantNetMessage (Pushing c CanPush) = Just c -isImportantNetMessage (Pushing c PushRequest) = Just c +isImportantNetMessage (Pushing c (CanPush _)) = Just c +isImportantNetMessage (Pushing c (PushRequest _)) = Just c isImportantNetMessage _ = Nothing readdressNetMessage :: NetMessage -> ClientID -> NetMessage @@ -85,18 +85,18 @@ logClientID c = T.concat [T.take 1 c, T.pack $ show $ T.length c] {- Things that initiate either side of a push, but do not actually send data. -} isPushInitiation :: PushStage -> Bool -isPushInitiation CanPush = True -isPushInitiation PushRequest = True -isPushInitiation StartingPush = True +isPushInitiation (CanPush _) = True +isPushInitiation (PushRequest _) = True +isPushInitiation (StartingPush _) = True isPushInitiation _ = False data PushSide = SendPack | ReceivePack deriving (Eq, Ord) pushDestinationSide :: PushStage -> PushSide -pushDestinationSide CanPush = ReceivePack -pushDestinationSide PushRequest = SendPack -pushDestinationSide StartingPush = ReceivePack +pushDestinationSide (CanPush _) = ReceivePack +pushDestinationSide (PushRequest _) = SendPack +pushDestinationSide (StartingPush _) = ReceivePack pushDestinationSide (ReceivePackOutput _ _) = SendPack pushDestinationSide (SendPackOutput _ _) = ReceivePack pushDestinationSide (ReceivePackDone _) = SendPack diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 9654fdb4ba..fbc3519313 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -131,9 +131,12 @@ decodePairingNotification m = parse . words . T.unpack . tagValue pushMessage :: PushStage -> JID -> JID -> Message pushMessage = gitAnnexMessage . encode where - encode CanPush = gitAnnexTag canPushAttr T.empty - encode PushRequest = gitAnnexTag pushRequestAttr T.empty - encode StartingPush = gitAnnexTag startingPushAttr T.empty + encode (CanPush u) = + gitAnnexTag canPushAttr $ T.pack $ fromUUID u + encode (PushRequest u) = + gitAnnexTag pushRequestAttr $ T.pack $ fromUUID u + encode (StartingPush u) = + gitAnnexTag startingPushAttr $ T.pack $ fromUUID u encode (ReceivePackOutput n b) = gitAnnexTagContent receivePackAttr (val n) $ encodeTagContent b encode (SendPackOutput n b) = @@ -157,11 +160,11 @@ decodeMessage m = decode =<< gitAnnexTagInfo m , receivePackDoneAttr ] [ decodePairingNotification - , pushdecoder $ const $ Just CanPush - , pushdecoder $ const $ Just PushRequest - , pushdecoder $ const $ Just StartingPush - , pushdecoder $ gen ReceivePackOutput - , pushdecoder $ gen SendPackOutput + , pushdecoder $ gen CanPush + , pushdecoder $ gen PushRequest + , pushdecoder $ gen StartingPush + , pushdecoder $ seqgen ReceivePackOutput + , pushdecoder $ seqgen SendPackOutput , pushdecoder $ fmap (ReceivePackDone . decodeExitCode) . readish . T.unpack . tagValue @@ -169,7 +172,8 @@ decodeMessage m = decode =<< gitAnnexTagInfo m pushdecoder a m' i = Pushing <$> (formatJID <$> messageFrom m') <*> a i - gen c i = do + gen c = Just . c . toUUID . T.unpack . tagValue + seqgen c i = do packet <- decodeTagContent $ tagElement i let seqnum = fromMaybe 0 $ readish $ T.unpack $ tagValue i return $ c seqnum packet diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 46c8cb1737..c1605bee2c 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -21,6 +21,7 @@ import Assistant.Sync import qualified Command.Sync import qualified Annex.Branch import Annex.UUID +import Logs.UUID import Annex.TaggedPush import Config import Git @@ -84,7 +85,8 @@ makeXMPPGitRemote buddyname jid u = do -} xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do - sendNetMessage $ Pushing cid StartingPush + u <- liftAnnex getUUID + sendNetMessage $ Pushing cid (StartingPush u) (Fd inf, writepush) <- liftIO createPipe (readpush, Fd outf) <- liftIO createPipe @@ -247,26 +249,29 @@ xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do hClose inh killThread =<< myThreadId -xmppRemotes :: ClientID -> Assistant [Remote] -xmppRemotes cid = case baseJID <$> parseJID cid of +xmppRemotes :: ClientID -> UUID -> Assistant [Remote] +xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of Nothing -> return [] Just jid -> do let loc = gitXMPPLocation jid - filter (matching loc . Remote.repo) . syncGitRemotes + um <- liftAnnex uuidMap + filter (matching loc . Remote.repo) . filter (knownuuid um) . syncGitRemotes <$> getDaemonStatus where matching loc r = repoIsUrl r && repoLocation r == loc + knownuuid um r = Remote.uuid r == theiruuid || M.member theiruuid um handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant () -handlePushInitiation _ (Pushing cid CanPush) = - unlessM (null <$> xmppRemotes cid) $ - sendNetMessage $ Pushing cid PushRequest -handlePushInitiation checkcloudrepos (Pushing cid PushRequest) = +handlePushInitiation _ (Pushing cid (CanPush theiruuid)) = + unlessM (null <$> xmppRemotes cid theiruuid) $ do + u <- liftAnnex getUUID + sendNetMessage $ Pushing cid (PushRequest u) +handlePushInitiation checkcloudrepos (Pushing cid (PushRequest theiruuid)) = go =<< liftAnnex (inRepo Git.Branch.current) where go Nothing = noop go (Just branch) = do - rs <- xmppRemotes cid + rs <- xmppRemotes cid theiruuid liftAnnex $ Annex.Branch.commit "update" (g, u) <- liftAnnex $ (,) <$> gitRepo @@ -279,8 +284,8 @@ handlePushInitiation checkcloudrepos (Pushing cid PushRequest) = (taggedPush u selfjid branch r) (handleDeferred checkcloudrepos) checkcloudrepos r -handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do - rs <- xmppRemotes cid +handlePushInitiation checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do + rs <- xmppRemotes cid theiruuid unless (null rs) $ do void $ alertWhile (syncAlert rs) $ xmppReceivePack cid (handleDeferred checkcloudrepos) diff --git a/doc/design/assistant/xmpp.mdwn b/doc/design/assistant/xmpp.mdwn index f132f802e4..0afba9c23d 100644 --- a/doc/design/assistant/xmpp.mdwn +++ b/doc/design/assistant/xmpp.mdwn @@ -69,18 +69,18 @@ containing: For pairing, a chat message is sent to every known git-annex client, containing: - + ### git push over XMPP To indicate that we could push over XMPP, a chat message is sent, to each known client of each XMPP remote. - + To request that a remote push to us, a chat message can be sent. - + When replying to an canpush message, this is directed at the specific client that indicated it could push. To solicit pushes from all clients, @@ -88,7 +88,7 @@ the message has to be sent directed individually to each client. When a peer is ready to send a git push, it sends: - + The receiver runs `git receive-pack`, and sends back its output in one or more chat messages, directed to the client that is pushing: