diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index 1ea7db7ce4..57ed520242 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -42,13 +42,18 @@ data PushStage -- indicates that a push is starting | StartingPush -- a chunk of output of git receive-pack - | ReceivePackOutput ByteString + | ReceivePackOutput SequenceNum ByteString -- a chuck of output of git send-pack - | SendPackOutput ByteString + | SendPackOutput SequenceNum ByteString -- sent when git receive-pack exits, with its exit code | ReceivePackDone ExitCode deriving (Show, Eq, Ord) +{- A sequence number. Incremented by one per packet in a sequence, + - starting with 1 for the first packet. 0 means sequence numbers are + - not being used. -} +type SequenceNum = Int + {- NetMessages that are important (and small), and should be stored to be - resent when new clients are seen. -} isImportantNetMessage :: NetMessage -> Maybe ClientID @@ -64,8 +69,8 @@ readdressNetMessage m _ = m {- Convert a NetMessage to something that can be logged. -} sanitizeNetMessage :: NetMessage -> NetMessage sanitizeNetMessage (Pushing c stage) = Pushing c $ case stage of - ReceivePackOutput _ -> ReceivePackOutput elided - SendPackOutput _ -> SendPackOutput elided + ReceivePackOutput n _ -> ReceivePackOutput n elided + SendPackOutput n _ -> SendPackOutput n elided s -> s where elided = B8.pack "" @@ -85,8 +90,8 @@ pushDestinationSide :: PushStage -> PushSide pushDestinationSide CanPush = ReceivePack pushDestinationSide PushRequest = SendPack pushDestinationSide StartingPush = ReceivePack -pushDestinationSide (ReceivePackOutput _) = SendPack -pushDestinationSide (SendPackOutput _) = ReceivePack +pushDestinationSide (ReceivePackOutput _ _) = SendPack +pushDestinationSide (SendPackOutput _ _) = ReceivePack pushDestinationSide (ReceivePackDone _) = SendPack type SideMap a = PushSide -> a diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 2c00044036..01d42ba9bd 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -134,13 +134,13 @@ pushMessage = gitAnnexMessage . encode encode CanPush = gitAnnexTag canPushAttr T.empty encode PushRequest = gitAnnexTag pushRequestAttr T.empty encode StartingPush = gitAnnexTag startingPushAttr T.empty - encode (ReceivePackOutput b) = - gitAnnexTagContent receivePackAttr T.empty $ encodeTagContent b - encode (SendPackOutput b) = - gitAnnexTagContent sendPackAttr T.empty $ encodeTagContent b + encode (ReceivePackOutput n b) = + gitAnnexTagContent receivePackAttr (val n) $ encodeTagContent b + encode (SendPackOutput n b) = + gitAnnexTagContent sendPackAttr (val n) $ encodeTagContent b encode (ReceivePackDone code) = - gitAnnexTag receivePackDoneAttr $ - T.pack $ show $ encodeExitCode code + gitAnnexTag receivePackDoneAttr $ val $ encodeExitCode code + val = T.pack . show decodeMessage :: Message -> Maybe NetMessage decodeMessage m = decode =<< gitAnnexTagInfo m @@ -160,10 +160,8 @@ decodeMessage m = decode =<< gitAnnexTagInfo m , pushdecoder $ const $ Just CanPush , pushdecoder $ const $ Just PushRequest , pushdecoder $ const $ Just StartingPush - , pushdecoder $ - fmap ReceivePackOutput . decodeTagContent . tagElement - , pushdecoder $ - fmap SendPackOutput . decodeTagContent . tagElement + , pushdecoder $ gen ReceivePackOutput + , pushdecoder $ gen SendPackOutput , pushdecoder $ fmap (ReceivePackDone . decodeExitCode) . readish . T.unpack . tagValue @@ -171,6 +169,10 @@ decodeMessage m = decode =<< gitAnnexTagInfo m pushdecoder a m' i = Pushing <$> (formatJID <$> messageFrom m') <*> a i + gen c i = do + packet <- decodeTagContent $ tagElement i + let sequence = fromMaybe 0 $ readish $ T.unpack $ tagValue i + return $ c sequence packet decodeExitCode :: Int -> ExitCode decodeExitCode 0 = ExitSuccess diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 4fd878a9e2..808fbbc532 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -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 diff --git a/debian/changelog b/debian/changelog index 6a1cff3440..7b213cdded 100644 --- a/debian/changelog +++ b/debian/changelog @@ -18,6 +18,7 @@ git-annex (4.20130406) UNRELEASED; urgency=low VERSION_FROM_CHANGELOG. * webapp: Added animations. * assistant: Stop any transfers the assistant initiated on shutdown. + * assistant: Added sequence numbers to XMPP git push packets. (Not yet used.) -- Joey Hess Sat, 06 Apr 2013 15:24:15 -0400 diff --git a/doc/design/assistant/xmpp.mdwn b/doc/design/assistant/xmpp.mdwn index fed79527ed..6be92f464e 100644 --- a/doc/design/assistant/xmpp.mdwn +++ b/doc/design/assistant/xmpp.mdwn @@ -88,17 +88,22 @@ When a peer is ready to send a git push, it sends: The receiver runs `git receive-pack`, and sends back its output in one or more chat messages, directed to the client that is pushing: - + 007b27ca394d26a05d9b6beefa1b07da456caa2157d7 refs/heads/git-annex report-status delete-refs side-band-64k quiet ofs-delta The sender replies with the data from `git push`, in one or more chat messages, directed to the receiver: - + data +The value of rp and sp used to be empty, but now it's a sequence number. +This indicates the sequence of this packet, counting from 1. The receiver +and sender each have their own sequence numbers. These sequence numbers +are not really used yet, but are available for debugging. + When `git receive-pack` exits, the receiver indicates its exit status with a chat message, directed at the sender: