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, 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
|
- fallback action instead. However, the content is not guaranteed to be
|
||||||
- present when this succeeds.
|
- present when this succeeds.
|
||||||
-}
|
-}
|
||||||
|
|
|
@ -29,7 +29,6 @@ import Annex.Notification as X
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
import Annex.Action
|
import Annex.Action
|
||||||
import Logs.Location
|
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
import Annex.LockPool
|
import Annex.LockPool
|
||||||
|
@ -73,7 +72,7 @@ alwaysUpload u key f sd d a _witness = guardHaveUUID u $
|
||||||
|
|
||||||
-- Download, supporting canceling detected stalls.
|
-- Download, supporting canceling detected stalls.
|
||||||
download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
|
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
|
case remoteAnnexStallDetection (Remote.gitconfig r) of
|
||||||
Nothing -> go (Just ProbeStallDetection)
|
Nothing -> go (Just ProbeStallDetection)
|
||||||
Just StallDetectionDisabled -> go Nothing
|
Just StallDetectionDisabled -> go Nothing
|
||||||
|
|
|
@ -23,6 +23,8 @@ git-annex (10.20221213) UNRELEASED; urgency=medium
|
||||||
* Added an optional cost= configuration to all special remotes.
|
* Added an optional cost= configuration to all special remotes.
|
||||||
* adb: Support the remote.name.cost and remote.name.cost-command configs.
|
* 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.
|
* 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
|
-- Joey Hess <id@joeyh.name> Mon, 12 Dec 2022 13:04:54 -0400
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex command-line option parsing
|
{- 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.
|
- 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"
|
<> 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
|
data FromToOptions
|
||||||
= FromRemote (DeferredParse Remote)
|
= FromRemote (DeferredParse Remote)
|
||||||
| ToRemote (DeferredParse Remote)
|
| ToRemote (DeferredParse Remote)
|
||||||
|
@ -162,23 +162,34 @@ parseToOption = strOption
|
||||||
<> completeRemotes
|
<> completeRemotes
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Like FromToOptions, but with a special --to=here
|
-- | From or to a remote, or both, or a special --to=here
|
||||||
type FromToHereOptions = Either ToHere FromToOptions
|
data FromToHereOptions
|
||||||
|
= FromOrToRemote FromToOptions
|
||||||
|
| ToHere
|
||||||
|
| FromRemoteToRemote (DeferredParse Remote) (DeferredParse Remote)
|
||||||
|
|
||||||
data ToHere = ToHere
|
parseFromToHereOptions :: Parser (Maybe FromToHereOptions)
|
||||||
|
parseFromToHereOptions = go
|
||||||
parseFromToHereOptions :: Parser FromToHereOptions
|
<$> optional parseFromOption
|
||||||
parseFromToHereOptions = parsefrom <|> parseto
|
<*> optional parseToOption
|
||||||
where
|
where
|
||||||
parsefrom = Right . FromRemote . parseRemoteOption <$> parseFromOption
|
go (Just from) (Just to) = Just $ FromRemoteToRemote
|
||||||
parseto = herespecialcase <$> parseToOption
|
(parseRemoteOption from)
|
||||||
where
|
(parseRemoteOption to)
|
||||||
herespecialcase "here" = Left ToHere
|
go (Just from) Nothing = Just $ FromOrToRemote
|
||||||
herespecialcase "." = Left ToHere
|
(FromRemote $ parseRemoteOption from)
|
||||||
herespecialcase n = Right $ ToRemote $ parseRemoteOption n
|
go Nothing (Just to) = Just $ case to of
|
||||||
|
"here" -> ToHere
|
||||||
|
"." -> ToHere
|
||||||
|
_ -> FromOrToRemote $ ToRemote $ parseRemoteOption to
|
||||||
|
go Nothing Nothing = Nothing
|
||||||
|
|
||||||
instance DeferredParseClass FromToHereOptions where
|
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.
|
-- Options for acting on keys, rather than work tree files.
|
||||||
data KeyOptions
|
data KeyOptions
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex command
|
{- 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.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -21,7 +21,7 @@ cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatc
|
||||||
|
|
||||||
data CopyOptions = CopyOptions
|
data CopyOptions = CopyOptions
|
||||||
{ copyFiles :: CmdParams
|
{ copyFiles :: CmdParams
|
||||||
, fromToOptions :: FromToHereOptions
|
, fromToOptions :: Maybe FromToHereOptions
|
||||||
, keyOptions :: Maybe KeyOptions
|
, keyOptions :: Maybe KeyOptions
|
||||||
, autoMode :: Bool
|
, autoMode :: Bool
|
||||||
, batchOption :: BatchMode
|
, batchOption :: BatchMode
|
||||||
|
@ -38,13 +38,19 @@ optParser desc = CopyOptions
|
||||||
instance DeferredParseClass CopyOptions where
|
instance DeferredParseClass CopyOptions where
|
||||||
finishParse v = CopyOptions
|
finishParse v = CopyOptions
|
||||||
<$> pure (copyFiles v)
|
<$> pure (copyFiles v)
|
||||||
<*> finishParse (fromToOptions v)
|
<*> maybe (pure Nothing) (Just <$$> finishParse)
|
||||||
|
(fromToOptions v)
|
||||||
<*> pure (keyOptions v)
|
<*> pure (keyOptions v)
|
||||||
<*> pure (autoMode v)
|
<*> pure (autoMode v)
|
||||||
<*> pure (batchOption v)
|
<*> pure (batchOption v)
|
||||||
|
|
||||||
seek :: CopyOptions -> CommandSeek
|
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
|
case batchOption o of
|
||||||
NoBatch -> withKeyOptions
|
NoBatch -> withKeyOptions
|
||||||
(keyOptions o) (autoMode o) seeker
|
(keyOptions o) (autoMode o) seeker
|
||||||
|
@ -57,30 +63,33 @@ seek o = startConcurrency commandStages $ do
|
||||||
ww = WarnUnmatchLsFiles
|
ww = WarnUnmatchLsFiles
|
||||||
|
|
||||||
seeker = AnnexedFileSeeker
|
seeker = AnnexedFileSeeker
|
||||||
{ startAction = start o
|
{ startAction = start o fto
|
||||||
, checkContentPresent = case fromToOptions o of
|
, checkContentPresent = case fto of
|
||||||
Right (FromRemote _) -> Just False
|
FromOrToRemote (FromRemote _) -> Just False
|
||||||
Right (ToRemote _) -> Just True
|
FromOrToRemote (ToRemote _) -> Just True
|
||||||
Left ToHere -> Just False
|
ToHere -> Just False
|
||||||
|
FromRemoteToRemote _ _ -> Just False
|
||||||
, usesLocationLog = True
|
, 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.
|
{- A copy is just a move that does not delete the source file.
|
||||||
- However, auto mode avoids unnecessary copies, and avoids getting or
|
- However, auto mode avoids unnecessary copies, and avoids getting or
|
||||||
- sending non-preferred content. -}
|
- sending non-preferred content. -}
|
||||||
start :: CopyOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
|
start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart
|
||||||
start o si file key = stopUnless shouldCopy $
|
start o fto si file key = stopUnless shouldCopy $
|
||||||
Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
|
Command.Move.start fto Command.Move.RemoveNever si file key
|
||||||
where
|
where
|
||||||
shouldCopy
|
shouldCopy
|
||||||
| autoMode o = want <||> numCopiesCheck file key (<)
|
| autoMode o = want <||> numCopiesCheck file key (<)
|
||||||
| otherwise = return True
|
| otherwise = return True
|
||||||
want = case fromToOptions o of
|
want = case fto of
|
||||||
Right (ToRemote dest) ->
|
FromOrToRemote (ToRemote dest) ->
|
||||||
|
(Remote.uuid <$> getParsed dest) >>= checkwantsend
|
||||||
|
FromOrToRemote (FromRemote _) -> checkwantget
|
||||||
|
ToHere -> checkwantget
|
||||||
|
FromRemoteToRemote _ dest ->
|
||||||
(Remote.uuid <$> getParsed dest) >>= checkwantsend
|
(Remote.uuid <$> getParsed dest) >>= checkwantsend
|
||||||
Right (FromRemote _) -> checkwantget
|
|
||||||
Left ToHere -> checkwantget
|
|
||||||
|
|
||||||
checkwantsend = wantGetBy False (Just key) (AssociatedFile (Just file))
|
checkwantsend = wantGetBy False (Just key) (AssociatedFile (Just file))
|
||||||
checkwantget = wantGet False (Just key) (AssociatedFile (Just file))
|
checkwantget = wantGet False (Just key) (AssociatedFile (Just file))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex command
|
{- 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.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -13,6 +13,7 @@ import Annex.Transfer
|
||||||
import Annex.NumCopies
|
import Annex.NumCopies
|
||||||
import Annex.Wanted
|
import Annex.Wanted
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
import Logs.Location
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
|
cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
|
||||||
|
@ -116,4 +117,5 @@ getKey' key afile = dispatch
|
||||||
| otherwise = return True
|
| otherwise = return True
|
||||||
docopy r witness = do
|
docopy r witness = do
|
||||||
showAction $ "from " ++ Remote.name r
|
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
|
{- 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.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -19,6 +19,7 @@ import Annex.Transfer
|
||||||
import Logs.Presence
|
import Logs.Presence
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.File
|
import Logs.File
|
||||||
|
import Logs.Location
|
||||||
import Annex.NumCopies
|
import Annex.NumCopies
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
|
@ -32,7 +33,7 @@ cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatc
|
||||||
|
|
||||||
data MoveOptions = MoveOptions
|
data MoveOptions = MoveOptions
|
||||||
{ moveFiles :: CmdParams
|
{ moveFiles :: CmdParams
|
||||||
, fromToOptions :: FromToHereOptions
|
, fromToOptions :: Maybe FromToHereOptions
|
||||||
, removeWhen :: RemoveWhen
|
, removeWhen :: RemoveWhen
|
||||||
, keyOptions :: Maybe KeyOptions
|
, keyOptions :: Maybe KeyOptions
|
||||||
, batchOption :: BatchMode
|
, batchOption :: BatchMode
|
||||||
|
@ -49,7 +50,8 @@ optParser desc = MoveOptions
|
||||||
instance DeferredParseClass MoveOptions where
|
instance DeferredParseClass MoveOptions where
|
||||||
finishParse v = MoveOptions
|
finishParse v = MoveOptions
|
||||||
<$> pure (moveFiles v)
|
<$> pure (moveFiles v)
|
||||||
<*> finishParse (fromToOptions v)
|
<*> maybe (pure Nothing) (Just <$$> finishParse)
|
||||||
|
(fromToOptions v)
|
||||||
<*> pure (removeWhen v)
|
<*> pure (removeWhen v)
|
||||||
<*> pure (keyOptions v)
|
<*> pure (keyOptions v)
|
||||||
<*> pure (batchOption v)
|
<*> pure (batchOption v)
|
||||||
|
@ -58,7 +60,12 @@ data RemoveWhen = RemoveSafe | RemoveNever
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
seek :: MoveOptions -> CommandSeek
|
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
|
case batchOption o of
|
||||||
NoBatch -> withKeyOptions (keyOptions o) False seeker
|
NoBatch -> withKeyOptions (keyOptions o) False seeker
|
||||||
(commandAction . keyaction)
|
(commandAction . keyaction)
|
||||||
|
@ -68,18 +75,20 @@ seek o = startConcurrency stages $ do
|
||||||
batchAnnexed fmt seeker keyaction
|
batchAnnexed fmt seeker keyaction
|
||||||
where
|
where
|
||||||
seeker = AnnexedFileSeeker
|
seeker = AnnexedFileSeeker
|
||||||
{ startAction = start (fromToOptions o) (removeWhen o)
|
{ startAction = start fto (removeWhen o)
|
||||||
, checkContentPresent = case fromToOptions o of
|
, checkContentPresent = case fto of
|
||||||
Right (FromRemote _) -> Nothing
|
FromOrToRemote (FromRemote _) -> Nothing
|
||||||
Right (ToRemote _) -> Just True
|
FromOrToRemote (ToRemote _) -> Just True
|
||||||
Left ToHere -> Nothing
|
ToHere -> Nothing
|
||||||
|
FromRemoteToRemote _ _ -> Nothing
|
||||||
, usesLocationLog = True
|
, usesLocationLog = True
|
||||||
}
|
}
|
||||||
stages = case fromToOptions o of
|
stages = case fto of
|
||||||
Right (FromRemote _) -> downloadStages
|
FromOrToRemote (FromRemote _) -> downloadStages
|
||||||
Right (ToRemote _) -> commandStages
|
FromOrToRemote (ToRemote _) -> commandStages
|
||||||
Left ToHere -> downloadStages
|
ToHere -> downloadStages
|
||||||
keyaction = startKey (fromToOptions o) (removeWhen o)
|
FromRemoteToRemote _ _ -> commandStages
|
||||||
|
keyaction = startKey fto (removeWhen o)
|
||||||
ww = WarnUnmatchLsFiles
|
ww = WarnUnmatchLsFiles
|
||||||
|
|
||||||
start :: FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart
|
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' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> SeekInput -> Key -> ActionItem -> CommandStart
|
||||||
start' fromto removewhen afile si key ai =
|
start' fromto removewhen afile si key ai =
|
||||||
case fromto of
|
case fromto of
|
||||||
Right (FromRemote src) ->
|
FromOrToRemote (FromRemote src) ->
|
||||||
checkFailedTransferDirection ai Download $
|
checkFailedTransferDirection ai Download $
|
||||||
fromStart removewhen afile key ai si =<< getParsed src
|
fromStart removewhen afile key ai si =<< getParsed src
|
||||||
Right (ToRemote dest) ->
|
FromOrToRemote (ToRemote dest) ->
|
||||||
checkFailedTransferDirection ai Upload $
|
checkFailedTransferDirection ai Upload $
|
||||||
toStart removewhen afile key ai si =<< getParsed dest
|
toStart removewhen afile key ai si =<< getParsed dest
|
||||||
Left ToHere ->
|
ToHere ->
|
||||||
checkFailedTransferDirection ai Download $
|
checkFailedTransferDirection ai Download $
|
||||||
toHereStart removewhen afile key ai si
|
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 :: RemoveWhen -> String
|
||||||
describeMoveAction RemoveNever = "copy"
|
describeMoveAction RemoveNever = "copy"
|
||||||
|
@ -136,7 +149,10 @@ expectedPresent dest key = do
|
||||||
return $ dest `elem` remotes
|
return $ dest `elem` remotes
|
||||||
|
|
||||||
toPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
|
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
|
srcuuid <- getUUID
|
||||||
case isthere of
|
case isthere of
|
||||||
Left err -> do
|
Left err -> do
|
||||||
|
@ -165,7 +181,7 @@ toPerform dest removewhen key afile fastcheck isthere = do
|
||||||
setpresentremote
|
setpresentremote
|
||||||
logMoveCleanup deststartedwithcopy
|
logMoveCleanup deststartedwithcopy
|
||||||
next $ return True
|
next $ return True
|
||||||
RemoveSafe -> lockContentForRemoval key lockfailed $ \contentlock -> do
|
RemoveSafe -> lockcontentforremoval $ \contentlock -> do
|
||||||
srcuuid <- getUUID
|
srcuuid <- getUUID
|
||||||
r <- willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
|
r <- willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
|
||||||
DropAllowed -> drophere setpresentremote contentlock "moved"
|
DropAllowed -> drophere setpresentremote contentlock "moved"
|
||||||
|
@ -200,6 +216,10 @@ toPerform dest removewhen key afile fastcheck isthere = do
|
||||||
() <- setpresentremote
|
() <- setpresentremote
|
||||||
return False
|
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
|
-- This occurs when, for example, two files are being dropped
|
||||||
-- and have the same content. The seek stage checks if the content
|
-- and have the same content. The seek stage checks if the content
|
||||||
-- is present, but due to buffering, may find it present for the
|
-- 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 :: Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform
|
||||||
fromPerform src removewhen key afile = do
|
fromPerform src removewhen key afile = do
|
||||||
showAction $ "from " ++ Remote.name src
|
|
||||||
present <- inAnnex key
|
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
|
destuuid <- getUUID
|
||||||
logMove srcuuid destuuid present key $ \deststartedwithcopy ->
|
logMove (Remote.uuid src) destuuid present key $ \deststartedwithcopy ->
|
||||||
if present
|
if present
|
||||||
then dispatch removewhen deststartedwithcopy True
|
then return $ finish deststartedwithcopy True
|
||||||
else dispatch removewhen deststartedwithcopy =<< get
|
else do
|
||||||
|
got <- get
|
||||||
|
return $ finish deststartedwithcopy got
|
||||||
where
|
where
|
||||||
get = notifyTransfer Download afile $
|
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
|
logMoveCleanup deststartedwithcopy
|
||||||
stop -- copy failed
|
stop -- copy failed
|
||||||
dispatch RemoveNever deststartedwithcopy True = do
|
finish deststartedwithcopy True RemoveNever = do
|
||||||
logMoveCleanup deststartedwithcopy
|
logMoveCleanup deststartedwithcopy
|
||||||
next $ return True -- copy complete
|
next $ return True -- copy complete
|
||||||
dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do
|
finish deststartedwithcopy True RemoveSafe = do
|
||||||
destuuid <- getUUID
|
destuuid <- getUUID
|
||||||
willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case
|
lockContentShared key $ \_lck ->
|
||||||
DropAllowed -> dropremote deststartedwithcopy "moved"
|
fromDrop src destuuid deststartedwithcopy key afile id
|
||||||
DropCheckNumCopies -> do
|
|
||||||
(numcopies, mincopies) <- getSafestNumMinCopies afile key
|
fromDrop :: Remote -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> ([UnVerifiedCopy] -> [UnVerifiedCopy])-> CommandPerform
|
||||||
(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
|
fromDrop src destuuid deststartedwithcopy key afile adjusttocheck =
|
||||||
verifyEnoughCopiesToDrop "" key Nothing numcopies mincopies [Remote.uuid src] verified
|
willDropMakeItWorse (Remote.uuid src) destuuid deststartedwithcopy key afile >>= \case
|
||||||
tocheck (dropremote deststartedwithcopy . showproof) (faileddropremote deststartedwithcopy)
|
DropAllowed -> dropremote "moved"
|
||||||
DropWorse -> faileddropremote deststartedwithcopy
|
DropCheckNumCopies -> do
|
||||||
|
(numcopies, mincopies) <- getSafestNumMinCopies afile key
|
||||||
srcuuid = Remote.uuid src
|
(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
|
showproof proof = "proof: " ++ show proof
|
||||||
|
|
||||||
dropremote deststartedwithcopy reason = do
|
dropremote reason = do
|
||||||
fastDebug "Command.Move" $ unwords
|
fastDebug "Command.Move" $ unwords
|
||||||
[ "Dropping from remote"
|
[ "Dropping from remote"
|
||||||
, show src
|
, show src
|
||||||
|
@ -275,8 +310,8 @@ fromPerform src removewhen key afile = do
|
||||||
when ok $
|
when ok $
|
||||||
logMoveCleanup deststartedwithcopy
|
logMoveCleanup deststartedwithcopy
|
||||||
next $ Command.Drop.cleanupRemote key src (Command.Drop.DroppingUnused False) ok
|
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 "(Use --force to override this check, or adjust numcopies.)"
|
||||||
showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."
|
showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."
|
||||||
logMoveCleanup deststartedwithcopy
|
logMoveCleanup deststartedwithcopy
|
||||||
|
@ -297,6 +332,124 @@ toHereStart removewhen afile key ai si =
|
||||||
fromPerform r removewhen key afile
|
fromPerform r removewhen key afile
|
||||||
next $ return True
|
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
|
{- 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
|
- files as they like, while avoiding making bad situations any worse
|
||||||
- than they already were.
|
- than they already were.
|
||||||
|
@ -306,9 +459,10 @@ toHereStart removewhen afile key ai si =
|
||||||
- repository reduces the number of copies, and should fail if
|
- repository reduces the number of copies, and should fail if
|
||||||
- that would violate numcopies settings.
|
- that would violate numcopies settings.
|
||||||
-
|
-
|
||||||
- On the other hand, when the destination repository does not already
|
- On the other hand, when the destination repository did not start
|
||||||
- have a copy of a file, it can be dropped without making numcopies
|
- with a copy of a file, it can be dropped from the source without
|
||||||
- worse, so the move is allowed even if numcopies is not met.
|
- 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
|
- Similarly, a file can move from an untrusted repository to another
|
||||||
- untrusted repository, even if that is the only copy of the file.
|
- 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
|
Copy the content of files from all reachable remotes to the local
|
||||||
repository.
|
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`
|
* `--jobs=N` `-JN`
|
||||||
|
|
||||||
Enables parallel transfers with up to the specified number of jobs
|
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
|
Move the content of files from all reachable remotes to the local
|
||||||
repository.
|
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`
|
* `--force`
|
||||||
|
|
||||||
Override numcopies and required content checking, and always remove
|
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]]
|
[[!meta author=yoh]]
|
||||||
[[!tag projects/dandi]]
|
[[!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