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

assistant: Added sequence numbers to XMPP git push packets. (Not yet used.)

Browse source 
For backwards compatability, "" is treated as "0" sequence number.

--debug will show xmpp sequence numbers now, but they are not otherwise
used.
This commit is contained in:
Joey Hess 2013-04-10 18:39:56 -04:00
parent 92b1b8e9ab
commit 271a919d14
5 changed files with 45 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

23
Assistant/XMPP/Git.hs
View file

@ -108,7 +108,7 @@ xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do
outh <- liftIO $ fdToHandle writepush
controlh <- liftIO $ fdToHandle writecontrol
t1 <- forkIO <~> toxmpp inh
t1 <- forkIO <~> toxmpp 0 inh
t2 <- forkIO <~> fromxmpp outh controlh
{- This can take a long time to run, so avoid running it in the
@ -122,15 +122,19 @@ xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do
return r
where
toxmpp inh = forever $ do
toxmpp seqnum inh = do
b <- liftIO $ B.hGetSome inh chunkSize
if B.null b
then liftIO $ killThread =<< myThreadId
else sendNetMessage $ Pushing cid $ SendPackOutput b
else do
let seqnum' = succ seqnum
sendNetMessage $ Pushing cid $
SendPackOutput seqnum' b
toxmpp seqnum' inh
fromxmpp outh controlh = forever $ do
m <- timeout xmppTimeout <~> waitNetPushMessage SendPack
case m of
(Just (Pushing _ (ReceivePackOutput b))) ->
(Just (Pushing _ (ReceivePackOutput _ b))) ->
liftIO $ writeChunk outh b
(Just (Pushing _ (ReceivePackDone exitcode))) ->
liftIO $ do
@ -213,7 +217,7 @@ xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do
}
(Just inh, Just outh, _, pid) <- liftIO $ createProcess p
readertid <- forkIO <~> relayfromxmpp inh
relaytoxmpp outh
relaytoxmpp 0 outh
code <- liftIO $ waitForProcess pid
void $ sendNetMessage $ Pushing cid $ ReceivePackDone code
liftIO $ do
@ -222,16 +226,17 @@ xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do
hClose outh
return $ code == ExitSuccess
where
relaytoxmpp outh = do
relaytoxmpp seqnum outh = do
b <- liftIO $ B.hGetSome outh chunkSize
-- empty is EOF, so exit
unless (B.null b) $ do
sendNetMessage $ Pushing cid $ ReceivePackOutput b
relaytoxmpp outh
let seqnum' = succ seqnum
sendNetMessage $ Pushing cid $ ReceivePackOutput seqnum' b
relaytoxmpp seqnum' outh
relayfromxmpp inh = forever $ do
m <- timeout xmppTimeout <~> waitNetPushMessage ReceivePack
case m of
(Just (Pushing _ (SendPackOutput b))) ->
(Just (Pushing _ (SendPackOutput _ b))) ->
liftIO $ writeChunk inh b
(Just _) -> noop
Nothing -> do