diff options
author | Joey Hess <joey@kitenet.net> | 2011-07-05 18:31:46 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-07-05 19:57:46 -0400 |
commit | 9f1577f74684d8d627e75d3021eb1ff50ef7492f (patch) | |
tree | 840a7331189550e93a2ea684bceeb97b4c05b1aa /Command/Drop.hs | |
parent | 674768abac3efb2646479c6afba76d9ff27fd802 (diff) |
remove unused backend machinery
The only remaining vestiage of backends is different types of keys. These
are still called "backends", mostly to avoid needing to change user interface
and configuration. But everything to do with storing keys in different
backends was gone; instead different types of remotes are used.
In the refactoring, lots of code was moved out of odd corners like
Backend.File, to closer to where it's used, like Command.Drop and
Command.Fsck. Quite a lot of dead code was removed. Several data structures
became simpler, which may result in better runtime efficiency. There should
be no user-visible changes.
Diffstat (limited to 'Command/Drop.hs')
-rw-r--r-- | Command/Drop.hs | 60 |
1 files changed, 52 insertions, 8 deletions
diff --git a/Command/Drop.hs b/Command/Drop.hs index bd4740741..14f098349 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -8,12 +8,15 @@ module Command.Drop where import Command -import qualified Backend +import qualified Remote +import qualified Annex import LocationLog import Types import Content import Messages import Utility +import Trust +import Config command :: [Command] command = [repoCommand "drop" paramPath seek @@ -25,19 +28,19 @@ seek = [withAttrFilesInGit "annex.numcopies" start] {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} start :: CommandStartAttrFile -start (file, attr) = isAnnexed file $ \(key, backend) -> do - inbackend <- Backend.hasKey key - if inbackend +start (file, attr) = isAnnexed file $ \(key, _) -> do + present <- inAnnex key + if present then do showStart "drop" file - next $ perform key backend numcopies + next $ perform key numcopies else stop where numcopies = readMaybe attr :: Maybe Int -perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform -perform key backend numcopies = do - success <- Backend.removeKey backend key numcopies +perform :: Key -> Maybe Int -> CommandPerform +perform key numcopies = do + success <- dropKey key numcopies if success then next $ cleanup key else stop @@ -47,3 +50,44 @@ cleanup 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), and fails with an + - error if not. -} +dropKey :: Key -> Maybe Int -> Annex Bool +dropKey key numcopiesM = 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 [] + where + findcopies need have [] bad + | length have >= need = return True + | otherwise = notEnoughCopies need have bad + findcopies need have (r:rs) bad + | length have >= need = return True + | otherwise = do + let u = Remote.uuid r + let dup = u `elem` have + haskey <- Remote.hasKey r key + case (dup, 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 + unsafe = showNote "unsafe" + hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)" |