drop --from is now supported to remove file content from a remote.

This commit is contained in:
Joey Hess 2011-10-28 17:26:38 -04:00
parent 33e18d3d02
commit 6c31e3a8c3
7 changed files with 114 additions and 63 deletions

View file

@ -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.)"