git-annex/Command/Drop.hs
Joey Hess f7f34d2072 drop unwanted content in the transfer scan
This was complicated quite a bit by needing to check numcopies. I optimised
that, so it only looks up numcopies once per file, no matter how many
remotes it checks to drop from. Although it did just occur to me that
it might be better to first check if it wants to drop content, and only
then check numcopies..
2012-10-18 15:07:11 -04:00

137 lines
4.6 KiB
Haskell

{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Drop where
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
import qualified Option
import Annex.Wanted
def :: [Command]
def = [withOptions [fromOption] $ command "drop" paramPaths seek
"indicate content of files not currently wanted"]
fromOption :: Option
fromOption = Option.field ['f'] "from" paramRemote "drop content from a remote"
seek :: [CommandSeek]
seek = [withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $
case from of
Nothing -> startLocal file numcopies key
Just remote -> do
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 = stopUnless (inAnnex key) $ do
showStart "drop" file
next $ performLocal key numcopies
startRemote :: FilePath -> Maybe Int -> Key -> Remote -> CommandStart
startRemote file numcopies key remote = do
showStart ("drop " ++ Remote.name remote) file
next $ performRemote key numcopies remote
performLocal :: Key -> Maybe Int -> CommandPerform
performLocal key numcopies = lockContent key $ do
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
untrusteduuids <- trustGet UnTrusted
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
stopUnless (canDropKey key numcopies trusteduuids tocheck []) $ do
whenM (inAnnex key) $ removeAnnex key
next $ cleanupLocal key
performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
performRemote key numcopies remote = lockContent key $ 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)
stopUnless (canDropKey key numcopies have tocheck [uuid]) $ do
ok <- Remote.removeKey remote key
next $ cleanupRemote key remote ok
where
uuid = Remote.uuid remote
cleanupLocal :: Key -> CommandCleanup
cleanupLocal key = do
logStatus key InfoMissing
return True
cleanupRemote :: Key -> Remote -> Bool -> CommandCleanup
cleanupRemote key remote ok = do
-- 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.logStatus remote key InfoMissing
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] -> [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
need <- getNumCopies numcopiesM
findCopies key need skip have check
findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
findCopies key need skip = helper []
where
helper bad have []
| length have >= need = return True
| 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) -> helper bad (u:have) rs
(False, Left _) -> helper (r:bad) have rs
_ -> helper bad have rs
notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> 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.)"