Merge branch 'fromto'
This commit is contained in:
commit
62f8a26dd9
11 changed files with 294 additions and 82 deletions
|
@ -139,7 +139,8 @@ lockContentShared key a = lockContentUsing lock key notpresent $
|
|||
-
|
||||
- If locking fails, throws an exception rather than running the action.
|
||||
-
|
||||
- If locking fails because the the content is not present, runs the
|
||||
- When the content file itself is used as the lock file,
|
||||
- and locking fails because the the content is not present, runs the
|
||||
- fallback action instead. However, the content is not guaranteed to be
|
||||
- present when this succeeds.
|
||||
-}
|
||||
|
|
|
@ -29,7 +29,6 @@ import Annex.Notification as X
|
|||
import Annex.Content
|
||||
import Annex.Perms
|
||||
import Annex.Action
|
||||
import Logs.Location
|
||||
import Utility.Metered
|
||||
import Utility.ThreadScheduler
|
||||
import Annex.LockPool
|
||||
|
@ -73,7 +72,7 @@ alwaysUpload u key f sd d a _witness = guardHaveUUID u $
|
|||
|
||||
-- Download, supporting canceling detected stalls.
|
||||
download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
|
||||
download r key f d witness = logStatusAfter key $
|
||||
download r key f d witness =
|
||||
case remoteAnnexStallDetection (Remote.gitconfig r) of
|
||||
Nothing -> go (Just ProbeStallDetection)
|
||||
Just StallDetectionDisabled -> go Nothing
|
||||
|
|
|
@ -23,6 +23,8 @@ git-annex (10.20221213) UNRELEASED; urgency=medium
|
|||
* Added an optional cost= configuration to all special remotes.
|
||||
* adb: Support the remote.name.cost and remote.name.cost-command configs.
|
||||
* findkeys: New command, very similar to git-annex find but operating on keys.
|
||||
* move, copy: Support combining --from and --to in order to move/copy
|
||||
the content of files that are in one remote to another remote.
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Mon, 12 Dec 2022 13:04:54 -0400
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command-line option parsing
|
||||
-
|
||||
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -134,7 +134,7 @@ parseDryRunOption = DryRun <$> switch
|
|||
<> help "don't make changes, but show what would be done"
|
||||
)
|
||||
|
||||
-- | From or To a remote.
|
||||
-- | From or To a remote but not both.
|
||||
data FromToOptions
|
||||
= FromRemote (DeferredParse Remote)
|
||||
| ToRemote (DeferredParse Remote)
|
||||
|
@ -162,23 +162,34 @@ parseToOption = strOption
|
|||
<> completeRemotes
|
||||
)
|
||||
|
||||
-- | Like FromToOptions, but with a special --to=here
|
||||
type FromToHereOptions = Either ToHere FromToOptions
|
||||
-- | From or to a remote, or both, or a special --to=here
|
||||
data FromToHereOptions
|
||||
= FromOrToRemote FromToOptions
|
||||
| ToHere
|
||||
| FromRemoteToRemote (DeferredParse Remote) (DeferredParse Remote)
|
||||
|
||||
data ToHere = ToHere
|
||||
|
||||
parseFromToHereOptions :: Parser FromToHereOptions
|
||||
parseFromToHereOptions = parsefrom <|> parseto
|
||||
parseFromToHereOptions :: Parser (Maybe FromToHereOptions)
|
||||
parseFromToHereOptions = go
|
||||
<$> optional parseFromOption
|
||||
<*> optional parseToOption
|
||||
where
|
||||
parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
|
||||
parseto = herespecialcase <$> parseToOption
|
||||
where
|
||||
herespecialcase "here" = Left ToHere
|
||||
herespecialcase "." = Left ToHere
|
||||
herespecialcase n = Right $ ToRemote $ parseRemoteOption n
|
||||
go (Just from) (Just to) = Just $ FromRemoteToRemote
|
||||
(parseRemoteOption from)
|
||||
(parseRemoteOption to)
|
||||
go (Just from) Nothing = Just $ FromOrToRemote
|
||||
(FromRemote $ parseRemoteOption from)
|
||||
go Nothing (Just to) = Just $ case to of
|
||||
"here" -> ToHere
|
||||
"." -> ToHere
|
||||
_ -> FromOrToRemote $ ToRemote $ parseRemoteOption to
|
||||
go Nothing Nothing = Nothing
|
||||
|
||||
instance DeferredParseClass FromToHereOptions where
|
||||
finishParse = either (pure . Left) (Right <$$> finishParse)
|
||||
finishParse (FromOrToRemote v) = FromOrToRemote <$> finishParse v
|
||||
finishParse ToHere = pure ToHere
|
||||
finishParse (FromRemoteToRemote v1 v2) = FromRemoteToRemote
|
||||
<$> finishParse v1
|
||||
<*> finishParse v2
|
||||
|
||||
-- Options for acting on keys, rather than work tree files.
|
||||
data KeyOptions
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -21,7 +21,7 @@ cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatc
|
|||
|
||||
data CopyOptions = CopyOptions
|
||||
{ copyFiles :: CmdParams
|
||||
, fromToOptions :: FromToHereOptions
|
||||
, fromToOptions :: Maybe FromToHereOptions
|
||||
, keyOptions :: Maybe KeyOptions
|
||||
, autoMode :: Bool
|
||||
, batchOption :: BatchMode
|
||||
|
@ -38,13 +38,19 @@ optParser desc = CopyOptions
|
|||
instance DeferredParseClass CopyOptions where
|
||||
finishParse v = CopyOptions
|
||||
<$> pure (copyFiles v)
|
||||
<*> finishParse (fromToOptions v)
|
||||
<*> maybe (pure Nothing) (Just <$$> finishParse)
|
||||
(fromToOptions v)
|
||||
<*> pure (keyOptions v)
|
||||
<*> pure (autoMode v)
|
||||
<*> pure (batchOption v)
|
||||
|
||||
seek :: CopyOptions -> CommandSeek
|
||||
seek o = startConcurrency commandStages $ do
|
||||
seek o = case fromToOptions o of
|
||||
Just fto -> seek' o fto
|
||||
Nothing -> giveup "Specify --from or --to"
|
||||
|
||||
seek' :: CopyOptions -> FromToHereOptions -> CommandSeek
|
||||
seek' o fto = startConcurrency commandStages $ do
|
||||
case batchOption o of
|
||||
NoBatch -> withKeyOptions
|
||||
(keyOptions o) (autoMode o) seeker
|
||||
|
@ -57,30 +63,33 @@ seek o = startConcurrency commandStages $ do
|
|||
ww = WarnUnmatchLsFiles
|
||||
|
||||
seeker = AnnexedFileSeeker
|
||||
{ startAction = start o
|
||||
, checkContentPresent = case fromToOptions o of
|
||||
Right (FromRemote _) -> Just False
|
||||
Right (ToRemote _) -> Just True
|
||||
Left ToHere -> Just False
|
||||
{ startAction = start o fto
|
||||
, checkContentPresent = case fto of
|
||||
FromOrToRemote (FromRemote _) -> Just False
|
||||
FromOrToRemote (ToRemote _) -> Just True
|
||||
ToHere -> Just False
|
||||
FromRemoteToRemote _ _ -> Just False
|
||||
, usesLocationLog = True
|
||||
}
|
||||
keyaction = Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever
|
||||
keyaction = Command.Move.startKey fto Command.Move.RemoveNever
|
||||
|
||||
{- A copy is just a move that does not delete the source file.
|
||||
- However, auto mode avoids unnecessary copies, and avoids getting or
|
||||
- sending non-preferred content. -}
|
||||
start :: CopyOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
|
||||
start o si file key = stopUnless shouldCopy $
|
||||
Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
|
||||
start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
|
||||
start o fto si file key = stopUnless shouldCopy $
|
||||
Command.Move.start fto Command.Move.RemoveNever si file key
|
||||
where
|
||||
shouldCopy
|
||||
| autoMode o = want <||> numCopiesCheck file key (<)
|
||||
| otherwise = return True
|
||||
want = case fromToOptions o of
|
||||
Right (ToRemote dest) ->
|
||||
want = case fto of
|
||||
FromOrToRemote (ToRemote dest) ->
|
||||
(Remote.uuid <$> getParsed dest) >>= checkwantsend
|
||||
FromOrToRemote (FromRemote _) -> checkwantget
|
||||
ToHere -> checkwantget
|
||||
FromRemoteToRemote _ dest ->
|
||||
(Remote.uuid <$> getParsed dest) >>= checkwantsend
|
||||
Right (FromRemote _) -> checkwantget
|
||||
Left ToHere -> checkwantget
|
||||
|
||||
checkwantsend = wantGetBy False (Just key) (AssociatedFile (Just file))
|
||||
checkwantget = wantGet False (Just key) (AssociatedFile (Just file))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010, 2013 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -13,6 +13,7 @@ import Annex.Transfer
|
|||
import Annex.NumCopies
|
||||
import Annex.Wanted
|
||||
import qualified Command.Move
|
||||
import Logs.Location
|
||||
|
||||
cmd :: Command
|
||||
cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
|
||||
|
@ -116,4 +117,5 @@ getKey' key afile = dispatch
|
|||
| otherwise = return True
|
||||
docopy r witness = do
|
||||
showAction $ "from " ++ Remote.name r
|
||||
download r key afile stdRetry witness
|
||||
logStatusAfter key $
|
||||
download r key afile stdRetry witness
|
||||
|
|
244
Command/Move.hs
244
Command/Move.hs
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2010-2022 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -19,6 +19,7 @@ import Annex.Transfer
|
|||
import Logs.Presence
|
||||
import Logs.Trust
|
||||
import Logs.File
|
||||
import Logs.Location
|
||||
import Annex.NumCopies
|
||||
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
|
@ -32,7 +33,7 @@ cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatc
|
|||
|
||||
data MoveOptions = MoveOptions
|
||||
{ moveFiles :: CmdParams
|
||||
, fromToOptions :: FromToHereOptions
|
||||
, fromToOptions :: Maybe FromToHereOptions
|
||||
, removeWhen :: RemoveWhen
|
||||
, keyOptions :: Maybe KeyOptions
|
||||
, batchOption :: BatchMode
|
||||
|
@ -49,7 +50,8 @@ optParser desc = MoveOptions
|
|||
instance DeferredParseClass MoveOptions where
|
||||
finishParse v = MoveOptions
|
||||
<$> pure (moveFiles v)
|
||||
<*> finishParse (fromToOptions v)
|
||||
<*> maybe (pure Nothing) (Just <$$> finishParse)
|
||||
(fromToOptions v)
|
||||
<*> pure (removeWhen v)
|
||||
<*> pure (keyOptions v)
|
||||
<*> pure (batchOption v)
|
||||
|
@ -58,7 +60,12 @@ data RemoveWhen = RemoveSafe | RemoveNever
|
|||
deriving (Show, Eq)
|
||||
|
||||
seek :: MoveOptions -> CommandSeek
|
||||
seek o = startConcurrency stages $ do
|
||||
seek o = case fromToOptions o of
|
||||
Just fto -> seek' o fto
|
||||
Nothing -> giveup "Specify --from or --to"
|
||||
|
||||
seek' :: MoveOptions -> FromToHereOptions -> CommandSeek
|
||||
seek' o fto = startConcurrency stages $ do
|
||||
case batchOption o of
|
||||
NoBatch -> withKeyOptions (keyOptions o) False seeker
|
||||
(commandAction . keyaction)
|
||||
|
@ -68,18 +75,20 @@ seek o = startConcurrency stages $ do
|
|||
batchAnnexed fmt seeker keyaction
|
||||
where
|
||||
seeker = AnnexedFileSeeker
|
||||
{ startAction = start (fromToOptions o) (removeWhen o)
|
||||
, checkContentPresent = case fromToOptions o of
|
||||
Right (FromRemote _) -> Nothing
|
||||
Right (ToRemote _) -> Just True
|
||||
Left ToHere -> Nothing
|
||||
{ startAction = start fto (removeWhen o)
|
||||
, checkContentPresent = case fto of
|
||||
FromOrToRemote (FromRemote _) -> Nothing
|
||||
FromOrToRemote (ToRemote _) -> Just True
|
||||
ToHere -> Nothing
|
||||
FromRemoteToRemote _ _ -> Nothing
|
||||
, usesLocationLog = True
|
||||
}
|
||||
stages = case fromToOptions o of
|
||||
Right (FromRemote _) -> downloadStages
|
||||
Right (ToRemote _) -> commandStages
|
||||
Left ToHere -> downloadStages
|
||||
keyaction = startKey (fromToOptions o) (removeWhen o)
|
||||
stages = case fto of
|
||||
FromOrToRemote (FromRemote _) -> downloadStages
|
||||
FromOrToRemote (ToRemote _) -> commandStages
|
||||
ToHere -> downloadStages
|
||||
FromRemoteToRemote _ _ -> commandStages
|
||||
keyaction = startKey fto (removeWhen o)
|
||||
ww = WarnUnmatchLsFiles
|
||||
|
||||
start :: FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart
|
||||
|
@ -95,15 +104,19 @@ startKey fromto removewhen (si, k, ai) =
|
|||
start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> SeekInput -> Key -> ActionItem -> CommandStart
|
||||
start' fromto removewhen afile si key ai =
|
||||
case fromto of
|
||||
Right (FromRemote src) ->
|
||||
FromOrToRemote (FromRemote src) ->
|
||||
checkFailedTransferDirection ai Download $
|
||||
fromStart removewhen afile key ai si =<< getParsed src
|
||||
Right (ToRemote dest) ->
|
||||
FromOrToRemote (ToRemote dest) ->
|
||||
checkFailedTransferDirection ai Upload $
|
||||
toStart removewhen afile key ai si =<< getParsed dest
|
||||
Left ToHere ->
|
||||
ToHere ->
|
||||
checkFailedTransferDirection ai Download $
|
||||
toHereStart removewhen afile key ai si
|
||||
FromRemoteToRemote src dest -> do
|
||||
src' <- getParsed src
|
||||
dest' <- getParsed dest
|
||||
fromToStart removewhen afile key ai si src' dest'
|
||||
|
||||
describeMoveAction :: RemoveWhen -> String
|
||||
describeMoveAction RemoveNever = "copy"
|
||||
|
@ -136,7 +149,10 @@ expectedPresent dest key = do
|
|||
return $ dest `elem` remotes
|
||||
|
||||
toPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
|
||||
toPerform dest removewhen key afile fastcheck isthere = do
|
||||
toPerform = toPerform' Nothing
|
||||
|
||||
toPerform' :: Maybe ContentRemovalLock -> Remote -> RemoveWhen -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
|
||||
toPerform' mcontentlock dest removewhen key afile fastcheck isthere = do
|
||||
srcuuid <- getUUID
|
||||
case isthere of
|
||||
Left err -> do
|
||||
|
@ -165,7 +181,7 @@ toPerform dest removewhen key afile fastcheck isthere = do
|
|||
setpresentremote
|
||||
logMoveCleanup deststartedwithcopy
|
||||
next $ return True
|
||||
RemoveSafe -> lockContentForRemoval key lockfailed $ \contentlock -> do
|
||||
RemoveSafe -> lockcontentforremoval $ \contentlock -> do
|
||||
srcuuid <- getUUID
|
||||
r <- willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
|
||||
DropAllowed -> drophere setpresentremote contentlock "moved"
|
||||
|
@ -200,6 +216,10 @@ toPerform dest removewhen key afile fastcheck isthere = do
|
|||
() <- setpresentremote
|
||||
return False
|
||||
|
||||
lockcontentforremoval a = case mcontentlock of
|
||||
Nothing -> lockContentForRemoval key lockfailed a
|
||||
Just contentlock -> a contentlock
|
||||
|
||||
-- This occurs when, for example, two files are being dropped
|
||||
-- and have the same content. The seek stage checks if the content
|
||||
-- is present, but due to buffering, may find it present for the
|
||||
|
@ -233,39 +253,54 @@ fromOk src key
|
|||
|
||||
fromPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform
|
||||
fromPerform src removewhen key afile = do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
present <- inAnnex key
|
||||
finish <- fromPerform' present True src key afile
|
||||
finish removewhen
|
||||
|
||||
fromPerform' :: Bool -> Bool -> Remote -> Key -> AssociatedFile -> Annex (RemoveWhen -> CommandPerform)
|
||||
fromPerform' present updatelocationlog src key afile = do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
destuuid <- getUUID
|
||||
logMove srcuuid destuuid present key $ \deststartedwithcopy ->
|
||||
logMove (Remote.uuid src) destuuid present key $ \deststartedwithcopy ->
|
||||
if present
|
||||
then dispatch removewhen deststartedwithcopy True
|
||||
else dispatch removewhen deststartedwithcopy =<< get
|
||||
then return $ finish deststartedwithcopy True
|
||||
else do
|
||||
got <- get
|
||||
return $ finish deststartedwithcopy got
|
||||
where
|
||||
get = notifyTransfer Download afile $
|
||||
download src key afile stdRetry
|
||||
logdownload .
|
||||
download src key afile stdRetry
|
||||
|
||||
dispatch _ deststartedwithcopy False = do
|
||||
logdownload a
|
||||
| updatelocationlog = logStatusAfter key a
|
||||
| otherwise = a
|
||||
|
||||
finish deststartedwithcopy False _ = do
|
||||
logMoveCleanup deststartedwithcopy
|
||||
stop -- copy failed
|
||||
dispatch RemoveNever deststartedwithcopy True = do
|
||||
finish deststartedwithcopy True RemoveNever = do
|
||||
logMoveCleanup deststartedwithcopy
|
||||
next $ return True -- copy complete
|
||||
dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do
|
||||
finish deststartedwithcopy True RemoveSafe = do
|
||||
destuuid <- getUUID
|
||||
willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
|
||||
DropAllowed -> dropremote deststartedwithcopy "moved"
|
||||
DropCheckNumCopies -> do
|
||||
(numcopies, mincopies) <- getSafestNumMinCopies afile key
|
||||
(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
|
||||
verifyEnoughCopiesToDrop "" key Nothing numcopies mincopies [Remote.uuid src] verified
|
||||
tocheck (dropremote deststartedwithcopy . showproof) (faileddropremote deststartedwithcopy)
|
||||
DropWorse -> faileddropremote deststartedwithcopy
|
||||
|
||||
srcuuid = Remote.uuid src
|
||||
|
||||
lockContentShared key $ \_lck ->
|
||||
fromDrop src destuuid deststartedwithcopy key afile id
|
||||
|
||||
fromDrop :: Remote -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> ([UnVerifiedCopy] -> [UnVerifiedCopy])-> CommandPerform
|
||||
fromDrop src destuuid deststartedwithcopy key afile adjusttocheck =
|
||||
willDropMakeItWorse (Remote.uuid src) destuuid deststartedwithcopy key afile >>= \case
|
||||
DropAllowed -> dropremote "moved"
|
||||
DropCheckNumCopies -> do
|
||||
(numcopies, mincopies) <- getSafestNumMinCopies afile key
|
||||
(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
|
||||
verifyEnoughCopiesToDrop "" key Nothing numcopies mincopies [Remote.uuid src] verified
|
||||
(adjusttocheck tocheck) (dropremote . showproof) faileddropremote
|
||||
DropWorse -> faileddropremote
|
||||
where
|
||||
showproof proof = "proof: " ++ show proof
|
||||
|
||||
dropremote deststartedwithcopy reason = do
|
||||
|
||||
dropremote reason = do
|
||||
fastDebug "Command.Move" $ unwords
|
||||
[ "Dropping from remote"
|
||||
, show src
|
||||
|
@ -275,8 +310,8 @@ fromPerform src removewhen key afile = do
|
|||
when ok $
|
||||
logMoveCleanup deststartedwithcopy
|
||||
next $ Command.Drop.cleanupRemote key src (Command.Drop.DroppingUnused False) ok
|
||||
|
||||
faileddropremote deststartedwithcopy = do
|
||||
|
||||
faileddropremote = do
|
||||
showLongNote "(Use --force to override this check, or adjust numcopies.)"
|
||||
showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."
|
||||
logMoveCleanup deststartedwithcopy
|
||||
|
@ -297,6 +332,124 @@ toHereStart removewhen afile key ai si =
|
|||
fromPerform r removewhen key afile
|
||||
next $ return True
|
||||
|
||||
fromToStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> Remote -> Remote -> CommandStart
|
||||
fromToStart removewhen afile key ai si src dest = do
|
||||
if Remote.uuid src == Remote.uuid dest
|
||||
then stop
|
||||
else do
|
||||
u <- getUUID
|
||||
if u == Remote.uuid src
|
||||
then toStart removewhen afile key ai si dest
|
||||
else if u == Remote.uuid dest
|
||||
then fromStart removewhen afile key ai si src
|
||||
else stopUnless (fromOk src key) $
|
||||
starting (describeMoveAction removewhen) (OnlyActionOn key ai) si $
|
||||
fromToPerform src dest removewhen key afile
|
||||
|
||||
{- When there is a local copy, transfer it to the dest, and drop from the src.
|
||||
-
|
||||
- When the dest has a copy, drop it from the src.
|
||||
-
|
||||
- Otherwise, download a copy from the dest, populating the local annex
|
||||
- copy, but not updating location logs. Then transfer that to the dest,
|
||||
- drop the local copy, and finally drop from the src.
|
||||
-
|
||||
- Using a regular download of the local copy, rather than download to
|
||||
- some other file makes resuming an interruped download work as usual,
|
||||
- and simplifies implementation. It does mean that, if `git-annex get` of
|
||||
- the same content is being run at the same time as this move, the content
|
||||
- may end up locally present, or not. This is similar to the behavior
|
||||
- when running `git-annex move --to` concurrently with git-annex get.
|
||||
-}
|
||||
fromToPerform :: Remote -> Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform
|
||||
fromToPerform src dest removewhen key afile = do
|
||||
hereuuid <- getUUID
|
||||
loggedpresent <- any (== hereuuid)
|
||||
<$> loggedLocations key
|
||||
ispresent <- inAnnex key
|
||||
go ispresent loggedpresent
|
||||
where
|
||||
-- The content is present, and is logged as present, so it
|
||||
-- can be sent to dest and dropped from src.
|
||||
--
|
||||
-- When resuming an interrupted move --from --to, where the content
|
||||
-- was not present but got downloaded from src, it will not be
|
||||
-- logged present, and so this won't be used. Instead, the local
|
||||
-- content will get dropped after being copied to dest.
|
||||
go True True = do
|
||||
haskey <- Remote.hasKey dest key
|
||||
-- Prepare to drop from src later. Doing this first
|
||||
-- makes "from src" be shown consistently before
|
||||
-- "to dest"
|
||||
dropsrc <- fromsrc True
|
||||
combinecleanups
|
||||
-- Send to dest, preserve local copy.
|
||||
(todest Nothing RemoveNever haskey)
|
||||
(\senttodest -> if senttodest
|
||||
then dropsrc removewhen
|
||||
else stop
|
||||
)
|
||||
go ispresent _loggedpresent = do
|
||||
haskey <- Remote.hasKey dest key
|
||||
case haskey of
|
||||
Left err -> do
|
||||
showNote err
|
||||
stop
|
||||
Right True -> do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
showAction $ "to " ++ Remote.name dest
|
||||
-- Drop from src, checking copies including
|
||||
-- the one already in dest.
|
||||
dropfromsrc id
|
||||
Right False -> do
|
||||
-- Get local copy from src, defer dropping
|
||||
-- from src until later. Note that fromsrc
|
||||
-- does not update the location log.
|
||||
cleanupfromsrc <- if ispresent
|
||||
then return $ const $ next (return True)
|
||||
else fromsrc False
|
||||
-- Lock the local copy for removal early,
|
||||
-- to avoid other processes relying on it
|
||||
-- as a copy, and removing other copies
|
||||
-- (such as the one in src), that prevents
|
||||
-- dropping the local copy later.
|
||||
lockContentForRemoval key stop $ \contentlock ->
|
||||
combinecleanups
|
||||
-- Send to dest and remove local copy.
|
||||
(todest (Just contentlock) RemoveSafe haskey)
|
||||
(\senttodest ->
|
||||
-- Drop from src, checking
|
||||
-- copies including dest.
|
||||
combinecleanups
|
||||
(cleanupfromsrc RemoveNever)
|
||||
(\_ -> if senttodest
|
||||
then dropfromsrc (\l -> UnVerifiedRemote dest : l)
|
||||
else stop
|
||||
)
|
||||
)
|
||||
|
||||
fromsrc present = fromPerform' present False src key afile
|
||||
|
||||
todest mcontentlock removewhen' = toPerform' mcontentlock dest removewhen' key afile False
|
||||
|
||||
dropfromsrc adjusttocheck = case removewhen of
|
||||
RemoveSafe -> logMove (Remote.uuid src) (Remote.uuid dest) True key $ \deststartedwithcopy ->
|
||||
fromDrop src (Remote.uuid dest) deststartedwithcopy key afile adjusttocheck
|
||||
RemoveNever -> next (return True)
|
||||
|
||||
combinecleanups a b = a >>= \case
|
||||
Just cleanupa -> b True >>= \case
|
||||
Just cleanupb -> return $ Just $ do
|
||||
oka <- cleanupa
|
||||
okb <- cleanupb
|
||||
return (oka && okb)
|
||||
Nothing -> return (Just cleanupa)
|
||||
Nothing -> b False >>= \case
|
||||
Just cleanupb -> return $ Just $ do
|
||||
void cleanupb
|
||||
return False
|
||||
Nothing -> return Nothing
|
||||
|
||||
{- The goal of this command is to allow the user maximum freedom to move
|
||||
- files as they like, while avoiding making bad situations any worse
|
||||
- than they already were.
|
||||
|
@ -306,9 +459,10 @@ toHereStart removewhen afile key ai si =
|
|||
- repository reduces the number of copies, and should fail if
|
||||
- that would violate numcopies settings.
|
||||
-
|
||||
- On the other hand, when the destination repository does not already
|
||||
- have a copy of a file, it can be dropped without making numcopies
|
||||
- worse, so the move is allowed even if numcopies is not met.
|
||||
- On the other hand, when the destination repository did not start
|
||||
- with a copy of a file, it can be dropped from the source without
|
||||
- making numcopies worse, so the move is allowed even if numcopies
|
||||
- is not met.
|
||||
-
|
||||
- Similarly, a file can move from an untrusted repository to another
|
||||
- untrusted repository, even if that is the only copy of the file.
|
||||
|
|
|
@ -32,6 +32,15 @@ Paths of files or directories to operate on can be specified.
|
|||
Copy the content of files from all reachable remotes to the local
|
||||
repository.
|
||||
|
||||
* `--from=remote1 --to=remote2`
|
||||
|
||||
Copy the content of files that are in remote1 to remote2.
|
||||
|
||||
This is implemented by first downloading the content from remote1 to the
|
||||
local repository (if not already present), then sending it to remote2, and
|
||||
then deleting the content from the local repository (if it was not present
|
||||
to start with).
|
||||
|
||||
* `--jobs=N` `-JN`
|
||||
|
||||
Enables parallel transfers with up to the specified number of jobs
|
||||
|
|
|
@ -28,6 +28,16 @@ Paths of files or directories to operate on can be specified.
|
|||
Move the content of files from all reachable remotes to the local
|
||||
repository.
|
||||
|
||||
* `--from=remote1 --to=remote2`
|
||||
|
||||
Move the content of files that are in remote1 to remote2. Does not change
|
||||
what is stored in the local repository.
|
||||
|
||||
This is implemented by first downloading the content from remote1 to the
|
||||
local repository (if not already present), then sending it to remote2, and
|
||||
then deleting the content from the local repository (if it was not present
|
||||
to start with).
|
||||
|
||||
* `--force`
|
||||
|
||||
Override numcopies and required content checking, and always remove
|
||||
|
|
|
@ -14,3 +14,5 @@ NB may be some `annex sync` would do that magic?
|
|||
|
||||
[[!meta author=yoh]]
|
||||
[[!tag projects/dandi]]
|
||||
|
||||
> [[implemented|done]] --[[Joey]]
|
||||
|
|
|
@ -0,0 +1,13 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 8"""
|
||||
date="2023-01-23T21:45:37Z"
|
||||
content="""
|
||||
I did implement this using the second path described in comment #5.
|
||||
|
||||
And it does download the content to the local annex, and then after
|
||||
sending it to the destination remote, will drop the local content
|
||||
(unless it was already present). So running it concurrent with
|
||||
`git-annex get` may leave local files present or not, depending on which
|
||||
process gets to a file first.
|
||||
"""]]
|
Loading…
Add table
Add a link
Reference in a new issue