summaryrefslogtreecommitdiff
path: root/Assistant/XMPP/Git.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/XMPP/Git.hs')
-rw-r--r--Assistant/XMPP/Git.hs27
1 files changed, 16 insertions, 11 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 46c8cb173..c1605bee2 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)