automated syncing

Some changes to make automated syncing nicer. Merge from both the remote's
$branch and its synced/$branch; either could have new changes. Create
synced/$branch on the remote when pushing.
This commit is contained in:
Joey Hess 2011-12-30 19:11:22 -04:00
parent dba8fc8a1c
commit 79872e360e

View file

@ -30,28 +30,25 @@ def = [command "sync" (paramOptional (paramRepeating paramRemote))
seek :: CommandSeek seek :: CommandSeek
seek args = do seek args = do
!branch <- currentBranch !branch <- currentBranch
let syncbranch = Git.Ref.under "refs/heads/synced/" branch remotes <- syncRemotes args
remotes <- syncRemotes syncbranch args
return $ concat $ return $ concat $
[ [ commit ] [ [ commit ]
, [ mergeLocal branch syncbranch ] , [ mergeLocal branch ]
, [ pullRemote remote branch | remote <- remotes ] , [ pullRemote remote branch | remote <- remotes ]
, [ mergeAnnex ] , [ mergeAnnex ]
, [ pushLocal syncbranch ] , [ pushLocal branch ]
, [ pushRemote remote branch syncbranch | remote <- remotes ] , [ pushRemote remote branch | remote <- remotes ]
] ]
syncRemotes :: Git.Ref -> [String] -> Annex [Remote.Remote Annex] syncBranch :: Git.Ref -> Git.Ref
syncRemotes branch [] = defaultSyncRemotes branch syncBranch = Git.Ref.under "refs/heads/synced/"
syncRemotes _ rs = mapM Remote.byName rs
defaultSyncRemotes :: Git.Ref -> Annex [Remote.Remote Annex] syncRemotes :: [String] -> Annex [Remote.Remote Annex]
defaultSyncRemotes syncbranch = mapM Remote.byName =<< syncRemotes [] = filterM hasurl =<< Remote.remoteList
map getRemoteName . filter isRemote . map (show . snd) <$> siblings
where where
siblings = inRepo (Git.Ref.matching $ Git.Ref.base syncbranch) hasurl r = not . null <$> geturl r
getRemoteName = fst . separate (== '/') . snd . separate (== '/') . snd . separate (== '/') geturl r = fromRepo $ Git.Config.get ("remote." ++ Remote.name r ++ ".url") ""
isRemote r = "refs/remotes/" `isPrefixOf` r syncRemotes rs = mapM Remote.byName rs
commit :: CommandStart commit :: CommandStart
commit = do commit = do
@ -63,9 +60,10 @@ commit = do
[Param "-a", Param "-m", Param "git-annex automatic sync"] [Param "-a", Param "-m", Param "git-annex automatic sync"]
return True return True
mergeLocal :: Git.Ref -> Git.Ref -> CommandStart mergeLocal :: Git.Ref -> CommandStart
mergeLocal branch syncbranch = go =<< needmerge mergeLocal branch = go =<< needmerge
where where
syncbranch = syncBranch branch
needmerge = do needmerge = do
unlessM (inRepo $ Git.Ref.exists syncbranch) $ unlessM (inRepo $ Git.Ref.exists syncbranch) $
updateBranch syncbranch updateBranch syncbranch
@ -76,8 +74,9 @@ mergeLocal branch syncbranch = go =<< needmerge
next $ next $ mergeFromIfExists syncbranch next $ next $ mergeFromIfExists syncbranch
pushLocal :: Git.Ref -> CommandStart pushLocal :: Git.Ref -> CommandStart
pushLocal syncbranch = go =<< inRepo (Git.Ref.exists syncbranch) pushLocal branch = go =<< inRepo (Git.Ref.exists syncbranch)
where where
syncbranch = syncBranch branch
go False = stop go False = stop
go True = do go True = do
updateBranch syncbranch updateBranch syncbranch
@ -108,7 +107,6 @@ pullRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
pullRemote remote branch = do pullRemote remote branch = do
showStart "pull" (Remote.name remote) showStart "pull" (Remote.name remote)
next $ do next $ do
checkRemote remote
showOutput showOutput
fetched <- inRepo $ Git.Command.runBool "fetch" fetched <- inRepo $ Git.Command.runBool "fetch"
[Param $ Remote.name remote] [Param $ Remote.name remote]
@ -116,25 +114,40 @@ pullRemote remote branch = do
then next $ mergeRemote remote branch then next $ mergeRemote remote branch
else stop else stop
{- The remote probably has both a master and a synced/master branch.
- Which to merge from? Well, the master has whatever latest changes
- were committed, while the synced/master may have changes that some
- other remote synced to this remote. So, merge them both. -}
mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandCleanup mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandCleanup
mergeRemote remote = mergeFromIfExists . mergeRemote remote branch = all (== True) <$> mapM go [branch, syncBranch branch]
Git.Ref.under ("refs/remotes/" ++ Remote.name remote ++ "/synced")
pushRemote :: Remote.Remote Annex -> Git.Ref -> Git.Ref -> CommandStart
pushRemote remote branch syncbranch = go =<< newer
where where
newer = inRepo $ Git.Branch.changed syncbranchRemote syncbranch go b = do
e <- inRepo $ Git.Branch.changed branch b
if e
then mergeFromIfExists $ remotebranch b
else return True
remotebranch = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote
pushRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
pushRemote remote branch = go =<< newer
where
newer = do
e <- inRepo (Git.Ref.exists syncbranchRemote)
if e
then inRepo $ Git.Branch.changed syncbranchRemote syncbranch
else return True
go False = stop go False = stop
go True = do go True = do
showStart "push" (Remote.name remote) showStart "push" (Remote.name remote)
ex <- inRepo $ Git.Ref.exists syncbranchRemote
next $ next $ do next $ next $ do
showOutput showOutput
inRepo $ Git.Command.runBool "push" $ inRepo $ Git.Command.runBool "push" $
[ Param (Remote.name remote) [ Param (Remote.name remote)
, Param (show $ Annex.Branch.name) ] ++ , Param (show $ Annex.Branch.name)
[ Param refspec | ex ] , Param refspec
]
refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch) refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch)
syncbranch = syncBranch branch
syncbranchRemote = Git.Ref.under syncbranchRemote = Git.Ref.under
("refs/remotes/" ++ Remote.name remote) syncbranch ("refs/remotes/" ++ Remote.name remote) syncbranch
@ -142,13 +155,6 @@ currentBranch :: Annex Git.Ref
currentBranch = Git.Ref . firstLine . L.unpack <$> currentBranch = Git.Ref . firstLine . L.unpack <$>
inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"]) inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"])
checkRemote :: Remote.Remote Annex -> Annex ()
checkRemote remote = do
remoteurl <- fromRepo $
Git.Config.get ("remote." ++ Remote.name remote ++ ".url") ""
when (null remoteurl) $
error $ "No url is configured for the remote: " ++ Remote.name remote
mergeAnnex :: CommandStart mergeAnnex :: CommandStart
mergeAnnex = do mergeAnnex = do
Annex.Branch.forceUpdate Annex.Branch.forceUpdate