move: --safe/--unsafe and potential drop race fix

move: Added --safe option, which makes move honor numcopies settings. Also --unsafe enables the default behavior, anticipating that the default may one day change. This commit was sponsored by Ethan Aubin.
2018-04-09 16:09:00 -04:00 · 2018-04-09 16:09:00 -04:00 · af8546990d
commit af8546990d
parent ae530f043e
11 changed files with 187 additions and 74 deletions
--- a/Annex/NumCopies.hs
+++ b/Annex/NumCopies.hs
@ -11,6 +11,7 @@ module Annex.NumCopies (
 	module Types.NumCopies,
 	module Logs.NumCopies,
 	getFileNumCopies,
+	getAssociatedFileNumCopies,
 	getGlobalFileNumCopies,
 	getNumCopies,
 	deprecatedNumCopies,
@ -69,6 +70,10 @@ getFileNumCopies f = fromSources
 	, deprecatedNumCopies
 	]

+getAssociatedFileNumCopies :: AssociatedFile -> Annex NumCopies
+getAssociatedFileNumCopies (AssociatedFile afile) =
+	maybe getNumCopies getFileNumCopies afile
+
 {- This is the globally visible numcopies value for a file. So it does
 - not include local configuration in the git config or command line
 - options. -}
--- a/8
+++ b/8
@ -1,3 +1,11 @@
+git-annex (6.20180410) UNRELEASED; urgency=medium
+
+  * move: Added --safe option, which makes move honor numcopies settings.
+    Also --unsafe enables the default behavior, anticipating that the
+    default may one day change.
+
+ -- Joey Hess <id@joeyh.name>  Mon, 09 Apr 2018 14:03:28 -0400
+
 git-annex (6.20180409) upstream; urgency=medium

  * Added adb special remote which allows exporting files to Android devices.
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@ -50,7 +50,7 @@ seek o = allowConcurrentOutput $ do
 		Batch -> batchInput Right (batchCommandAction . go)
 		NoBatch -> withKeyOptions
 			(keyOptions o) (autoMode o)
-			(Command.Move.startKey (fromToOptions o) False)
+			(Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever)
 			(withFilesInGit go)
 			=<< workTreeItems (copyFiles o)

@ -59,7 +59,7 @@ seek o = allowConcurrentOutput $ do
 - sending non-preferred content. -}
 start :: CopyOptions -> FilePath -> Key -> CommandStart
 start o file key = stopUnless shouldCopy $ 
-	Command.Move.start (fromToOptions o) False file key
+	Command.Move.start (fromToOptions o) Command.Move.RemoveNever file key
  where
 	shouldCopy
 		| autoMode o = want <||> numCopiesCheck file key (<)
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@ -202,8 +202,8 @@ requiredContent = do
 {- In auto mode, only runs the action if there are enough
 - copies on other semitrusted repositories. -}
 checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
-checkDropAuto automode mremote (AssociatedFile afile) key a =
-	go =<< maybe getNumCopies getFileNumCopies afile
+checkDropAuto automode mremote afile key a =
+	go =<< getAssociatedFileNumCopies afile
  where
 	go numcopies
 		| automode = do
--- a/Command/Get.hs
+++ b/Command/Get.hs
@ -68,7 +68,7 @@ start' expensivecheck from key afile ai = onlyActionOn key $
 			Nothing -> go $ perform key afile
 			Just src ->
 				stopUnless (Command.Move.fromOk src key) $
-					go $ Command.Move.fromPerform src False key afile
+					go $ Command.Move.fromPerform src Command.Move.RemoveNever key afile
  where
 	go a = do
 		showStartKey "get" key ai
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@ -55,7 +55,7 @@ start o file k = startKey o afile k (mkActionItem afile)
 startKey :: MirrorOptions -> AssociatedFile -> Key -> ActionItem -> CommandStart
 startKey o afile key ai = onlyActionOn key $ case fromToOptions o of
 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
