diff options
author | Joey Hess <joey@kitenet.net> | 2013-05-21 18:24:29 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-05-21 18:24:29 -0400 |
commit | b6ebb173e7b5d4d07577cb2918e7d1a24fbc1f60 (patch) | |
tree | 8c994e00b091c448d80737aa99bbc181701eee04 /Assistant/XMPP/Git.hs | |
parent | 14f2a42ca4131a7a51a9e10a94521639b971bccd (diff) |
XMPP: Avoid redundant and unncessary pushes. Note that this breaks compatibility with previous versions of git-annex, which will refuse to accept any XMPP pushes from this version.
Diffstat (limited to 'Assistant/XMPP/Git.hs')
-rw-r--r-- | Assistant/XMPP/Git.hs | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 98c70cf41..c314042e6 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -23,6 +23,7 @@ import qualified Annex.Branch import Annex.UUID import Logs.UUID import Annex.TaggedPush +import Annex.CatFile import Config import Git import qualified Git.Branch @@ -311,11 +312,27 @@ handlePushInitiation checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do mapM_ checkcloudrepos rs handlePushInitiation _ _ = noop +{- Check if any of the shas that can be pushed are ones we do not + - have. + - + - (Older clients send no shas, so when there are none, always + - request a push.) + -} handlePushNotice :: NetMessage -> Assistant () -handlePushNotice (Pushing cid (CanPush theiruuid)) = - unlessM (null <$> xmppRemotes cid theiruuid) $ do +handlePushNotice (Pushing cid (CanPush theiruuid shas)) = + unlessM (null <$> xmppRemotes cid theiruuid) $ + if null shas + then go + else ifM (haveall shas) + ( debug ["ignoring CanPush with known shas"] + , go + ) + where + go = do u <- liftAnnex getUUID sendNetMessage $ Pushing cid (PushRequest u) + haveall l = liftAnnex $ not <$> anyM donthave l + donthave sha = isNothing <$> catObjectDetails sha handlePushNotice _ = noop writeChunk :: Handle -> B.ByteString -> IO () |