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

add uuid to all xmpp messages

Browse source 
(Except for the actual streaming of receive-pack through XMPP, which
can only run once we've gotten an appropriate uuid in a push initiation
message.)

Pushes are now only initiated when the initiation message comes from a
known uuid. This allows multiple distinct repositories to use the same xmpp
address.

Note: This probably breaks initial push after xmpp pairing, because at that
point we may not know about the paired uuid, and so reject the push from
it. It won't break in simple cases, because the annex-uuid of the remote
is checked. However, when there are multiple clients behind a single xmpp
address, only uuid of the first is recorded in annex-uuid, and so any
pushes from the others will be rejected (unless the first remote pushes their
uuids to us beforehand.
This commit is contained in:
Joey Hess 2013-04-30 13:22:55 -04:00
parent 343f989c14
commit df88c51334
5 changed files with 47 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

5
Assistant/Sync.hs
View file

@ -113,7 +113,7 @@ pushToRemotes' now notifypushes remotes = do
let (xmppremotes, normalremotes) = partition isXMPPRemote remotes let (xmppremotes, normalremotes) = partition isXMPPRemote remotes
ret <- go True branch g u normalremotes ret <- go True branch g u normalremotes
forM_ xmppremotes $ \r -> forM_ xmppremotes $ \r ->
sendNetMessage $ Pushing (getXMPPClientID r) CanPush sendNetMessage $ Pushing (getXMPPClientID r) (CanPush u)
return ret return ret
where where
go _ Nothing _ _ _ = return [] -- no branch, so nothing to do go _ Nothing _ _ _ = return [] -- no branch, so nothing to do
@ -202,8 +202,9 @@ manualPull currentbranch remotes = do
haddiverged <- liftAnnex Annex.Branch.forceUpdate haddiverged <- liftAnnex Annex.Branch.forceUpdate
forM_ normalremotes $ \r -> forM_ normalremotes $ \r ->
liftAnnex $ Command.Sync.mergeRemote r currentbranch liftAnnex $ Command.Sync.mergeRemote r currentbranch
u <- liftAnnex getUUID
forM_ xmppremotes $ \r -> forM_ xmppremotes $ \r ->
sendNetMessage $ Pushing (getXMPPClientID r) PushRequest sendNetMessage $ Pushing (getXMPPClientID r) (PushRequest u)
return (catMaybes failed, haddiverged) return (catMaybes failed, haddiverged)
{- Start syncing a remote, using a background thread. -} {- Start syncing a remote, using a background thread. -}

22
Assistant/Types/NetMessager.hs
View file

@ -37,11 +37,11 @@ type ClientID = Text
data PushStage data PushStage
-- indicates that we have data to push over the out of band network -- indicates that we have data to push over the out of band network
= CanPush = CanPush UUID
-- request that a git push be sent over the out of band network -- request that a git push be sent over the out of band network
| PushRequest | PushRequest UUID
-- indicates that a push is starting -- indicates that a push is starting
| StartingPush | StartingPush UUID
-- a chunk of output of git receive-pack -- a chunk of output of git receive-pack
| ReceivePackOutput SequenceNum ByteString | ReceivePackOutput SequenceNum ByteString
-- a chuck of output of git send-pack -- a chuck of output of git send-pack
@ -58,8 +58,8 @@ type SequenceNum = Int
{- NetMessages that are important (and small), and should be stored to be {- NetMessages that are important (and small), and should be stored to be
- resent when new clients are seen. -} - resent when new clients are seen. -}
isImportantNetMessage :: NetMessage -> Maybe ClientID isImportantNetMessage :: NetMessage -> Maybe ClientID
isImportantNetMessage (Pushing c CanPush) = Just c isImportantNetMessage (Pushing c (CanPush _)) = Just c
isImportantNetMessage (Pushing c PushRequest) = Just c isImportantNetMessage (Pushing c (PushRequest _)) = Just c
isImportantNetMessage _ = Nothing isImportantNetMessage _ = Nothing
readdressNetMessage :: NetMessage -> ClientID -> NetMessage readdressNetMessage :: NetMessage -> ClientID -> NetMessage
@ -85,18 +85,18 @@ 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. -} {- Things that initiate either side of a push, but do not actually send data. -}
isPushInitiation :: PushStage -> Bool isPushInitiation :: PushStage -> Bool
isPushInitiation CanPush = True isPushInitiation (CanPush _) = True
isPushInitiation PushRequest = True isPushInitiation (PushRequest _) = True
isPushInitiation StartingPush = True isPushInitiation (StartingPush _) = True
isPushInitiation _ = False isPushInitiation _ = False
data PushSide = SendPack | ReceivePack data PushSide = SendPack | ReceivePack
deriving (Eq, Ord) deriving (Eq, Ord)
pushDestinationSide :: PushStage -> PushSide pushDestinationSide :: PushStage -> PushSide
pushDestinationSide CanPush = ReceivePack pushDestinationSide (CanPush _) = ReceivePack
pushDestinationSide PushRequest = SendPack pushDestinationSide (PushRequest _) = SendPack
pushDestinationSide StartingPush = ReceivePack pushDestinationSide (StartingPush _) = ReceivePack
pushDestinationSide (ReceivePackOutput _ _) = SendPack pushDestinationSide (ReceivePackOutput _ _) = SendPack
pushDestinationSide (SendPackOutput _ _) = ReceivePack pushDestinationSide (SendPackOutput _ _) = ReceivePack
pushDestinationSide (ReceivePackDone _) = SendPack pushDestinationSide (ReceivePackDone _) = SendPack

