b223988e22
--backend is no longer a global option, and is only accepted by commands that actually need it. Three commands that used to support backend but don't any longer are watch, webapp, and assistant. It would be possible to make them support it, but I doubt anyone used the option with these. And in the case of webapp and assistant, the option was handled inconsistently, only taking affect when the command is run with an existing git-annex repo, not when it creates a new one. Also, renamed GlobalOption etc to AnnexOption. Because there are many options of this type that are not actually global (any more) and get added to commands that need them. Sponsored-by: Kevin Mueller on Patreon
90 lines
2.8 KiB
Haskell
90 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 = withAnnexOptions [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) <- getSafestNumMinCopies afile key
|
|
Command.Drop.startRemote pcc afile ai si numcopies mincopies key (Command.Drop.DroppingUnused False)
|
|
=<< 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) <- getSafestNumMinCopies afile key
|
|
Command.Drop.startLocal pcc afile ai si numcopies mincopies key [] (Command.Drop.DroppingUnused False)
|
|
, stop
|
|
)
|
|
where
|
|
pcc = Command.Drop.PreferredContentChecked False
|