diff options
| -rw-r--r-- | Command/Copy.hs | 5 | ||||
| -rw-r--r-- | Command/Fsck.hs | 2 | ||||
| -rw-r--r-- | Command/Get.hs | 6 | ||||
| -rw-r--r-- | Command/Mirror.hs | 58 | ||||
| -rw-r--r-- | Command/Move.hs | 11 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 12 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | GitAnnex/Options.hs | 9 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 18 |
10 files changed, 103 insertions, 21 deletions
diff --git a/Command/Copy.hs b/Command/Copy.hs index 4e1646ad1..9fd97334a 100644 --- a/Command/Copy.hs +++ b/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 ] diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 6464fc002..35d6fc7b6 100644 --- a/Command/Fsck.hs +++ b/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) diff --git a/Command/Get.hs b/Command/Get.hs index 31a75c3e1..981c2245b 100644 --- a/Command/Get.hs +++ b/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 ] 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 + ) diff --git a/Command/Move.hs b/Command/Move.hs index 357ccc21e..ea8cd7163 100644 --- a/Command/Move.hs +++ b/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" diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 849cbc12b..3270ad8f7 100644 --- a/Command/TransferKey.hs +++ b/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] diff --git a/GitAnnex.hs b/GitAnnex.hs index 9553f2277..05565e643 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -56,6 +56,7 @@ import qualified Command.Content import qualified Command.Ungroup import qualified Command.Vicfg import qualified Command.Sync +import qualified Command.Mirror import qualified Command.AddUrl #ifdef WITH_FEED import qualified Command.ImportFeed @@ -93,6 +94,7 @@ cmds = concat , Command.Unlock.def , Command.Lock.def , Command.Sync.def + , Command.Mirror.def , Command.AddUrl.def #ifdef WITH_FEED , Command.ImportFeed.def diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 2cfdfafd2..459ee3bf4 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -65,3 +65,12 @@ keyOptions = , Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused")) "operate on files found by last run of git-annex unused" ] + +fromOption :: Option +fromOption = Option.field ['f'] "from" paramRemote "source remote" + +toOption :: Option +toOption = Option.field ['t'] "to" paramRemote "destination remote" + +fromToOptions :: [Option] +fromToOptions = [fromOption, toOption] diff --git a/debian/changelog b/debian/changelog index 7d1abbf67..cc60b973b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,7 @@ git-annex (4.20130816) UNRELEASED; urgency=low * sync, merge: Bug fix: Don't try to merge into master when in a bare repo. * import: Add options to control handling of duplicate files: --duplicate, --deduplicate, and --clean-duplicates + * mirror: New command, makes two repositories contain the same set of files. -- Joey Hess <joeyh@debian.org> Thu, 15 Aug 2013 15:47:52 +0200 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 44abd6943..00c7b2e50 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -157,6 +157,24 @@ subdirectories). post-receive hook. Then any syncs to the repository will update its working copy automatically. +* mirror [path ...] + + This causes a destination repository to mirror a source repository. + + To use the local repository as the source repository, + specify mirror --to remote. + + To use a remote as the source repository, specify mirror --from remote. + + Each specified file in the source repository is mirrored to the destination + repository. If a file's content is present in the source repository, it is + copied to the destination repository. If a file's content is not present in + the source repository, it will be dropped from the destination repository + when possible. + + Note that mirror does not sync the git repository, but only the file + contents. + * addurl [url ...] Downloads each url to its own file, which is added to the annex. |