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.
This commit is contained in:
Joey Hess 2013-08-20 15:46:35 -04:00
parent f5623af6ec
commit 0f921307e7
10 changed files with 103 additions and 21 deletions

View file

@ -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
]

View file

@ -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)

View file

@ -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
]

58
Command/Mirror.hs Normal file
View file

@ -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
)

View file

@ -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"

View file

@ -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]