From 6c31e3a8c3c5ab92ca2e84b4c166f32d02a50f4f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Oct 2011 17:26:38 -0400 Subject: drop --from is now supported to remove file content from a remote. --- Command/Drop.hs | 125 ++++++++++++++++++++++++++++++++++++-------------- Command/DropUnused.hs | 5 +- Command/Move.hs | 25 ++-------- 3 files changed, 95 insertions(+), 60 deletions(-) (limited to 'Command') diff --git a/Command/Drop.hs b/Command/Drop.hs index a84d2efcc..27049fc67 100644 --- a/Command/Drop.hs +++ b/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.)" diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 1236fb823..46f2dc9f7 100644 --- a/Command/DropUnused.hs +++ b/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 diff --git a/Command/Move.hs b/Command/Move.hs index ae5e0e1d4..2a7402a0d 100644 --- a/Command/Move.hs +++ b/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 -- cgit v1.2.3