-		( Command.Move.toStart False afile key ai =<< getParsed r
+		( Command.Move.toStart Command.Move.RemoveNever afile key ai =<< getParsed r
 		, do
 			numcopies <- getnumcopies
 			Command.Drop.startRemote afile ai numcopies key =<< getParsed r
--- a/Command/Move.hs
+++ b/Command/Move.hs
@ -1,6 +1,6 @@
 {- git-annex command
 -
- - Copyright 2010-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}
@ -28,6 +28,7 @@ cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMat
 data MoveOptions = MoveOptions
 	{ moveFiles :: CmdParams
 	, fromToOptions :: FromToHereOptions
+	, removeWhenOptions :: RemoveWhen
 	, keyOptions :: Maybe KeyOptions
 	, batchOption :: BatchMode
 	}
@ -36,6 +37,7 @@ optParser :: CmdParamsDesc -> Parser MoveOptions
 optParser desc = MoveOptions
 	<$> cmdParams desc
 	<*> parseFromToHereOptions
+	<*> parseRemoveWhenOptions
 	<*> optional (parseKeyOptions <|> parseFailedTransfersOption)
 	<*> parseBatchOption

@ -43,64 +45,75 @@ instance DeferredParseClass MoveOptions where
 	finishParse v = MoveOptions
 		<$> pure (moveFiles v)
 		<*> finishParse (fromToOptions v)
+		<*> pure (removeWhenOptions v)
 		<*> pure (keyOptions v)
 		<*> pure (batchOption v)

+data RemoveWhen = RemoveSafe | RemoveUnsafe | RemoveNever
+	deriving (Show, Eq)
+
+parseRemoveWhenOptions :: Parser RemoveWhen
+parseRemoveWhenOptions = 
+	flag' RemoveSafe
+		( long "safe"
+		<> short 's'
+		<> help "preserve numcopies"
+		)
+	<|> flag' RemoveUnsafe
+		(long "unsafe"
+		<> short 'u'
+		<> help "do not preserve numcopies (default)"
+		)
+	<|> pure RemoveUnsafe
+
 seek :: MoveOptions -> CommandSeek
 seek o = allowConcurrentOutput $ do
-	let go = whenAnnexed $ start (fromToOptions o) True
+	let go = whenAnnexed $ start (fromToOptions o) (removeWhenOptions o)
 	case batchOption o of
 		Batch -> batchInput Right (batchCommandAction . go)
 		NoBatch -> withKeyOptions (keyOptions o) False
-			(startKey (fromToOptions o) True)
+			(startKey (fromToOptions o) (removeWhenOptions o))
 			(withFilesInGit go)
 			=<< workTreeItems (moveFiles o)

-start :: FromToHereOptions -> Bool -> FilePath -> Key -> CommandStart
-start fromto move f k = start' fromto move afile k (mkActionItem afile)
+start :: FromToHereOptions -> RemoveWhen -> FilePath -> Key -> CommandStart
+start fromto removewhen f k =
+	start' fromto removewhen afile k (mkActionItem afile)
  where
 	afile = AssociatedFile (Just f)

-startKey :: FromToHereOptions -> Bool -> Key -> ActionItem -> CommandStart
-startKey fromto move = start' fromto move (AssociatedFile Nothing)
+startKey :: FromToHereOptions -> RemoveWhen -> Key -> ActionItem -> CommandStart
+startKey fromto removewhen = start' fromto removewhen (AssociatedFile Nothing)

-start' :: FromToHereOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-start' fromto move afile key ai = onlyActionOn key $
+start' :: FromToHereOptions -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
+start' fromto removewhen afile key ai = onlyActionOn key $
 	case fromto of
 		Right (FromRemote src) ->
 			checkFailedTransferDirection ai Download $
-				fromStart move afile key ai =<< getParsed src
+				fromStart removewhen afile key ai =<< getParsed src
 		Right (ToRemote dest) ->
 			checkFailedTransferDirection ai Upload $
-				toStart move afile key ai =<< getParsed dest
+				toStart removewhen afile key ai =<< getParsed dest
 		Left ToHere ->
 			checkFailedTransferDirection ai Download $
-				toHereStart move afile key ai
+				toHereStart removewhen afile key ai

-showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
-showMoveAction move = showStartKey (if move then "move" else "copy")
+showMoveAction :: RemoveWhen -> Key -> ActionItem -> Annex ()
+showMoveAction RemoveNever = showStartKey "copy"
+showMoveAction _ = showStartKey "move"

-{- Moves (or copies) the content of an annexed file to a remote.
- -
- - If the remote already has the content, it is still removed from
- - the current repository.
- -
- - Note that unlike drop, this does not honor numcopies.
- - A file's content can be moved even if there are insufficient copies to
- - allow it to be dropped.
- -}
-toStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-toStart move afile key ai dest = do
+toStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
+toStart removewhen afile key ai dest = do
 	u <- getUUID
 	ishere <- inAnnex key
 	if not ishere || u == Remote.uuid dest
 		then stop -- not here, so nothing to do
-		else toStart' dest move afile key ai
+		else toStart' dest removewhen afile key ai

-toStart' :: Remote -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toStart' dest move afile key ai = do
+toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
+toStart' dest removewhen afile key ai = do
 	fast <- Annex.getState Annex.fast
-	if fast && not move
+	if fast && removewhen == RemoveNever
 		then ifM (expectedPresent dest key)
 			( stop
 			, go True (pure $ Right False)
@ -108,16 +121,16 @@ toStart' dest move afile key ai = do
 		else go False (Remote.hasKey dest key)
  where
 	go fastcheck isthere = do
-		showMoveAction move key ai
-		next $ toPerform dest move key afile fastcheck =<< isthere
+		showMoveAction removewhen key ai
+		next $ toPerform dest removewhen key afile fastcheck =<< isthere

 expectedPresent :: Remote -> Key -> Annex Bool
 expectedPresent dest key = do
 	remotes <- Remote.keyPossibilities key
 	return $ dest `elem` remotes

-toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
-toPerform dest move key afile fastcheck isthere =
+toPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
+toPerform dest removewhen key afile fastcheck isthere =
 	case isthere of
 		Left err -> do
 			showNote err
@ -139,18 +152,38 @@ toPerform dest move key afile fastcheck isthere =
 				Remote.logStatus dest key InfoPresent
  where
 	finish :: Annex () -> CommandPerform
-	finish setpresentremote
-		| move = lockContentForRemoval key $ \contentlock -> do
-			-- Drop content before updating location logs,
-			-- in case disk space is very low this frees up
-			-- space before writing data to disk.
-			removeAnnex contentlock
-			next $ do
-				setpresentremote
-				Command.Drop.cleanupLocal key
-		| otherwise = next $ do
+	finish setpresentremote = case removewhen of
+		RemoveNever -> do
 			setpresentremote
-			return True
+			next $ return True
+		_ -> lockContentForRemoval key $ \contentlock -> do
+			numcopies <- case removewhen of
+				RemoveUnsafe -> pure (NumCopies 1)
+				_ -> getAssociatedFileNumCopies afile
+			u <- getUUID
+			let drophere proof = do
+				liftIO $ debugM "drop" $ unwords
+					[ "Dropping from here"
+					, "proof:"
+					, show proof
+					]
+				-- Drop content before updating location logs,
+				-- in case disk space is very low this frees
+				-- up space before writing data to disk.
+				removeAnnex contentlock
+				next $ do
+					setpresentremote
+					Command.Drop.cleanupLocal key
+			let faileddrophere = do
+				warning "Not enough copies exist to drop from here (use --unsafe to avoid this check)"
+				next $ do
+					setpresentremote
+					return True
+			(tocheck, verified) <- verifiableCopies key [u]
+			verifyEnoughCopiesToDrop "" key (Just contentlock)
+				 numcopies [] verified
+				 (UnVerifiedRemote dest : tocheck)
+				 drophere faileddrophere

 {- Moves (or copies) the content of an annexed file from a remote
 - to the current repository.
@ -158,14 +191,14 @@ toPerform dest move key afile fastcheck isthere =
 - If the current repository already has the content, it is still removed
 - from the remote.
 -}
-fromStart :: Bool -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
-fromStart move afile key ai src
-	| move = go
-	| otherwise = stopUnless (not <$> inAnnex key) go
+fromStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> Remote -> CommandStart
+fromStart removewhen afile key ai src
+	| removewhen == RemoveNever = stopUnless (not <$> inAnnex key) go
+	| otherwise = go
  where
 	go = stopUnless (fromOk src key) $ do
-		showMoveAction move key ai
-		next $ fromPerform src move key afile
+		showMoveAction removewhen key ai
+		next $ fromPerform src removewhen key afile

 fromOk :: Remote -> Key -> Annex Bool
 fromOk src key = go =<< Annex.getState Annex.force
@ -181,12 +214,12 @@ fromOk src key = go =<< Annex.getState Annex.force
 		remotes <- Remote.keyPossibilities key
 		return $ u /= Remote.uuid src && elem src remotes

-fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
-fromPerform src move key afile = do
+fromPerform :: Remote -> RemoveWhen -> Key -> AssociatedFile -> CommandPerform
+fromPerform src removewhen key afile = do
 	showAction $ "from " ++ Remote.name src
 	ifM (inAnnex key)
-		( dispatch move True
-		, dispatch move =<< go
+		( dispatch removewhen True
+		, dispatch removewhen =<< go
 		)
  where
 	go = notifyTransfer Download afile $ 
@ -194,12 +227,16 @@ fromPerform src move key afile = do
 			getViaTmp (RemoteVerify src) key $ \t ->
 				Remote.retrieveKeyFile src key afile t p
 	dispatch _ False = stop -- failed
-	dispatch False True = next $ return True -- copy complete
-	-- Finish by dropping from remote, taking care to verify that
-	-- the copy here has not been lost somehow. 
-	-- (NumCopies is 1 since we're moving.)
-	dispatch True True = verifyEnoughCopiesToDrop "" key Nothing
-		(NumCopies 1) [] [] [UnVerifiedHere] dropremote faileddropremote
+	dispatch RemoveNever True = next $ return True -- copy complete
+	-- Finish move by dropping from remote, when verified 
+	-- numcopies or RemoveUnsafe allows.
+	dispatch _ True = do
+		numcopies <- case removewhen of
+			RemoveUnsafe -> pure (NumCopies 1)
+			_ -> getAssociatedFileNumCopies afile
+		(tocheck, verified) <- verifiableCopies key [Remote.uuid src]
+		verifyEnoughCopiesToDrop "" key Nothing numcopies [] verified
+			tocheck dropremote faileddropremote
 	dropremote proof = do
 		liftIO $ debugM "drop" $ unwords
 			[ "Dropping from remote"
@ -209,21 +246,26 @@ fromPerform src move key afile = do
 			]
 		ok <- Remote.removeKey src key
 		next $ Command.Drop.cleanupRemote key src ok
-	faileddropremote = giveup "Unable to drop from remote."
+	faileddropremote = case removewhen of
+		RemoveUnsafe -> giveup "Unable to drop from remote."
+		RemoveSafe -> do
+			warning "Not enough copies exist to drop from remote (use --unsafe to avoid this check)"
+			next $ return True
+		RemoveNever -> next $ return True

 {- Moves (or copies) the content of an annexed file from reachable remotes
 - to the current repository.
 -
 - When moving, the content is removed from all the reachable remotes. -}
-toHereStart ::  Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
-toHereStart move afile key ai
-	| move = go
-	| otherwise = stopUnless (not <$> inAnnex key) go
+toHereStart :: RemoveWhen -> AssociatedFile -> Key -> ActionItem -> CommandStart
+toHereStart removewhen afile key ai
+	| removewhen == RemoveNever = stopUnless (not <$> inAnnex key) go
+	| otherwise = go
  where
 	go = do
 		rs <- Remote.keyPossibilities key
 		forM_ rs $ \r ->
 			includeCommandAction $ do
-				showMoveAction move key ai
-				next $ fromPerform r move key afile
+				showMoveAction removewhen key ai
+				next $ fromPerform r removewhen key afile
 		stop
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@ -667,7 +667,7 @@ syncFile ebloom rs af k = onlyActionOn' k $ do
 		, return []
 		)
 	put dest = includeCommandAction $ 
-		Command.Move.toStart' dest False af k (mkActionItem af)
+		Command.Move.toStart' dest Command.Move.RemoveNever af k (mkActionItem af)

 {- When a remote has an export-tracking branch, change the export to
 - follow the current content of the branch. Otherwise, transfer any files
--- a/doc/bugs/move_violates_numcopies.mdwn
+++ b/doc/bugs/move_violates_numcopies.mdwn
@ -0,0 +1,25 @@
+`git annex move` does not honor numcopies. It is the only
+git-annex command to not honor numcopies by default.
+
+This can be surprising, and it complicates git-annex's story about
+attempting to preserve numcopies since there's this exception on the side.
+
+Also, `git annex move --to untrusted-repo` drops the local copy even if the
+untrusted copy is the only remaining copy, which is another unique thing
+about move.
+
+Should `git annex move --safe` become the default, and `git annex move
+--unsafe` be needed to get the current behavior? 
+
+(Note that the `-u` short option makes that easy enough to type for those
+of us who have workflows using the current behavior.)
+
+Such a change would break workflows, and potentially quite a lot of
+examples in the documentation might need to be updated. Although with the
+default numcopies=1, the move behavior would not change (except when moving
+onto an untrusted repository, ), which will limit the imact some.
+
+There could be a transition period where move warns when run w/o
+--safe/--unsafe.
+
+--[[Joey]]
--- a/doc/forum/git-annex_move_does_not_appear_to_respect_numcopies/comment_2_114cc3c9236ba930117cc14a0dddc3dd._comment
+++ b/doc/forum/git-annex_move_does_not_appear_to_respect_numcopies/comment_2_114cc3c9236ba930117cc14a0dddc3dd._comment
@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2018-04-09T17:47:38Z"
+ content="""
+You're exactly right; the move command bypasses the normal numcopies check,
+in a way that is otherwise (AFAICR) only ever done when using --force.
+
+There's also no way to get exactly the behavior of a numcopies honoring
+move. As you note copy followed by drop has that behavior, but all the
+drops then happen at the end, which is clumsy. There's clearly a good case
+for an option to make move honor numcopies if it does not by default.
+I've added that as `git annex move --safe`.
+
+I feel that the divergence from everything else in honoring numcopies by
+default is important enough to treat as a bug, so I opened
+[[bugs/move_violates_numcopies]].
+"""]]
--- a/doc/git-annex-move.mdwn
+++ b/doc/git-annex-move.mdwn
@ -10,6 +10,10 @@ git annex move `[path ...] [--from=remote|--to=remote|--to=here]`

 Moves the content of files from or to another remote.

+Note that by default, this command does not try to preserve the configured
+minimum number of copies of files. It is the only git-annex command to not
+do so.
+
 # OPTIONS

 * `--from=remote`
@ -25,6 +29,17 @@ Moves the content of files from or to another remote.
  Move the content of files from all reachable remotes to the local
  repository.

+* `--safe` `-s`
+
+  Preserve the configured minimum number of copies of files, by only
+  dropping content when there are enough other copies, and otherwise
+  only copying to the destination.
+
+* `--unsafe` `-u`
+
+  Do not preserve the configured minimum number of copies of files;
+  always move the content between repositories. Currently the default.
+
 * `--jobs=N` `-JN`

  Enables parallel transfers with up to the specified number of jobs