summaryrefslogtreecommitdiff
path: root/Command/Migrate.hs
blob: 0d21fcbdf960383d2a7be4fa478c64b4391a7fae (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
{- git-annex command
 -
 - Copyright 2011 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.Migrate where

import Control.Monad.State (liftIO)
import Control.Monad (unless)
import System.Posix.Files
import System.Directory

import Command
import qualified Annex
import qualified Backend
import Locations
import Types
import Content
import Messages
import qualified Command.Add

command :: [Command]
command = [repoCommand "migrate" paramPath seek "switch data to different backend"]

seek :: [CommandSeek]
seek = [withBackendFilesInGit start]

start :: CommandStartBackendFile
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
	exists <- inAnnex key
	newbackend <- choosebackend b
	upgradable <- Backend.upgradableKey oldbackend key
	if (newbackend /= oldbackend || upgradable) && exists
		then do
			showStart "migrate" file
			return $ Just $ perform file key newbackend
		else
			return Nothing
	where
		choosebackend Nothing = do
			backends <- Backend.list
			return $ head backends
		choosebackend (Just backend) = return backend

perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do
	g <- Annex.gitRepo

	-- Store the old backend's cached key in the new backend
	-- (the file can't be stored as usual, because it's already a symlink).
	-- The old backend's key is not dropped from it, because there may
	-- be other files still pointing at that key.
	let src = gitAnnexLocation g oldkey
	stored <- Backend.storeFileKey src $ Just newbackend
	case stored of
		Nothing -> return Nothing
		Just (newkey, _) -> do
			ok <- getViaTmpUnchecked newkey $ \t -> do
				-- Make a hard link to the old backend's
				-- cached key, to avoid wasting disk space.
				liftIO $ do
					exists <- doesFileExist t
					unless exists $ createLink src t
				return True
			if ok
				then do
					-- Update symlink to use the new key.
					liftIO $ removeFile file
					return $ Just $ Command.Add.cleanup file newkey
				else return Nothing