cc89699457
This is conceptually very simple, just making a 1 that was hard coded be exposed as a config option. The hard part was plumbing all that, and dealing with complexities like reading it from git attributes at the same time that numcopies is read. Behavior change: When numcopies is set to 0, git-annex used to drop content without requiring any copies. Now to get that (highly unsafe) behavior, mincopies also needs to be set to 0. It seemed better to remove that edge case, than complicate mincopies by ignoring it when numcopies is 0. This commit was sponsored by Denis Dzyubenko on Patreon.
91 lines
2.8 KiB
Haskell
91 lines
2.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Mirror where
|
|
|
|
import Command
|
|
import qualified Command.Move
|
|
import qualified Command.Drop
|
|
import qualified Command.Get
|
|
import qualified Remote
|
|
import Annex.Content
|
|
import Annex.NumCopies
|
|
import Types.Transfer
|
|
|
|
cmd :: Command
|
|
cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
|
|
command "mirror" SectionCommon
|
|
"mirror content of files to/from another repository"
|
|
paramPaths (seek <--< optParser)
|
|
|
|
data MirrorOptions = MirrorOptions
|
|
{ mirrorFiles :: CmdParams
|
|
, fromToOptions :: FromToOptions
|
|
, keyOptions :: Maybe KeyOptions
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser MirrorOptions
|
|
optParser desc = MirrorOptions
|
|
<$> cmdParams desc
|
|
<*> parseFromToOptions
|
|
<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
|
|
|
|
instance DeferredParseClass MirrorOptions where
|
|
finishParse v = MirrorOptions
|
|
<$> pure (mirrorFiles v)
|
|
<*> finishParse (fromToOptions v)
|
|
<*> pure (keyOptions v)
|
|
|
|
seek :: MirrorOptions -> CommandSeek
|
|
seek o = startConcurrency stages $
|
|
withKeyOptions (keyOptions o) False seeker
|
|
(commandAction . startKey o (AssociatedFile Nothing))
|
|
(withFilesInGitAnnex ww seeker)
|
|
=<< workTreeItems ww (mirrorFiles o)
|
|
where
|
|
stages = case fromToOptions o of
|
|
FromRemote _ -> downloadStages
|
|
ToRemote _ -> commandStages
|
|
ww = WarnUnmatchLsFiles
|
|
seeker = AnnexedFileSeeker
|
|
{ startAction = start o
|
|
, checkContentPresent = Nothing
|
|
, usesLocationLog = True
|
|
}
|
|
|
|
start :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
|
|
start o si file k = startKey o afile (si, k, ai)
|
|
where
|
|
afile = AssociatedFile (Just file)
|
|
ai = mkActionItem (k, afile)
|
|
|
|
startKey :: MirrorOptions -> AssociatedFile -> (SeekInput, Key, ActionItem) -> CommandStart
|
|
startKey o afile (si, key, ai) = case fromToOptions o of
|
|
ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
|
|
( Command.Move.toStart Command.Move.RemoveNever afile key ai si =<< getParsed r
|
|
, do
|
|
(numcopies, mincopies) <- getnummincopies
|
|
Command.Drop.startRemote afile ai si numcopies mincopies key =<< getParsed r
|
|
)
|
|
FromRemote r -> checkFailedTransferDirection ai Download $ do
|
|
haskey <- flip Remote.hasKey key =<< getParsed r
|
|
case haskey of
|
|
Left _ -> stop
|
|
Right True -> ifM (inAnnex key)
|
|
( stop
|
|
, Command.Get.start' (return True) Nothing key afile ai si
|
|
)
|
|
Right False -> ifM (inAnnex key)
|
|
( do
|
|
(numcopies, mincopies) <- getnummincopies
|
|
Command.Drop.startLocal afile ai si numcopies mincopies key []
|
|
, stop
|
|
)
|
|
where
|
|
getnummincopies = case afile of
|
|
AssociatedFile Nothing -> (,) <$> getNumCopies <*> getMinCopies
|
|
AssociatedFile (Just af) -> getFileNumMinCopies af
|