summaryrefslogtreecommitdiff
path: root/Upgrade/V5.hs
blob: 369188fb886d65d7e3a429c01646bbada900efad (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
{- git-annex v5 -> v6 upgrade support
 -
 - Copyright 2015 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Upgrade.V5 where

import Common.Annex
import qualified Annex
import Config
import Annex.InodeSentinal
import Annex.Link
import Annex.Direct
import Annex.Content
import Annex.CatFile
import qualified Database.Keys
import qualified Annex.Content.Direct as Direct
import qualified Git
import qualified Git.LsFiles
import qualified Git.Branch
import Git.FilePath
import Git.FileMode
import Git.Config
import Utility.InodeCache

upgrade :: Bool -> Annex Bool
upgrade automatic = do
	unless automatic $
		showAction "v5 to v6"
	Database.Keys.scanAssociatedFiles
	whenM isDirect $ do
		{- Direct mode makes the same tradeoff of using less disk
		 - space, with less preservation of old versions of files
		 - as does annex.thin. -}
		setConfig (annexConfig "thin") (boolConfig True)
		Annex.changeGitConfig $ \c -> c { annexThin = True }
		{- Since upgrade from direct mode changes how files
		 - are represented in git, commit any changes in the
		 - work tree first. -}
		whenM stageDirect $ do
			unless automatic $
				showAction "committing first"
			upgradeDirectCommit automatic
				"commit before upgrade to annex.version 6"
		setDirect False
		upgradeDirectWorkTree
		removeDirectCruft
		showLongNote "Upgraded repository out of direct mode."
		showLongNote "Changes have been staged for all annexed files in this repository; you should run `git commit` to commit these changes."
		showLongNote "Any other clones of this repository that use direct mode need to be upgraded now, too."
	configureSmudgeFilter
	-- Inode sentinal file was only used in direct mode and when
	-- locking down files as they were added. In v6, it's used more
	-- extensively, so make sure it exists, since old repos that didn't
	-- use direct mode may not have created it.
	unlessM (isDirect) $
		createInodeSentinalFile True
	return True

upgradeDirectCommit :: Bool -> String -> Annex ()
upgradeDirectCommit automatic msg = 
	void $ inRepo $ Git.Branch.commitCommand commitmode
		[ Param "-m"
		, Param msg
		]
  where
	commitmode = if automatic then Git.Branch.AutomaticCommit else Git.Branch.ManualCommit

{- Walk work tree from top and convert all annex symlinks to pointer files,
 - staging them in the index, and updating the work tree files with
 - either the content of the object, or the pointer file content. -}
upgradeDirectWorkTree :: Annex ()
upgradeDirectWorkTree = do
	top <- fromRepo Git.repoPath
	(l, clean) <- inRepo $ Git.LsFiles.stagedDetails [top]
	forM_ l go
	void $ liftIO clean
  where
	go (f, Just _sha, Just mode) | isSymLink mode = do
		-- Cannot use lookupFile here, as we're in between direct
		-- mode and v6.
		mk <- catKeyFile f
		case mk of
			Nothing -> noop
			Just k -> do
				ifM (isJust <$> getAnnexLinkTarget f)
					( writepointer f k
					, fromdirect f k
					)
				stagePointerFile f =<< hashPointerFile k
				Database.Keys.addAssociatedFile k
					=<< inRepo (toTopFilePath f)
				return ()
	go _ = noop

	fromdirect f k = do
		-- If linkToAnnex fails for some reason, the work tree file
		-- still has the content; the annex object file is just
		-- not populated with it. Since the work tree file
		-- is recorded as an associated file, things will still
		-- work that way, it's just not ideal.
		ic <- withTSDelta (liftIO . genInodeCache f)
		void $ linkToAnnex k f ic
	writepointer f k = liftIO $ do
		nukeFile f
		writeFile f (formatPointer k)

{- Remove all direct mode bookkeeping files. -}
removeDirectCruft :: Annex ()
removeDirectCruft = mapM_ go =<< getKeysPresent InAnywhere
  where
	go k = do
		Direct.removeInodeCache k
		Direct.removeAssociatedFiles k