a3eac50fe9
The comments correctly noted that the remote could drop the key and yet False be returned due to some problem that occurred afterwards. For example, if it's a network remote, it could drop the key just as the network goes down, and so things timeout and a nonzero exit from ssh is propigated through and False returned. However... Most of the time, this scenario will not have happened. False will mean the remote was not available or could not drop the key at all. So, instead of assuming the worst, just trust the status we have. If we get it wrong, and the scenario above happened, our location log will think the remote has the key. But the remote's location log (assuming it has one) will know it dropped it, and the next sync will regain consistency. For a special remote, with no location log, our location log will be wrong, but this is no different than the situation where someone else dropped the key from the remote and we've not synced with them. The standard paranoia about not trusting the location log to be the last word about whether a remote has a key will save us from these situations. Ie, if we try to drop the file, we'll actively check the remote, and determine the inconsistency then.
140 lines
4.9 KiB
Haskell
140 lines
4.9 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.byNameWithUUID $ \from ->
|
|
withFilesInGit $ whenAnnexed $ start from]
|
|
|
|
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
|
|
start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
|
|
stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just file)) $
|
|
case from of
|
|
Nothing -> startLocal file numcopies key Nothing
|
|
Just remote -> do
|
|
u <- getUUID
|
|
if Remote.uuid remote == u
|
|
then startLocal file numcopies key Nothing
|
|
else startRemote file numcopies key remote
|
|
|
|
startLocal :: FilePath -> Maybe Int -> Key -> Maybe Remote -> CommandStart
|
|
startLocal file numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
|
|
showStart "drop" file
|
|
next $ performLocal key numcopies knownpresentremote
|
|
|
|
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 -> Maybe Remote -> CommandPerform
|
|
performLocal key numcopies knownpresentremote = lockContent key $ do
|
|
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
|
|
let trusteduuids' = case knownpresentremote of
|
|
Nothing -> trusteduuids
|
|
Just r -> nub (Remote.uuid r:trusteduuids)
|
|
untrusteduuids <- trustGet UnTrusted
|
|
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
|
|
stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do
|
|
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
|
|
when ok $
|
|
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 missing have []
|
|
| length have >= need = return True
|
|
| otherwise = notEnoughCopies key need have (skip++missing) bad
|
|
helper bad missing 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 missing (u:have) rs
|
|
(False, Left _) -> helper (r:bad) missing have rs
|
|
(False, Right False) -> helper bad (u:missing) have rs
|
|
_ -> helper bad missing 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)
|
|
"Rather than dropping this file, try using: git annex move"
|
|
hint
|
|
return False
|
|
where
|
|
unsafe = showNote "unsafe"
|
|
hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
|