diff options
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.)" |