diff options
| -rw-r--r-- | Assistant/NetMessager.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/XMPPClient.hs | 1 | ||||
| -rw-r--r-- | Assistant/Types/NetMessager.hs | 7 | ||||
| -rw-r--r-- | Assistant/XMPP/Git.hs | 13 | ||||
| -rw-r--r-- | debian/changelog | 2 |
5 files changed, 17 insertions, 8 deletions
diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs index 97d17af6e..fd320b00b 100644 --- a/Assistant/NetMessager.hs +++ b/Assistant/NetMessager.hs @@ -110,8 +110,8 @@ queueNetPushMessage m@(Pushing clientid stage) = do case v of Nothing -> return False (Just runningclientid) - | runningclientid == clientid -> queue nm | isPushInitiation stage -> defer nm + | runningclientid == clientid -> queue nm | otherwise -> discard where side = pushDestinationSide stage diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 086494a74..dd1b2ac1f 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -107,6 +107,7 @@ xmppClient urlrenderer d creds = handle selfjid (GotNetMessage (PairingNotification stage c u)) = maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c) handle _ (GotNetMessage m@(Pushing _ pushstage)) + | isPushNotice pushstage = inAssistant $ handlePushNotice m | isPushInitiation pushstage = inAssistant $ unlessM (queueNetPushMessage m) $ do let checker = checkCloudRepos urlrenderer diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index 09a558033..bc0bf3c22 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -85,13 +85,16 @@ 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 _ = False +isPushNotice :: PushStage -> Bool +isPushNotice (CanPush _) = True +isPushNotice _ = False + data PushSide = SendPack | ReceivePack - deriving (Eq, Ord) + deriving (Eq, Ord, Show) pushDestinationSide :: PushStage -> PushSide pushDestinationSide (CanPush _) = ReceivePack diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 93479014d..7970f0506 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -287,10 +287,6 @@ xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of knownuuid um r = Remote.uuid r == theiruuid || M.member theiruuid um handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant () -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 @@ -317,8 +313,15 @@ handlePushInitiation checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do mapM_ checkcloudrepos rs handlePushInitiation _ _ = noop +handlePushNotice :: NetMessage -> Assistant () +handlePushNotice (Pushing cid (CanPush theiruuid)) = + unlessM (null <$> xmppRemotes cid theiruuid) $ do + u <- liftAnnex getUUID + sendNetMessage $ Pushing cid (PushRequest u) +handlePushNotice _ = noop + handleDeferred :: (Remote -> Assistant ()) -> NetMessage -> Assistant () -handleDeferred = handlePushInitiation +handleDeferred checkcloudrepos m = handlePushInitiation checkcloudrepos m writeChunk :: Handle -> B.ByteString -> IO () writeChunk h b = do diff --git a/debian/changelog b/debian/changelog index 97e8a5a87..7b8476727 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,6 +23,8 @@ git-annex (4.20130517) UNRELEASED; urgency=low * Linux standalone: Back to being built with glibc 2.13 for maximum portability. * XMPP: Ignore duplicate messages received when pushing. + * XMPP: Be better at responding to CanPush messages when busy with + something else. -- Joey Hess <joeyh@debian.org> Fri, 17 May 2013 11:17:03 -0400 |