diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-11-10 14:38:50 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-11-10 14:38:50 -0400 |
| commit | 3ff1d41a1be38ab8e239b23f590b3f0c96e9ce8b (patch) | |
| tree | a056d769646f2bc6e20a203200647d0507b05ccf /Assistant/Sync.hs | |
| parent | 5ebfd2c11131fe9feca67d932d3bde0ebb20e2b7 (diff) | |
full-on git-annex assistant syncing now works over XMPP!
I decided to use the fallback push mode from the beginning for XMPP, since
while it uses some ugly branches, it avoids the possibility of a normal
push failing, and needing to pull and re-push. Due to the overhead of XMPP,
and the difficulty of building such a chain of actions due to the async
implementation, this seemed reasonable.
It seems to work great!
Diffstat (limited to 'Assistant/Sync.hs')
| -rw-r--r-- | Assistant/Sync.hs | 34 |
1 files changed, 18 insertions, 16 deletions
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 201e6e534..8d7ead31d 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -84,10 +84,6 @@ reconnectRemotes notifypushes rs = void $ do - fallback mode, where our push is guarenteed to succeed if the remote is - reachable. If the fallback fails, the push is queued to be retried - later. - - - - The fallback mode pushes to branches on the remote that have our uuid in - - them. While ugly, those branches are reserved for pushing by us, and - - so our pushes will succeed. -} pushToRemotes :: UTCTime -> Bool -> [Remote] -> Assistant Bool pushToRemotes now notifypushes remotes = do @@ -132,7 +128,7 @@ pushToRemotes now notifypushes remotes = do fallback branch g u rs = do debug ["fallback pushing to", show rs] (succeeded, failed) <- liftIO $ - inParallel (pushfallback g u branch) rs + inParallel (\r -> pushFallback u branch r g) rs updatemap succeeded failed when (notifypushes && (not $ null succeeded)) $ sendNetMessage $ NotifyPush $ @@ -140,20 +136,26 @@ pushToRemotes now notifypushes remotes = do return $ null failed push g branch remote = Command.Sync.pushBranch remote branch g - pushfallback g u branch remote = Git.Command.runBool "push" + +{- This fallback push mode pushes to branches on the remote that have our + - uuid in them. While ugly, those branches are reserved for pushing by us, + - and so our pushes will never conflict with other pushes. -} +pushFallback :: UUID -> Git.Ref -> Remote -> Git.Repo -> IO Bool +pushFallback u branch remote = Git.Command.runBool "push" params + where + params = [ Param $ Remote.name remote , Param $ refspec Annex.Branch.name , Param $ refspec branch - ] g - where - {- Push to refs/synced/uuid/branch; this - - avoids cluttering up the branch display. -} - refspec b = concat - [ s - , ":" - , "refs/synced/" ++ fromUUID u ++ "/" ++ s - ] - where s = show $ Git.Ref.base b + ] + {- Push to refs/synced/uuid/branch; this + - avoids cluttering up the branch display. -} + refspec b = concat + [ s + , ":" + , "refs/synced/" ++ fromUUID u ++ "/" ++ s + ] + where s = show $ Git.Ref.base b {- Manually pull from remotes and merge their branches. -} manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Bool], Bool) |