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