summaryrefslogtreecommitdiff
path: root/Command/Migrate.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-01-08 15:54:14 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-01-08 15:54:14 -0400
commita78b0555e1d46c4548cda3aaa1709040f6fa7f33 (patch)
tree9313997b7a9e3758b27cf79c0319d730397421a4 /Command/Migrate.hs
parent32b0e103909035ad0f25427c57a1ff504aefcada (diff)
New migrate subcommand can be used to switch files to using a different backend, safely and with no duplication of content.
Diffstat (limited to 'Command/Migrate.hs')
-rw-r--r--Command/Migrate.hs63
1 files changed, 63 insertions, 0 deletions
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
new file mode 100644
index 000000000..0caded6d1
--- /dev/null
+++ b/Command/Migrate.hs
@@ -0,0 +1,63 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Migrate where
+
+import Control.Monad.State (liftIO)
+import System.Posix.Files
+import System.Directory
+
+import Command
+import qualified Annex
+import qualified Backend
+import Locations
+import Types
+import Core
+import Messages
+import qualified Command.Add
+
+command :: [Command]
+command = [Command "migrate" paramPath seek "switch data to different backend"]
+
+seek :: [CommandSeek]
+seek = [withBackendFilesInGit start]
+
+start :: CommandStartBackendFile
+start (_, Nothing) = return Nothing
+start (file, Just newbackend) = isAnnexed file $ \(key, oldbackend) -> do
+ exists <- inAnnex key
+ if (newbackend /= oldbackend) && exists
+ then do
+ showStart "migrate" file
+ return $ Just $ perform file key newbackend
+ else
+ return Nothing
+
+perform :: FilePath -> Key -> Backend -> 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 = annexLocation g oldkey
+ stored <- Backend.storeFileKey src $ Just newbackend
+ case stored of
+ Nothing -> return Nothing
+ Just (newkey, _) -> do
+ ok <- getViaTmp newkey $ \t -> do
+ -- Make a hard link to the old backend's
+ -- cached key, to avoid wasting disk space.
+ liftIO $ 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