blob: 790d5d365b70a4370dbf46c7118330456f251331 (
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
|
{- 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, when)
import System.Posix.Files
import System.Directory
import System.FilePath
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
next $ perform file key newbackend
else stop
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
let tmpfile = gitAnnexTmpDir g </> takeFileName file
liftIO $ createLink src tmpfile
stored <- Backend.storeFileKey tmpfile $ Just newbackend
liftIO $ cleantmp tmpfile
case stored of
Nothing -> stop
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
next $ Command.Add.cleanup file newkey
else stop
where
cleantmp t = do
exists <- doesFileExist t
when exists $ removeFile t
|
