summaryrefslogtreecommitdiff
path: root/Command/Drop.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-05 18:31:46 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-05 19:57:46 -0400
commit9f1577f74684d8d627e75d3021eb1ff50ef7492f (patch)
tree840a7331189550e93a2ea684bceeb97b4c05b1aa /Command/Drop.hs
parent674768abac3efb2646479c6afba76d9ff27fd802 (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.hs60
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.)"