mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

XMPP: Be better at responding to CanPush messages when busy with something else.

Browse source 
Observed: With 2 xmpp clients, one would sometimes stop responding
to CanPush messages. Often it was in the middle of a receive-pack
of its own (or was waiting for a failed one to time out).

Now these are always immediately responded to, which is fine; the point
of CanPush is to find out if there's another client out there that's
interested in our push.

Also, in queueNetPushMessage, queue push initiation messages when
we're already running the side of the push they would initiate.
Before, these messages were sent into the netMessagesPush channel,
which was wrong. The xmpp send-pack and receive-pack code discarded
such messages.

This still doesn't make XMPP push 100% robust. In testing, I am seeing
it sometimes try to run two send-packs, or two receive-packs at once
to the same client (probably because the client sent two requests).

Also, I'm seeing rather a lot of cases where it stalls out until it
runs into the 120 second timeout and cancels a push.

And finally, there seems to be a bug in runPush. I have logs that
show it running its setup action, but never its cleanup action.
How is this possible given its use of E.bracket? Either some exception
is finding its way through, or the action somehow stalls forever.
When this happens, one of the 2 clients stops syncing.
This commit is contained in:
Joey Hess 2013-05-21 00:59:38 -04:00
parent 230aed671f
commit 14d96b8e06
5 changed files with 17 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Assistant/XMPP/Git.hs
View file

@ -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