9d36c826c0
This means that Command.Move and Command.Get don't need to manually set the stage, and is a lot cleaner conceptually. Also, this makes Command.Sync.syncFile use the worker pool better. In the scenario where it first downloads content and then uploads it to some other remotes, it will start in TransferStage, then enter VerifyStage and then go back to TransferStage for each transfer to the remotes. Before, it entered CleanupStage after the download, and stayed in it for the upload, so too many transfer jobs could run at the same time. Note that, in Remote.Git, it uses runTransfer and also verifyKeyContent inside onLocal. That has a Annex state for the remote, with no worker pool. So the resulting calls to enteringStage won't block in there. While Remote.Git.copyToRemote does do checksum verification, I realized that should not use a verification slot in the WorkerPool to do it. Because, it's reading back from eg, a removable disk to checksum. That will contend with other writes to that disk. It's best to treat that checksum verification as just part of the transer. So, removed the todo item about that, as there's nothing needing to be done.
78 lines
2.4 KiB
Haskell
78 lines
2.4 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 transferStages $
|
|
withKeyOptions (keyOptions o) False
|
|
(commandAction . startKey o (AssociatedFile Nothing))
|
|
(withFilesInGit (commandAction . (whenAnnexed $ start o)))
|
|
=<< workTreeItems (mirrorFiles o)
|
|
|
|
start :: MirrorOptions -> FilePath -> Key -> CommandStart
|
|
start o file k = startKey o afile (k, ai)
|
|
where
|
|
afile = AssociatedFile (Just file)
|
|
ai = mkActionItem (k, afile)
|
|
|
|
startKey :: MirrorOptions -> AssociatedFile -> (Key, ActionItem) -> CommandStart
|
|
startKey o afile (key, ai) = case fromToOptions o of
|
|
ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
|
|
( Command.Move.toStart Command.Move.RemoveNever afile key ai =<< getParsed r
|
|
, do
|
|
numcopies <- getnumcopies
|
|
Command.Drop.startRemote afile ai numcopies key =<< getParsed r
|
|
)
|
|
FromRemote r -> checkFailedTransferDirection ai Download $ do
|
|
haskey <- flip Remote.hasKey key =<< getParsed r
|
|
case haskey of
|
|
Left _ -> stop
|
|
Right True -> Command.Get.start' (return True) Nothing key afile ai
|
|
Right False -> ifM (inAnnex key)
|
|
( do
|
|
numcopies <- getnumcopies
|
|
Command.Drop.startLocal afile ai numcopies key []
|
|
, stop
|
|
)
|
|
where
|
|
getnumcopies = case afile of
|
|
AssociatedFile Nothing -> getNumCopies
|
|
AssociatedFile (Just af) -> getFileNumCopies af
|