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

run xmpp push actions in separate thread from xmpp client

Browse source 
Took me a while to figure out why the xmpp client was not receiving git xmpp
push messages after a push started.
This commit is contained in:
Joey Hess 2012-11-09 16:04:55 -04:00
parent 232b61e946
commit 47c032a748
2 changed files with 15 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Assistant/Threads/XMPPClient.hs
View file

@ -96,17 +96,18 @@ xmppClient urlrenderer d = do
handle _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us handle _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us
handle selfjid (GotNetMessage (PairingNotification stage c u)) = handle selfjid (GotNetMessage (PairingNotification stage c u)) =
maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c) maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c)
handle _ (GotNetMessage m@(CanPush _)) = inAssistant $ handle _ (GotNetMessage m@(CanPush _)) = handlepushmsg m
unlessM (queueNetPushMessage m) $ void $ handlePushMessage m handle _ (GotNetMessage m@(PushRequest _)) = handlepushmsg m
handle _ (GotNetMessage m@(PushRequest _)) = inAssistant $ handle _ (GotNetMessage m@(StartingPush _)) = handlepushmsg m
unlessM (queueNetPushMessage m) $ void $ handlePushMessage m
handle _ (GotNetMessage m@(StartingPush _)) = inAssistant $
unlessM (queueNetPushMessage m) $ void $ handlePushMessage m
handle _ (GotNetMessage m) = void $ inAssistant $ queueNetPushMessage m handle _ (GotNetMessage m) = void $ inAssistant $ queueNetPushMessage m
handle _ (Ignorable _) = noop handle _ (Ignorable _) = noop
handle _ (Unknown _) = noop handle _ (Unknown _) = noop
handle _ (ProtocolError _) = noop handle _ (ProtocolError _) = noop
handlepushmsg m = inAssistant $
unlessM (queueNetPushMessage m) $
void $ forkIO <~> handlePushMessage m
data XMPPEvent data XMPPEvent
= GotNetMessage NetMessage = GotNetMessage NetMessage
| PresenceMessage Presence | PresenceMessage Presence

20
Assistant/XMPP/Git.hs
View file

@ -224,24 +224,20 @@ xmppRemotes cid = case baseJID <$> parseJID cid of
return $ repoIsUrl r && repoLocation r == "xmpp::" ++ want return $ repoIsUrl r && repoLocation r == "xmpp::" ++ want
handleDeferred :: NetMessage -> Assistant () handleDeferred :: NetMessage -> Assistant ()
handleDeferred = void . handlePushMessage handleDeferred = handlePushMessage
handlePushMessage :: NetMessage -> Assistant Bool handlePushMessage :: NetMessage -> Assistant ()
handlePushMessage (CanPush cid) = do handlePushMessage (CanPush cid) = do
rs <- xmppRemotes cid rs <- xmppRemotes cid
if null rs unless (null rs) $
then return False sendNetMessage $ PushRequest cid
else do
sendNetMessage $ PushRequest cid
return True
handlePushMessage (PushRequest cid) = do handlePushMessage (PushRequest cid) = do
rs <- xmppRemotes cid rs <- xmppRemotes cid
current <- liftAnnex $ inRepo Git.Branch.current current <- liftAnnex $ inRepo Git.Branch.current
let refs = catMaybes [current, Just Annex.Branch.fullname] let refs = catMaybes [current, Just Annex.Branch.fullname]
any id <$> (forM rs $ \r -> xmppPush cid r refs) forM_ rs $ \r -> xmppPush cid r refs
handlePushMessage (StartingPush cid) = do handlePushMessage (StartingPush cid) = do
rs <- xmppRemotes cid rs <- xmppRemotes cid
if null rs unless (null rs) $
then return False void $ xmppReceivePack cid
else xmppReceivePack cid handlePushMessage _ = noop
handlePushMessage _ = return False