remove unused backend machinery

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.
This commit is contained in:
Joey Hess 2011-07-05 18:31:46 -04:00
parent 674768abac
commit 9f1577f746
25 changed files with 308 additions and 445 deletions

View file

@ -42,8 +42,8 @@ start pair@(file, _) = notAnnexed file $ do
perform :: BackendFile -> CommandPerform
perform (file, backend) = do
stored <- Backend.storeFileKey file backend
case stored of
k <- Backend.genKey file backend
case k of
Nothing -> stop
Just (key, _) -> do
moveAnnex key file

View file

@ -51,8 +51,8 @@ perform url file = do
if ok
then do
[(_, backend)] <- Backend.chooseBackends [file]
stored <- Backend.storeFileKey tmp backend
case stored of
k <- Backend.genKey tmp backend
case k of
Nothing -> stop
Just (key, _) -> do
moveAnnex key tmp

View file

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

View file

@ -21,7 +21,6 @@ import qualified Command.Drop
import qualified Command.Move
import qualified Remote
import qualified Git
import Backend
import Types.Key
import Utility
@ -64,9 +63,7 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
r <- Remote.byName name
showNote $ "from " ++ Remote.name r ++ "..."
next $ Command.Move.fromCleanup r True key
droplocal = do
backend <- keyBackend key
Command.Drop.perform key backend (Just 0) -- force drop
droplocal = Command.Drop.perform key (Just 0) -- force drop
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do

View file

@ -15,7 +15,6 @@ import Control.Monad (unless)
import Command
import qualified AnnexQueue
import Utility
import qualified Backend
import Content
import Messages
import Types.Key
@ -30,7 +29,7 @@ seek = [withFilesMissing start]
start :: CommandStartString
start file = notBareRepo $ do
key <- cmdlineKey
inbackend <- Backend.hasKey key
inbackend <- inAnnex key
unless inbackend $ error $
"key ("++keyName key++") is not present in backend"
showStart "fromkey" file

View file

