1{- git-annex v2 -> v3 upgrade support
2 -
3 - Copyright 2011 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Upgrade.V2 where
9
10import Annex.Common
11import qualified Git
12import qualified Git.Command
13import qualified Git.Ref
14import qualified Annex.Branch
15import qualified Annex
16import Annex.Content
17import Utility.Tmp
18import Logs
19import Messages.Progress
20
21olddir :: Git.Repo -> FilePath
22olddir g
23	| Git.repoIsLocalBare g = ""
24	| otherwise = ".git-annex"
25
26{- .git-annex/ moved to a git-annex branch.
27 -
28 - Strategy:
29 -
30 - * Create the git-annex branch.
31 - * Find each location log file in .git-annex/, and inject its content
32 -   into the git-annex branch, unioning with any content already in
33 -   there. (in passing, this deals with the semi transition that left
34 -   some location logs hashed two different ways; both are found and
35 -   merged).
36 - * Also inject remote.log, trust.log, and uuid.log.
37 - * git rm -rf .git-annex
38 - * Remove stuff that used to be needed in .gitattributes.
39 - * Commit changes.
40 -}
41upgrade :: Annex Bool
42upgrade = do
43	showAction "v2 to v3"
44	bare <- fromRepo Git.repoIsLocalBare
45	old <- fromRepo olddir
46
47	Annex.Branch.create
48	showProgressDots
49
50	e <- liftIO $ doesDirectoryExist old
51	when e $ do
52		config <- Annex.getGitConfig
53		mapM_ (\(k, f) -> inject f $ fromRawFilePath $ locationLogFile config k) =<< locationLogs
54		mapM_ (\f -> inject f f) =<< logFiles old
55
56	saveState False
57	showProgressDots
58
59	when e $ do
60		inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File old]
61		unless bare $ inRepo gitAttributesUnWrite
62	showProgressDots
63
64	unless bare push
65
66	return True
67
68locationLogs :: Annex [(Key, FilePath)]
69locationLogs = do
70	config <- Annex.getGitConfig
71	dir <- fromRepo gitStateDir
72	liftIO $ do
73		levela <- dirContents dir
74		levelb <- mapM tryDirContents levela
75		files <- mapM tryDirContents (concat levelb)
76		return $ mapMaybe (islogfile config) (concat files)
77  where
78	tryDirContents d = catchDefaultIO [] $ dirContents d
79	islogfile config f = maybe Nothing (\k -> Just (k, f)) $
80			locationLogFileKey config (toRawFilePath f)
81
82inject :: FilePath -> FilePath -> Annex ()
83inject source dest = do
84	old <- fromRepo olddir
85	new <- liftIO (readFile $ old </> source)
86	Annex.Branch.change (Annex.Branch.RegardingUUID []) (toRawFilePath dest) $ \prev ->
87		encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new
88
89logFiles :: FilePath -> Annex [FilePath]
90logFiles dir = return . filter (".log" `isSuffixOf`)
91		<=< liftIO $ getDirectoryContents dir
92
93push :: Annex ()
94push = do
95	origin_master <- inRepo $ Git.Ref.exists $
96		Git.Ref $ encodeBS "origin/master"
97	origin_gitannex <- Annex.Branch.hasOrigin
98	case (origin_master, origin_gitannex) of
99		(_, True) -> do
100			-- Merge in the origin's git-annex branch,
101			-- so that pushing the git-annex branch
102			-- will immediately work. Not pushed here,
103			-- because it's less obnoxious to let the user
104			-- push.
105			void Annex.Branch.update
106		(True, False) -> do
107			-- push git-annex to origin, so that
108			-- "git push" will from then on
109			-- automatically push it
110			void Annex.Branch.update -- just in case
111			showAction "pushing new git-annex branch to origin"
112			showOutput
113			inRepo $ Git.Command.run
114				[ Param "push"
115				, Param "origin"
116				, Param $ Git.fromRef Annex.Branch.name
117				]
118		_ -> do
119			-- no origin exists, so just let the user
120			-- know about the new branch
121			void Annex.Branch.update
122			showLongNote $
123				"git-annex branch created\n" ++
124				"Be sure to push this branch when pushing to remotes.\n"
125
126{- Old .gitattributes contents, not needed anymore. -}
127attrLines :: [String]
128attrLines =
129	[ stateDir </> "*.log merge=union"
130	, stateDir </> "*/*/*.log merge=union"
131	]
132
133gitAttributesUnWrite :: Git.Repo -> IO ()
134gitAttributesUnWrite repo = do
135	let attributes = fromRawFilePath (Git.attributes repo)
136	whenM (doesFileExist attributes) $ do
137		c <- readFileStrict attributes
138		liftIO $ viaTmp writeFile attributes $ unlines $
139			filter (`notElem` attrLines) $ lines c
140		Git.Command.run [Param "add", File attributes] repo
141
142stateDir :: FilePath
143stateDir = addTrailingPathSeparator ".git-annex"
144
145gitStateDir :: Git.Repo -> FilePath
146gitStateDir repo = addTrailingPathSeparator $
147	fromRawFilePath (Git.repoPath repo) </> stateDir
148