blob: 458a114df2352c3efb85abbc6f0be16a1d730a51 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Command.Sync where
import Common.Annex
import Command
import qualified Remote
import qualified Annex.Branch
import qualified Git.Command
import qualified Git.Config
import qualified Git.Ref
import qualified Git
import qualified Data.ByteString.Lazy.Char8 as L
def :: [Command]
def = [command "sync" (paramOptional (paramRepeating paramRemote))
[seek] "synchronize local repository with remote repositories"]
-- syncing involves several operations, any of which can independantly fail
seek :: CommandSeek
seek args = do
!branch <- currentBranch
let syncbranch = Git.Ref.under "refs/heads/synced/" branch
remotes <- syncRemotes syncbranch args
return $
[ commit
, mergeLocal branch
] ++
[ update remote branch | remote <- remotes ] ++
[ mergeAnnex ] ++
[ pushLocal syncbranch ] ++
[ pushRemote remote branch syncbranch | remote <- remotes ]
syncRemotes :: Git.Ref -> [String] -> Annex [Remote.Remote Annex]
syncRemotes branch [] = defaultSyncRemotes branch
syncRemotes _ rs = mapM Remote.byName rs
defaultSyncRemotes :: Git.Ref -> Annex [Remote.Remote Annex]
defaultSyncRemotes syncbranch = mapM Remote.byName
=<< process . L.unpack <$> inRepo showref
where
showref = Git.Command.pipeRead
[ Param "show-ref"
, Param $ show $ Git.Ref.base syncbranch
]
process = map getRemoteName . filter isRemote .
map getBranchName . lines
isRemote r = "refs/remotes/" `isPrefixOf` r
getBranchName = snd . separate (== ' ')
getRemoteName = fst . separate (== '/') . snd . separate (== '/') . snd . separate (== '/')
commit :: CommandStart
commit = do
showStart "commit" ""
next $ next $ do
showOutput
-- Commit will fail when the tree is clean, so ignore failure.
_ <- inRepo $ Git.Command.runBool "commit"
[Param "-a", Param "-m", Param "git-annex automatic sync"]
return True
mergeLocal :: Git.Ref -> CommandStart
mergeLocal branch = do
let mergebranch = Git.Ref.under "refs/heads/synced" branch
showStart "merge" $ Git.Ref.describe mergebranch
next $ next $ mergeFromIfExists mergebranch
pushLocal :: Git.Ref -> CommandStart
pushLocal syncbranch = go =<< inRepo (Git.Ref.exists syncbranch)
where
go False = stop
go True = do
unlessM (updatebranch) $
error $ "failed to update " ++ show syncbranch
stop
updatebranch = inRepo $ Git.Command.runBool "branch"
[ Param "-f"
, Param $ show $ Git.Ref.base syncbranch
]
mergeFromIfExists :: Git.Ref -> CommandCleanup
mergeFromIfExists branch = go =<< inRepo (Git.Ref.exists branch)
where
go True = do
showOutput
inRepo $ Git.Command.runBool "merge"
[Param (show branch)]
go False = do
showNote $ Git.Ref.describe branch ++
" does not exist, not merging"
return False
update :: Remote.Remote Annex -> Git.Ref -> CommandStart
update remote branch = do
showStart "update" (Remote.name remote)
next $ do
checkRemote remote
showOutput
fetched <- inRepo $ Git.Command.runBool "fetch" [Param (Remote.name remote)]
if fetched
then next $ mergeRemote remote branch
else stop
mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandCleanup
mergeRemote remote = mergeFromIfExists .
Git.Ref.under ("refs/remotes/" ++ Remote.name remote ++ "/synced")
pushRemote :: Remote.Remote Annex -> Git.Ref -> Git.Ref -> CommandStart
pushRemote remote branch syncbranch = do
showStart "push" (Remote.name remote)
let syncbranchRemote = Git.Ref.under
("refs/remotes/" ++ Remote.name remote) syncbranch
let refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch)
ex <- inRepo $ Git.Ref.exists syncbranchRemote
next $ next $ do
showOutput
inRepo $ Git.Command.runBool "push" $
[ Param (Remote.name remote)
, Param (show $ Annex.Branch.name) ] ++
[ Param refspec | ex ]
currentBranch :: Annex Git.Ref
currentBranch = Git.Ref . firstLine . L.unpack <$>
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 = do
Annex.Branch.forceUpdate
stop
|