22
Assistant/XMPP.hs
View file

@ -131,9 +131,12 @@ decodePairingNotification m = parse . words . T.unpack . tagValue
pushMessage :: PushStage -> JID -> JID -> Message pushMessage :: PushStage -> JID -> JID -> Message
pushMessage = gitAnnexMessage . encode pushMessage = gitAnnexMessage . encode
where where
encode CanPush = gitAnnexTag canPushAttr T.empty encode (CanPush u) =
encode PushRequest = gitAnnexTag pushRequestAttr T.empty gitAnnexTag canPushAttr $ T.pack $ fromUUID u
encode StartingPush = gitAnnexTag startingPushAttr T.empty encode (PushRequest u) =
gitAnnexTag pushRequestAttr $ T.pack $ fromUUID u
encode (StartingPush u) =
gitAnnexTag startingPushAttr $ T.pack $ fromUUID u
encode (ReceivePackOutput n b) = encode (ReceivePackOutput n b) =
gitAnnexTagContent receivePackAttr (val n) $ encodeTagContent b gitAnnexTagContent receivePackAttr (val n) $ encodeTagContent b
encode (SendPackOutput n b) = encode (SendPackOutput n b) =
@ -157,11 +160,11 @@ decodeMessage m = decode =<< gitAnnexTagInfo m
, receivePackDoneAttr , receivePackDoneAttr
] ]
[ decodePairingNotification [ decodePairingNotification
, pushdecoder $ const $ Just CanPush , pushdecoder $ gen CanPush
, pushdecoder $ const $ Just PushRequest , pushdecoder $ gen PushRequest
, pushdecoder $ const $ Just StartingPush , pushdecoder $ gen StartingPush
, pushdecoder $ gen ReceivePackOutput , pushdecoder $ seqgen ReceivePackOutput
, pushdecoder $ gen SendPackOutput , pushdecoder $ seqgen SendPackOutput
, pushdecoder $ , pushdecoder $
fmap (ReceivePackDone . decodeExitCode) . readish . fmap (ReceivePackDone . decodeExitCode) . readish .
T.unpack . tagValue T.unpack . tagValue
@ -169,7 +172,8 @@ decodeMessage m = decode =<< gitAnnexTagInfo m
pushdecoder a m' i = Pushing pushdecoder a m' i = Pushing
<$> (formatJID <$> messageFrom m') <$> (formatJID <$> messageFrom m')
<*> a i <*> a i
gen c i = do gen c = Just . c . toUUID . T.unpack . tagValue
seqgen c i = do
packet <- decodeTagContent $ tagElement i packet <- decodeTagContent $ tagElement i
let seqnum = fromMaybe 0 $ readish $ T.unpack $ tagValue i let seqnum = fromMaybe 0 $ readish $ T.unpack $ tagValue i
return $ c seqnum packet return $ c seqnum packet

27
Assistant/XMPP/Git.hs
View file

@ -21,6 +21,7 @@ import Assistant.Sync
import qualified Command.Sync import qualified Command.Sync
import qualified Annex.Branch import qualified Annex.Branch
import Annex.UUID import Annex.UUID
import Logs.UUID
import Annex.TaggedPush import Annex.TaggedPush
import Config import Config
import Git import Git
@ -84,7 +85,8 @@ makeXMPPGitRemote buddyname jid u = do
-} -}
xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool xmppPush :: ClientID -> (Git.Repo -> IO Bool) -> (NetMessage -> Assistant ()) -> Assistant Bool
xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do
sendNetMessage $ Pushing cid StartingPush u <- liftAnnex getUUID
sendNetMessage $ Pushing cid (StartingPush u)
(Fd inf, writepush) <- liftIO createPipe (Fd inf, writepush) <- liftIO createPipe
(readpush, Fd outf) <- liftIO createPipe (readpush, Fd outf) <- liftIO createPipe
@ -247,26 +249,29 @@ xmppReceivePack cid handledeferred = runPush ReceivePack cid handledeferred $ do
hClose inh hClose inh
killThread =<< myThreadId killThread =<< myThreadId
xmppRemotes :: ClientID -> Assistant [Remote] xmppRemotes :: ClientID -> UUID -> Assistant [Remote]
xmppRemotes cid = case baseJID <$> parseJID cid of xmppRemotes cid theiruuid = case baseJID <$> parseJID cid of
Nothing -> return [] Nothing -> return []
Just jid -> do Just jid -> do
let loc = gitXMPPLocation jid let loc = gitXMPPLocation jid
filter (matching loc . Remote.repo) . syncGitRemotes um <- liftAnnex uuidMap
filter (matching loc . Remote.repo) . filter (knownuuid um) . syncGitRemotes
<$> getDaemonStatus <$> getDaemonStatus
where where
matching loc r = repoIsUrl r && repoLocation r == loc matching loc r = repoIsUrl r && repoLocation r == loc
knownuuid um r = Remote.uuid r == theiruuid || M.member theiruuid um
handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant () handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant ()
handlePushInitiation _ (Pushing cid CanPush) = handlePushInitiation _ (Pushing cid (CanPush theiruuid)) =
unlessM (null <$> xmppRemotes cid) $ unlessM (null <$> xmppRemotes cid theiruuid) $ do
sendNetMessage $ Pushing cid PushRequest u <- liftAnnex getUUID
handlePushInitiation checkcloudrepos (Pushing cid PushRequest) = sendNetMessage $ Pushing cid (PushRequest u)
handlePushInitiation checkcloudrepos (Pushing cid (PushRequest theiruuid)) =
go =<< liftAnnex (inRepo Git.Branch.current) go =<< liftAnnex (inRepo Git.Branch.current)
where where
go Nothing = noop go Nothing = noop
go (Just branch) = do go (Just branch) = do
rs <- xmppRemotes cid rs <- xmppRemotes cid theiruuid
liftAnnex $ Annex.Branch.commit "update" liftAnnex $ Annex.Branch.commit "update"
(g, u) <- liftAnnex $ (,) (g, u) <- liftAnnex $ (,)
<$> gitRepo <$> gitRepo
@ -279,8 +284,8 @@ handlePushInitiation checkcloudrepos (Pushing cid PushRequest) =
(taggedPush u selfjid branch r) (taggedPush u selfjid branch r)
(handleDeferred checkcloudrepos) (handleDeferred checkcloudrepos)
checkcloudrepos r checkcloudrepos r
handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do handlePushInitiation checkcloudrepos (Pushing cid (StartingPush theiruuid)) = do
rs <- xmppRemotes cid rs <- xmppRemotes cid theiruuid
unless (null rs) $ do unless (null rs) $ do
void $ alertWhile (syncAlert rs) $ void $ alertWhile (syncAlert rs) $
xmppReceivePack cid (handleDeferred checkcloudrepos) xmppReceivePack cid (handleDeferred checkcloudrepos)

