mirror: New command, makes two repositories contain the same set of files.

This is a simple approach for setting up a mirroring repository.

It will work with any type of remotes.

Mirror --from is more expensive than mirror --to in general.
OTOH, mirror --from will get the file from any remote that has it, not only
the named mirror remote. And if the named mirror remote is not the fastest
available remote with a file, that can speed things up.

It would be possible to make the assistant or watch command do a more
dynamic mirroring, that didn't need to scan every time.

Command/Copy.hs

@@ -9,6 +9,7 @@ module Command.Copy where
 
 import Common.Annex
 import Command
+import GitAnnex.Options
 import qualified Command.Move
 import qualified Remote
 import Annex.Wanted
@@ -19,8 +20,8 @@ def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek
 
 seek :: [CommandSeek]
 seek =
-	[ withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
-	  withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
+	[ withField toOption Remote.byNameWithUUID $ \to ->
+	  withField fromOption Remote.byNameWithUUID $ \from ->
 	  withKeyOptions (Command.Move.startKey to from False) $
 	  withFilesInGit $ whenAnnexed $ start to from
 	]

Command/Fsck.hs

@@ -33,7 +33,7 @@ import qualified Option
 import Types.Key
 import Utility.HumanTime
 import Git.FilePath
-import GitAnnex.Options
+import GitAnnex.Options hiding (fromOption)
 
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getProcessID)

Command/Get.hs

@@ -11,10 +11,10 @@ import Common.Annex
 import Command
 import qualified Remote
 import Annex.Content
-import qualified Command.Move
 import Logs.Transfer
 import Annex.Wanted
 import GitAnnex.Options
+import qualified Command.Move
 import Types.Key
 
 def :: [Command]
@@ -22,11 +22,11 @@ def = [withOptions getOptions $ command "get" paramPaths seek
 	SectionCommon "make content of annexed files available"]
 
 getOptions :: [Option]
-getOptions = [Command.Move.fromOption] ++ keyOptions
+getOptions = fromOption : keyOptions
 
 seek :: [CommandSeek]
 seek = 
-	[ withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
+	[ withField fromOption Remote.byNameWithUUID $ \from ->
 	  withKeyOptions (startKeys from) $
 	  withFilesInGit $ whenAnnexed $ start from
 	]

Command/Mirror.hs

@@ -0,0 +1,58 @@
+{- git-annex command
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Mirror where
+
+import Common.Annex
+import Command
+import GitAnnex.Options
+import qualified Command.Move
+import qualified Command.Drop
+import qualified Command.Get
+import qualified Remote
+import Annex.Content
+import qualified Annex
+
+def :: [Command]
+def = [withOptions fromToOptions $ command "mirror" paramPaths seek
+	SectionCommon "mirror content of files to/from another repository"]
+
+seek :: [CommandSeek]
+seek =
+	[ withField toOption Remote.byNameWithUUID $ \to ->
+	  withField fromOption Remote.byNameWithUUID $ \from ->
+	  withFilesInGit $ whenAnnexed $ start to from
+	]
+
+start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
+start to from file (key, _backend) = do
+	noAuto
+	case (from, to) of
+		(Nothing, Nothing) -> error "specify either --from or --to"
+		(Nothing, Just r) -> mirrorto r
+		(Just r, Nothing) -> mirrorfrom r
+		_ -> error "only one of --from or --to can be specified"
+  where
+	noAuto = whenM (Annex.getState Annex.auto) $
+		error "--auto is not supported for mirror"
+	mirrorto r = ifM (inAnnex key)
+		( Command.Move.toStart r False (Just file) key
+		, do
+			numcopies <- numCopies file
+			Command.Drop.startRemote file numcopies key r
+		)
+	mirrorfrom r = do
+		haskey <- Remote.hasKey r key
+		case haskey of
+			Left _ -> stop
+			Right True -> Command.Get.start' (return True) Nothing key (Just file)
+			Right False -> ifM (inAnnex key)
+				( do
+					numcopies <- numCopies file
+					Command.Drop.startLocal file numcopies key Nothing
+				, stop
+				)

Command/Move.hs

@@ -14,7 +14,6 @@ import qualified Annex
 import Annex.Content
 import qualified Remote
 import Annex.UUID
-import qualified Option
 import Logs.Presence
 import Logs.Transfer
 import GitAnnex.Options
@@ -24,14 +23,8 @@ def :: [Command]
 def = [withOptions moveOptions $ command "move" paramPaths seek
 	SectionCommon "move content of files to/from another repository"]
 
-fromOption :: Option
-fromOption = Option.field ['f'] "from" paramRemote "source remote"
-
-toOption :: Option
-toOption = Option.field ['t'] "to" paramRemote "destination remote"
-
 moveOptions :: [Option]
-moveOptions = [fromOption, toOption] ++ keyOptions
+moveOptions = fromToOptions ++ keyOptions
 
 seek :: [CommandSeek]
 seek = 
@@ -54,7 +47,7 @@ start' to from move afile key = do
 		(Nothing, Nothing) -> error "specify either --from or --to"
 		(Nothing, Just dest) -> toStart dest move afile key
 		(Just src, Nothing) -> fromStart src move afile key
-		(_ ,  _) -> error "only one of --from or --to can be specified"
+		_ -> error "only one of --from or --to can be specified"
   where
 	noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
 		"--auto is not supported for move"

Command/TransferKey.hs

@@ -15,23 +15,23 @@ import Logs.Location
 import Logs.Transfer
 import qualified Remote
 import Types.Remote
-import qualified Command.Move
+import GitAnnex.Options
 import qualified Option
 
 def :: [Command]
-def = [withOptions options $
+def = [withOptions transferKeyOptions $
 	noCommit $ command "transferkey" paramKey seek SectionPlumbing
 		"transfers a key from or to a remote"]
 
-options :: [Option]
-options = [fileOption, Command.Move.fromOption, Command.Move.toOption]
+transferKeyOptions :: [Option]
+transferKeyOptions = fileOption : fromToOptions
 
 fileOption :: Option
 fileOption = Option.field [] "file" paramFile "the associated file"
 
 seek :: [CommandSeek]
-seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
-	withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
+seek = [withField toOption Remote.byNameWithUUID $ \to ->
+	withField fromOption Remote.byNameWithUUID $ \from ->
 	withField fileOption return $ \file ->
 		withKeys $ start to from file]