9f1577f746
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.
93 lines
2.6 KiB
Haskell
93 lines
2.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 Command
|
|
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
|
|
"indicate content of files not currently wanted"]
|
|
|
|
seek :: [CommandSeek]
|
|
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, _) -> do
|
|
present <- inAnnex key
|
|
if present
|
|
then do
|
|
showStart "drop" file
|
|
next $ perform key numcopies
|
|
else stop
|
|
where
|
|
numcopies = readMaybe attr :: Maybe Int
|
|
|
|
perform :: Key -> Maybe Int -> CommandPerform
|
|
perform key numcopies = do
|
|
success <- dropKey key numcopies
|
|
if success
|
|
then next $ cleanup key
|
|
else stop
|
|
|
|
cleanup :: Key -> CommandCleanup
|
|
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.)"
|