cedc28a783
When two files have the same content, and a required content expression matches one but not the other, dropping the latter file will fail as it would also remove the content of the required file. This will slow down drop (w/o --auto), dropunused, mirror, and move, by one keys db lookup per file. But I did include an optimisation to avoid a double db lookup in the drop --auto / sync --content case. I suspect that dropunused could also use PreferredContentChecked True, but haven't entirely thought it through and it's rarely used with enough files for the optimisation to matter. Sponsored-by: Dartmouth College's Datalad project
92 lines
2.8 KiB
Haskell
92 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 pcc 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 pcc afile ai si numcopies mincopies key []
|
|
, stop
|
|
)
|
|
where
|
|
getnummincopies = case afile of
|
|
AssociatedFile Nothing -> (,) <$> getNumCopies <*> getMinCopies
|
|
AssociatedFile (Just af) -> getFileNumMinCopies af
|
|
pcc = Command.Drop.PreferredContentChecked False
|