@ -9,10 +9,15 @@ module Command.Fsck where
import Control.Monad (when)
import Control.Monad.State (liftIO)
import System.Directory
import Data.List
import System.Posix.Files
import Command
import qualified Backend
import qualified Annex
import qualified Remote
import qualified Types.Backend
import qualified Types.Key
import UUID
import Types
import Messages
@ -20,6 +25,9 @@ import Utility
import Content
import LocationLog
import Locations
import Trust
import DataUnits
import Config
command :: [Command]
command = [repoCommand "fsck" (paramOptional $ paramRepeating paramPath) seek
@ -40,7 +48,7 @@ perform key file backend numcopies = do
-- the location log is checked first, so that if it has bad data
-- that gets corrected
locationlogok <- verifyLocationLog key file
backendok <- Backend.fsckKey backend key (Just file) numcopies
backendok <- fsckKey backend key (Just file) numcopies
if locationlogok && backendok
then next $ return True
else stop
@ -80,3 +88,68 @@ verifyLocationLog key file = do
fix g u s = do
showNote "fixing location log"
logChange g key u s
{- Checks a key for problems. -}
fsckKey :: Backend Annex -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
fsckKey backend key file numcopies = do
size_ok <- checkKeySize key
copies_ok <- checkKeyNumCopies key file numcopies
backend_ok <-(Types.Backend.fsckKey backend) key
return $ size_ok && copies_ok && backend_ok
{- The size of the data for a key is checked against the size encoded in
- the key's metadata, if available. -}
checkKeySize :: Key -> Annex Bool
checkKeySize key = do
g <- Annex.gitRepo
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
case (present, Types.Key.keySize key) of
(_, Nothing) -> return True
(False, _) -> return True
(True, Just size) -> do
stat <- liftIO $ getFileStatus file
let size' = fromIntegral (fileSize stat)
if size == size'
then return True
else do
dest <- moveBad key
warning $ "Bad file size (" ++
compareSizes storageUnits True size size' ++
"); moved to " ++ dest
return False
checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do
needed <- getNumCopies numcopies
locations <- keyLocations key
untrusted <- trustGet UnTrusted
let untrustedlocations = intersect untrusted locations
let safelocations = filter (`notElem` untrusted) locations
let present = length safelocations
if present < needed
then do
ppuuids <- Remote.prettyPrintUUIDs untrustedlocations
warning $ missingNote (filename file key) present needed ppuuids
return False
else return True
where
filename Nothing k = show k
filename (Just f) _ = f
missingNote :: String -> Int -> Int -> String -> String
missingNote file 0 _ [] =
"** No known copies exist of " ++ file
missingNote file 0 _ untrusted =
"Only these untrusted locations may have copies of " ++ file ++
"\n" ++ untrusted ++
"Back it up to trusted locations with git-annex copy."
missingNote file present needed [] =
"Only " ++ show present ++ " of " ++ show needed ++
" trustworthy copies exist of " ++ file ++
"\nBack it up with git-annex copy."
missingNote file present needed untrusted =
missingNote file present needed [] ++
"\nThe following untrusted locations may also have copies: " ++
"\n" ++ untrusted

View file

@ -8,7 +8,6 @@
module Command.Get where
import Command
import qualified Backend
import qualified Annex
import qualified Remote
import Types
@ -24,7 +23,7 @@ seek :: [CommandSeek]
seek = [withFilesInGit start]
start :: CommandStartString
start file = isAnnexed file $ \(key, backend) -> do
start file = isAnnexed file $ \(key, _) -> do
inannex <- inAnnex key
if inannex
then stop
@ -32,14 +31,52 @@ start file = isAnnexed file $ \(key, backend) -> do
showStart "get" file
from <- Annex.getState Annex.fromremote
case from of
Nothing -> next $ perform key backend
Nothing -> next $ perform key
Just name -> do
src <- Remote.byName name
next $ Command.Move.fromPerform src False key
perform :: Key -> Backend Annex -> CommandPerform
perform key backend = do
ok <- getViaTmp key (Backend.retrieveKeyFile backend key)
perform :: Key -> CommandPerform
perform key = do
ok <- getViaTmp key (getKeyFile key)
if ok
then next $ return True -- no cleanup needed
else stop
{- Try to find a copy of the file in one of the remotes,
- and copy it to here. -}
getKeyFile :: Key -> FilePath -> Annex Bool
getKeyFile key file = do
remotes <- Remote.keyPossibilities key
if null remotes
then do
showNote "not available"
Remote.showLocations key []
return False
else trycopy remotes remotes
where
trycopy full [] = do
Remote.showTriedRemotes full
Remote.showLocations key []
return False
trycopy full (r:rs) = do
probablythere <- probablyPresent r
if probablythere
then docopy r (trycopy full rs)
else trycopy full rs
-- This check is to avoid an ugly message if a remote is a
-- drive that is not mounted.
probablyPresent r =
if Remote.hasKeyCheap r
then do
res <- Remote.hasKey r key
case res of
Right b -> return b
Left _ -> return False
else return True
docopy r continue = do
showNote $ "from " ++ Remote.name r ++ "..."
copied <- Remote.retrieveKeyFile r key file
if copied
then return True
else continue

View file

@ -15,6 +15,7 @@ import System.FilePath
import Command
import qualified Annex
import qualified Backend
import qualified Types.Key
import Locations
import Types
import Content
@ -32,18 +33,20 @@ start :: CommandStartBackendFile
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
exists <- inAnnex key
newbackend <- choosebackend b
upgradable <- Backend.upgradableKey oldbackend key
if (newbackend /= oldbackend || upgradable) && exists
if (newbackend /= oldbackend || upgradableKey key) && exists
then do
showStart "migrate" file
next $ perform file key newbackend
else stop
where
choosebackend Nothing = do
backends <- Backend.list
return $ head backends
choosebackend Nothing = return . head =<< Backend.orderedList
choosebackend (Just backend) = return backend
{- Checks if a key is upgradable to a newer representation. -}
{- Ideally, all keys have file size metadata. Old keys may not. -}
upgradableKey :: Key -> Bool
upgradableKey key = Types.Key.keySize key == Nothing
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do
g <- Annex.gitRepo
@ -55,9 +58,9 @@ perform file oldkey newbackend = do
let src = gitAnnexLocation g oldkey
let tmpfile = gitAnnexTmpDir g </> takeFileName file
liftIO $ createLink src tmpfile
stored <- Backend.storeFileKey tmpfile $ Just newbackend
k <- Backend.genKey tmpfile $ Just newbackend
liftIO $ cleantmp tmpfile
case stored of
case k of
Nothing -> stop
Just (newkey, _) -> do
ok <- getViaTmpUnchecked newkey $ \t -> do

View file

@ -25,6 +25,7 @@ import DataUnits
import Content
import Types.Key
import Locations
import Backend
-- a named computation that produces a statistic
type Stat = StatState (Maybe (String, StatState String))
@ -95,9 +96,8 @@ showStat s = calc =<< s
calc Nothing = return ()
supported_backends :: Stat
supported_backends = stat "supported backends" $
lift (Annex.getState Annex.supportedBackends) >>=
return . unwords . (map B.name)
supported_backends = stat "supported backends" $
return $ unwords $ map B.name Backend.list
supported_remote_types :: Stat
supported_remote_types = stat "supported remote types" $

View file

@ -13,10 +13,10 @@ import System.Directory
import System.Posix.Files
import Command
import qualified Command.Drop
import qualified Annex
import qualified AnnexQueue
import Utility
import qualified Backend
import LocationLog
import Types
import Content
@ -33,7 +33,7 @@ seek = [withFilesInGit start]
{- The unannex subcommand undoes an add. -}
start :: CommandStartString
start file = isAnnexed file $ \(key, backend) -> do
start file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
if ishere
then do
@ -46,13 +46,12 @@ start file = isAnnexed file $ \(key, backend) -> do
Annex.changeState $ \s -> s { Annex.force = True }
showStart "unannex" file
next $ perform file key backend
next $ perform file key
else stop
perform :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file key backend = do
-- force backend to always remove
ok <- Backend.removeKey backend key (Just 0)
perform :: FilePath -> Key -> CommandPerform
perform file key = do
ok <- Command.Drop.dropKey key (Just 0) -- always remove
if ok
then next $ cleanup file key
else stop

View file

@ -12,7 +12,6 @@ import System.Directory hiding (copyFile)
import Command
import qualified Annex
import qualified Backend
import Types
import Messages
import Locations
@ -38,7 +37,7 @@ start file = isAnnexed file $ \(key, _) -> do
perform :: FilePath -> Key -> CommandPerform
perform dest key = do
unlessM (Backend.hasKey key) $ error "content not present"
unlessM (inAnnex key) $ error "content not present"
checkDiskSpace key