diff options
author | Joey Hess <joey@kitenet.net> | 2013-08-20 15:46:35 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-08-20 15:46:35 -0400 |
commit | 856f2f21c654ac9ac87554b9bb0e59b4ba595b10 (patch) | |
tree | acc1557ab3f4e2fed27ea97e2e29c65f3e48b423 /Command/Mirror.hs | |
parent | da79efe0dfa97f3cb9e983e54cd1541695b5a39a (diff) |
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.
Diffstat (limited to 'Command/Mirror.hs')
-rw-r--r-- | Command/Mirror.hs | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/Command/Mirror.hs b/Command/Mirror.hs new file mode 100644 index 000000000..c0dd8a51f --- /dev/null +++ b/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 + ) |