8
doc/design/assistant/xmpp.mdwn
View file

@ -69,18 +69,18 @@ containing:
For pairing, a chat message is sent to every known git-annex client, For pairing, a chat message is sent to every known git-annex client,
containing: containing:
<git-annex xmlns='git-annex' pairing="PairReq|PairAck|PairDone uuid" /> <git-annex xmlns='git-annex' pairing="PairReq|PairAck|PairDone myuuid" />
### git push over XMPP ### git push over XMPP
To indicate that we could push over XMPP, a chat message is sent, To indicate that we could push over XMPP, a chat message is sent,
to each known client of each XMPP remote. to each known client of each XMPP remote.
<git-annex xmlns='git-annex' canpush="" /> <git-annex xmlns='git-annex' canpush="myuuid" />
To request that a remote push to us, a chat message can be sent. To request that a remote push to us, a chat message can be sent.
<git-annex xmlns='git-annex' pushrequest="" /> <git-annex xmlns='git-annex' pushrequest="myuuid" />
When replying to an canpush message, this is directed at the specific When replying to an canpush message, this is directed at the specific
client that indicated it could push. To solicit pushes from all clients, client that indicated it could push. To solicit pushes from all clients,
@ -88,7 +88,7 @@ the message has to be sent directed individually to each client.
When a peer is ready to send a git push, it sends: When a peer is ready to send a git push, it sends:
<git-annex xmlns='git-annex' startingpush="" /> <git-annex xmlns='git-annex' startingpush="myuuid" />
The receiver runs `git receive-pack`, and sends back its output in The receiver runs `git receive-pack`, and sends back its output in
one or more chat messages, directed to the client that is pushing: one or more chat messages, directed to the client that is pushing: