drop --from is now supported to remove file content from a remote.

Command/Drop.hs

@@ -11,76 +11,131 @@ import Common.Annex
 import Command
 import qualified Remote
 import qualified Annex
+import Annex.UUID
 import Logs.Location
 import Logs.Trust
 import Annex.Content
 import Config
 
 command :: [Command]
-command = [Command "drop" paramPaths defaultChecks seek
+command = [Command "drop" paramPaths (noTo >> needsRepo) seek
 	"indicate content of files not currently wanted"]
 
 seek :: [CommandSeek]
 seek = [withNumCopies start]
 
 start :: FilePath -> Maybe Int -> CommandStart
-start file numcopies = isAnnexed file $ \(key, _) -> do
+start file numcopies = isAnnexed file $ \(key, _) ->
+	autoCopies key (>) numcopies $ do
+		from <- Annex.getState Annex.fromremote
+		case from of
+			Nothing -> startLocal file numcopies key
+			Just name -> do
+				remote <- Remote.byName name
+				u <- getUUID
+				if Remote.uuid remote == u
+					then startLocal file numcopies key
+					else startRemote file numcopies key remote
+
+startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
+startLocal file numcopies key = do
 	present <- inAnnex key
 	if present
-		then autoCopies key (>) numcopies $ do
+		then do
 			showStart "drop" file
-			next $ perform key numcopies
+			next $ performLocal key numcopies
 		else stop
 
-perform :: Key -> Maybe Int -> CommandPerform
-perform key numcopies = do
-	success <- canDropKey key numcopies
+startRemote :: FilePath -> Maybe Int -> Key -> Remote.Remote Annex -> CommandStart
+startRemote file numcopies key remote = do
+	showStart "drop" file
+	next $ performRemote key numcopies remote
+
+performLocal :: Key -> Maybe Int -> CommandPerform
+performLocal key numcopies = do
+	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+	untrusteduuids <- trustGet UnTrusted
+	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
+	success <- canDropKey key numcopies trusteduuids tocheck []
 	if success
-		then next $ cleanup key
+		then next $ cleanupLocal key
 		else stop
 
-cleanup :: Key -> CommandCleanup
-cleanup key = do
+performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform
+performRemote key numcopies remote = do
+	-- Filter the remote it's being dropped from out of the lists of
+	-- places assumed to have the key, and places to check.
+	-- When the local repo has the key, that's one additional copy.
+	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
+	present <- inAnnex key
+	u <- getUUID
+	let have = filter (/= uuid) $
+		if present then u:trusteduuids else trusteduuids
+	untrusteduuids <- trustGet UnTrusted
+	let tocheck = filter (/= remote) $
+		Remote.remotesWithoutUUID remotes (have++untrusteduuids)
+	success <- canDropKey key numcopies have tocheck [uuid]
+	if success
+		then next $ cleanupRemote key remote
+		else stop
+	where
+		uuid = Remote.uuid remote
+
+cleanupLocal :: Key -> CommandCleanup
+cleanupLocal key = do
 	whenM (inAnnex key) $ removeAnnex key
 	logStatus key InfoMissing
 	return True
 
-{- Checks remotes to verify that enough copies of a key exist to allow
- - for a key to be safely removed (with no data loss). -}
-canDropKey :: Key -> Maybe Int -> Annex Bool
-canDropKey key numcopiesM = do
+cleanupRemote :: Key -> Remote.Remote Annex -> CommandCleanup
+cleanupRemote key remote = do
+	ok <- Remote.removeKey remote key
+	-- better safe than sorry: assume the remote dropped the key
+	-- even if it seemed to fail; the failure could have occurred
+	-- after it really dropped it
+	Remote.remoteHasKey remote key False
+	return ok
+
+{- Checks specified remotes to verify that enough copies of a key exist to
+ - allow it to be safely removed (with no data loss). Can be provided with
+ - some locations where the key is known/assumed to be present. -}
+canDropKey :: Key -> Maybe Int -> [UUID] -> [Remote.Remote Annex] -> [UUID] -> Annex Bool
+canDropKey key numcopiesM have check skip = do
 	force <- Annex.getState Annex.force
 	if force || numcopiesM == Just 0
 		then return True
 		else do
-			(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
-			untrusteduuids <- trustGet UnTrusted
-			let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
-			numcopies <- getNumCopies numcopiesM
-			findcopies numcopies trusteduuids tocheck []
+			need <- getNumCopies numcopiesM
+			findCopies key need skip have check
+
+findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote.Remote Annex] -> Annex Bool
+findCopies key need skip = helper []
 	where
-		findcopies need have [] bad
+		helper bad have []
 			| length have >= need = return True
-			| otherwise = notEnoughCopies need have bad
-		findcopies need have (r:rs) bad
+			| otherwise = notEnoughCopies key need have skip bad
+		helper bad have (r:rs)
 			| length have >= need = return True
 			| otherwise = do
 				let u = Remote.uuid r
 				let duplicate = u `elem` have
 				haskey <- Remote.hasKey r key
 				case (duplicate, haskey) of
-					(False, Right True)	-> findcopies need (u:have) rs bad
-					(False, Left _)		-> findcopies need have rs (r:bad)
-					_			-> findcopies need have rs bad
-		notEnoughCopies need have bad = do
-			unsafe
-			showLongNote $
-				"Could only verify the existence of " ++
-				show (length have) ++ " out of " ++ show need ++ 
-				" necessary copies"
-			Remote.showTriedRemotes bad
-			Remote.showLocations key have
-			hint
-			return False
+					(False, Right True) -> helper bad (u:have) rs
+					(False, Left _)     -> helper (r:bad) have rs
+					_                   -> helper bad have rs
+
+notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote.Remote Annex] -> Annex Bool
+notEnoughCopies key need have skip bad = do
+	unsafe
+	showLongNote $
+		"Could only verify the existence of " ++
+		show (length have) ++ " out of " ++ show need ++ 
+		" necessary copies"
+	Remote.showTriedRemotes bad
+	Remote.showLocations key (have++skip)
+	hint
+	return False
+	where
 		unsafe = showNote "unsafe"
 		hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"

Command/DropUnused.hs

@@ -13,7 +13,6 @@ import Common.Annex
 import Command
 import qualified Annex
 import qualified Command.Drop
-import qualified Command.Move
 import qualified Remote
 import qualified Git
 import Types.Key
@@ -56,8 +55,8 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
 		dropremote name = do
 			r <- Remote.byName name
 			showAction $ "from " ++ Remote.name r
-			next $ Command.Move.fromCleanup r True key
-		droplocal = Command.Drop.perform key (Just 0) -- force drop
+			next $ Command.Drop.cleanupRemote key r
+		droplocal = Command.Drop.performLocal key (Just 0) -- force drop
 
 performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do

Command/Move.hs

@@ -11,7 +11,6 @@ import Common.Annex
 import Command
 import qualified Command.Drop
 import qualified Annex
-import Logs.Location
 import Annex.Content
 import qualified Remote
 import Annex.UUID
@@ -49,18 +48,6 @@ showMoveAction :: Bool -> FilePath -> Annex ()
 showMoveAction True file = showStart "move" file
 showMoveAction False file = showStart "copy" file
 
-{- Used to log a change in a remote's having a key. The change is logged
- - in the local repo, not on the remote. The process of transferring the
- - key to the remote, or removing the key from it *may* log the change
- - on the remote, but this cannot be relied on. -}
-remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
-remoteHasKey remote key present	= do
-	let remoteuuid = Remote.uuid remote
-	g <- gitRepo
-	logChange g key remoteuuid status
-	where
-		status = if present then InfoPresent else InfoMissing
-
 {- Moves (or copies) the content of an annexed file to a remote.
  -
  - If the remote already has the content, it is still removed from
@@ -108,9 +95,9 @@ toPerform dest move key = do
 		Right True -> next $ toCleanup dest move key
 toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
 toCleanup dest move key = do
-	remoteHasKey dest key True
+	Remote.remoteHasKey dest key True
 	if move
-		then Command.Drop.cleanup key
+		then Command.Drop.cleanupLocal key
 		else return True
 
 {- Moves (or copies) the content of an annexed file from a remote
@@ -140,11 +127,5 @@ fromPerform src move key = do
 				then next $ fromCleanup src move key
 				else stop -- fail
 fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
-fromCleanup src True key = do
-	ok <- Remote.removeKey src key
-	-- better safe than sorry: assume the src dropped the key
-	-- even if it seemed to fail; the failure could have occurred
-	-- after it really dropped it
-	remoteHasKey src key False
-	return ok
+fromCleanup src True key = Command.Drop.cleanupRemote key src
 fromCleanup _ False _ = return True

Remote.hs

@@ -25,7 +25,8 @@ module Remote (
 	nameToUUID,
 	showTriedRemotes,
 	showLocations,
-	forceTrust
+	forceTrust,
+	remoteHasKey
 ) where
 
 import qualified Data.Map as M
@@ -225,3 +226,15 @@ forceTrust level remotename = do
 	r <- nameToUUID remotename
 	Annex.changeState $ \s ->
 		s { Annex.forcetrust = (r, level):Annex.forcetrust s }
+
+{- Used to log a change in a remote's having a key. The change is logged
+ - in the local repo, not on the remote. The process of transferring the
+ - key to the remote, or removing the key from it *may* log the change
+ - on the remote, but this cannot always be relied on. -}
+remoteHasKey :: Remote Annex -> Key -> Bool -> Annex ()
+remoteHasKey remote key present	= do
+	let remoteuuid = uuid remote
+	g <- gitRepo
+	logChange g key remoteuuid status
+	where
+		status = if present then InfoPresent else InfoMissing

debian/changelog

@@ -5,6 +5,7 @@ git-annex (3.20111026) UNRELEASED; urgency=low
     host.
   * uninit: Add guard against being run with the git-annex branch checked out.
   * Fail if --from or --to is passed to commands that do not support them.
+  * drop --from is now supported to remove file content from a remote.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 27 Oct 2011 13:58:53 -0400
 

doc/bugs/wishlist:_support_drop__44___find_on_special_remotes.mdwn

@@ -2,6 +2,7 @@ Currently there is no way to drop files, or list what files are available, on a
 It would be good if "git annex drop" and "git annex find" supported the --from argument.
 
 > I agree, drop should support --from.
+>> [[done]] --[[Joey]] 
 > 
 > To find files *believed* to be present in a given remote, use
 > `git annex find --in remote`

doc/git-annex.mdwn

@@ -80,8 +80,9 @@ subdirectories).
   Drops the content of annexed files from this repository. 
 
   git-annex will refuse to drop content if it cannot verify it is
-  safe to do so. At least one copy of content needs to exist in another
-  remote. This can be overridden with the --force switch.
+  safe to do so. This can be overridden with the --force switch.
+
+  To drop content from a remote, specify --from.
 
 * move [path ...]