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

@ -34,7 +34,6 @@ type Annex = StateT AnnexState IO
data AnnexState = AnnexState data AnnexState = AnnexState
{ repo :: Git.Repo { repo :: Git.Repo
, backends :: [Backend Annex] , backends :: [Backend Annex]
, supportedBackends :: [Backend Annex]
, remotes :: [Remote Annex] , remotes :: [Remote Annex]
, repoqueue :: Queue , repoqueue :: Queue
, quiet :: Bool , quiet :: Bool
@ -52,12 +51,11 @@ data AnnexState = AnnexState
, cipher :: Maybe Cipher , cipher :: Maybe Cipher
} }
newState :: [Backend Annex] -> Git.Repo -> AnnexState newState :: Git.Repo -> AnnexState
newState allbackends gitrepo = AnnexState newState gitrepo = AnnexState
{ repo = gitrepo { repo = gitrepo
, backends = [] , backends = []
, remotes = [] , remotes = []
, supportedBackends = allbackends
, repoqueue = empty , repoqueue = empty
, quiet = False , quiet = False
, force = False , force = False
@ -75,9 +73,8 @@ newState allbackends gitrepo = AnnexState
} }
{- Create and returns an Annex state object for the specified git repo. -} {- Create and returns an Annex state object for the specified git repo. -}
new :: Git.Repo -> [Backend Annex] -> IO AnnexState new :: Git.Repo -> IO AnnexState
new gitrepo allbackends = new gitrepo = newState `liftM` (liftIO . Git.configRead) gitrepo
newState allbackends `liftM` (liftIO . Git.configRead) gitrepo
{- performs an action in the Annex monad -} {- performs an action in the Annex monad -}
run :: AnnexState -> Annex a -> IO (a, AnnexState) run :: AnnexState -> Annex a -> IO (a, AnnexState)

View file

@ -1,16 +1,4 @@
{- git-annex key-value storage backends {- git-annex key/value backends
-
- git-annex uses a key-value abstraction layer to allow files contents to be
- stored in different ways. In theory, any key-value storage system could be
- used to store the file contents, and git-annex would then retrieve them
- as needed and put them in `.git/annex/`.
-
- When a file is annexed, a key is generated from its content and/or metadata.
- This key can later be used to retrieve the file's content (its value). This
- key generation must be stable for a given file content, name, and size.
-
- Multiple pluggable backends are supported, and more than one can be used
- to store different files' contents in a given repository.
- -
- Copyright 2010 Joey Hess <joey@kitenet.net> - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
@ -19,15 +7,10 @@
module Backend ( module Backend (
list, list,
storeFileKey, orderedList,
retrieveKeyFile, genKey,
removeKey,
hasKey,
fsckKey,
upgradableKey,
lookupFile, lookupFile,
chooseBackends, chooseBackends,
keyBackend,
lookupBackendName, lookupBackendName,
maybeLookupBackendName maybeLookupBackendName
) where ) where
@ -36,7 +19,6 @@ import Control.Monad.State (liftIO, when)
import System.IO.Error (try) import System.IO.Error (try)
import System.FilePath import System.FilePath
import System.Posix.Files import System.Posix.Files
import System.Directory
import Locations import Locations
import qualified Git import qualified Git
@ -45,12 +27,20 @@ import Types
import Types.Key import Types.Key
import qualified Types.Backend as B import qualified Types.Backend as B
import Messages import Messages
import Content
import DataUnits -- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM
import qualified Backend.SHA
list :: [Backend Annex]
list = concat
[ Backend.WORM.backends
, Backend.SHA.backends
]
{- List of backends in the order to try them when storing a new key. -} {- List of backends in the order to try them when storing a new key. -}
list :: Annex [Backend Annex] orderedList :: Annex [Backend Annex]
list = do orderedList = do
l <- Annex.getState Annex.backends -- list is cached here l <- Annex.getState Annex.backends -- list is cached here
if not $ null l if not $ null l
then return l then return l
@ -59,92 +49,49 @@ list = do
d <- Annex.getState Annex.forcebackend d <- Annex.getState Annex.forcebackend
handle d s handle d s
where where
parseBackendList l [] = l parseBackendList [] = list
parseBackendList bs s = map (lookupBackendName bs) $ words s parseBackendList s = map lookupBackendName $ words s
handle Nothing s = return s handle Nothing s = return s
handle (Just "") s = return s handle (Just "") s = return s
handle (Just name) s = do handle (Just name) s = do
bs <- Annex.getState Annex.supportedBackends let l' = (lookupBackendName name):s
let l' = (lookupBackendName bs name):s
Annex.changeState $ \state -> state { Annex.backends = l' } Annex.changeState $ \state -> state { Annex.backends = l' }
return l' return l'
getstandard = do getstandard = do
bs <- Annex.getState Annex.supportedBackends
g <- Annex.gitRepo g <- Annex.gitRepo
return $ parseBackendList bs $ return $ parseBackendList $
Git.configGet g "annex.backends" "" Git.configGet g "annex.backends" ""
{- Looks up a backend in a list. May fail if unknown. -} {- Generates a key for a file, trying each backend in turn until one
lookupBackendName :: [Backend Annex] -> String -> Backend Annex - accepts it. -}
lookupBackendName bs s = maybe unknown id $ maybeLookupBackendName bs s genKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
where genKey file trybackend = do
unknown = error $ "unknown backend " ++ s bs <- orderedList
maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
maybeLookupBackendName bs s =
if 1 /= length matches
then Nothing
else Just $ head matches
where matches = filter (\b -> s == B.name b) bs
{- Attempts to store a file in one of the backends. -}
storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
storeFileKey file trybackend = do
bs <- list
let bs' = maybe bs (:bs) trybackend let bs' = maybe bs (:bs) trybackend
storeFileKey' bs' file genKey' bs' file
storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex)) genKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
storeFileKey' [] _ = return Nothing genKey' [] _ = return Nothing
storeFileKey' (b:bs) file = maybe nextbackend store =<< (B.getKey b) file genKey' (b:bs) file = do
where r <- (B.getKey b) file
nextbackend = storeFileKey' bs file case r of
store key = do Nothing -> genKey' bs file
stored <- (B.storeFileKey b) file key Just k -> return $ Just (k, b)
if (not stored)
then nextbackend
else return $ Just (key, b)
{- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -}
retrieveKeyFile :: Backend Annex -> Key -> FilePath -> Annex Bool
retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
{- Removes a key from a backend. -}
removeKey :: Backend Annex -> Key -> Maybe Int -> Annex Bool
removeKey backend key numcopies = (B.removeKey backend) key numcopies
{- Checks if a key is present in its backend. -}
hasKey :: Key -> Annex Bool
hasKey key = do
backend <- keyBackend key
(B.hasKey backend) key
{- 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
backend_ok <-(B.fsckKey backend) key file numcopies
return $ size_ok && backend_ok
{- Checks if a key is upgradable to a newer representation. -}
upgradableKey :: Backend Annex -> Key -> Annex Bool
upgradableKey backend key = (B.upgradableKey backend) key
{- Looks up the key and backend corresponding to an annexed file, {- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -} - by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex)) lookupFile :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile file = do lookupFile file = do
bs <- Annex.getState Annex.supportedBackends
tl <- liftIO $ try getsymlink tl <- liftIO $ try getsymlink
case tl of case tl of
Left _ -> return Nothing Left _ -> return Nothing
Right l -> makekey bs l Right l -> makekey l
where where
getsymlink = do getsymlink = do
l <- readSymbolicLink file l <- readSymbolicLink file
return $ takeFileName l return $ takeFileName l
makekey bs l = maybe (return Nothing) (makeret bs l) (fileKey l) makekey l = maybe (return Nothing) (makeret l) (fileKey l)
makeret bs l k = makeret l k =
case maybeLookupBackendName bs bname of case maybeLookupBackendName bname of
Just backend -> return $ Just (k, backend) Just backend -> return $ Just (k, backend)
Nothing -> do Nothing -> do
when (isLinkToAnnex l) $ when (isLinkToAnnex l) $
@ -164,37 +111,20 @@ chooseBackends fs = do
forced <- Annex.getState Annex.forcebackend forced <- Annex.getState Annex.forcebackend
if forced /= Nothing if forced /= Nothing
then do then do
l <- list l <- orderedList
return $ map (\f -> (f, Just $ head l)) fs return $ map (\f -> (f, Just $ head l)) fs
else do else do
bs <- Annex.getState Annex.supportedBackends
pairs <- liftIO $ Git.checkAttr g "annex.backend" fs pairs <- liftIO $ Git.checkAttr g "annex.backend" fs
return $ map (\(f,b) -> (f, maybeLookupBackendName bs b)) pairs return $ map (\(f,b) -> (f, maybeLookupBackendName b)) pairs
{- Returns the backend to use for a key. -} {- Looks up a backend by name. May fail if unknown. -}
keyBackend :: Key -> Annex (Backend Annex) lookupBackendName :: String -> Backend Annex
keyBackend key = do lookupBackendName s = maybe unknown id $ maybeLookupBackendName s
bs <- Annex.getState Annex.supportedBackends where
return $ lookupBackendName bs $ keyBackendName key unknown = error $ "unknown backend " ++ s
maybeLookupBackendName :: String -> Maybe (Backend Annex)
{- The size of the data for a key is checked against the size encoded in maybeLookupBackendName s =
- the key's metadata, if available. -} if 1 /= length matches
checkKeySize :: Key -> Annex Bool then Nothing
checkKeySize key = do else Just $ head matches
g <- Annex.gitRepo where matches = filter (\b -> s == B.name b) list
let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
case (present, 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

View file

@ -1,220 +0,0 @@
{- git-annex pseudo-backend
-
- This backend does not really do any independant data storage,
- it relies on the file contents in .git/annex/ in this repo,
- and other accessible repos.
-
- This is an abstract backend; name, getKey and fsckKey have to be implemented
- to complete it.
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Backend.File (backend, checkKey) where
import Data.List
import Data.String.Utils
import Types.Backend
import LocationLog
import qualified Remote
import qualified Git
import Content
import qualified Annex
import Types
import UUID
import Messages
import Trust
import Types.Key
backend :: Backend Annex
backend = Backend {
name = mustProvide,
getKey = mustProvide,
storeFileKey = dummyStore,
retrieveKeyFile = copyKeyFile,
removeKey = checkRemoveKey,
hasKey = inAnnex,
fsckKey = checkKeyOnly,
upgradableKey = checkUpgradableKey
}
mustProvide :: a
mustProvide = error "must provide this field"
{- Storing a key is a no-op. -}
dummyStore :: FilePath -> Key -> Annex Bool
dummyStore _ _ = return True
{- Try to find a copy of the file in one of the remotes,
- and copy it to here. -}
copyKeyFile :: Key -> FilePath -> Annex Bool
copyKeyFile key file = do
remotes <- Remote.keyPossibilities key
if null remotes
then do
showNote "not available"
showLocations key []
return False
else trycopy remotes remotes
where
trycopy full [] = do
showTriedRemotes full
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
{- 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. -}
checkRemoveKey :: Key -> Maybe Int -> Annex Bool
checkRemoveKey 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"
showTriedRemotes bad
showLocations key have
hint
return False
unsafe = showNote "unsafe"
hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)"
showLocations :: Key -> [UUID] -> Annex ()
showLocations key exclude = do
g <- Annex.gitRepo
u <- getUUID g
uuids <- keyLocations key
untrusteduuids <- trustGet UnTrusted
let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
ppuuidswanted <- Remote.prettyPrintUUIDs uuidswanted
ppuuidsskipped <- Remote.prettyPrintUUIDs uuidsskipped
showLongNote $ message ppuuidswanted ppuuidsskipped
where
filteruuids list x = filter (`notElem` x) list
message [] [] = "No other repository is known to contain the file."
message rs [] = "Try making some of these repositories available:\n" ++ rs
message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
message rs us = message rs [] ++ message [] us
showTriedRemotes :: [Remote.Remote Annex] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++
(join ", " $ map Remote.name remotes)
{- If a value is specified, it is used; otherwise the default is looked up
- in git config. forcenumcopies overrides everything. -}
getNumCopies :: Maybe Int -> Annex Int
getNumCopies v =
Annex.getState Annex.forcenumcopies >>= maybe (use v) (return . id)
where
use (Just n) = return n
use Nothing = do
g <- Annex.gitRepo
return $ read $ Git.configGet g config "1"
config = "annex.numcopies"
{- Ideally, all keys have file size metadata. Old keys may not. -}
checkUpgradableKey :: Key -> Annex Bool
checkUpgradableKey key
| keySize key == Nothing = return True
| otherwise = return False
{- This is used to check that numcopies is satisfied for the key on fsck.
- This trusts data in the the location log, and so can check all keys, even
- those with data not present in the current annex.
-
- The passed action is first run to allow backends deriving this one
- to do their own checks.
-}
checkKey :: (Key -> Annex Bool) -> Key -> Maybe FilePath -> Maybe Int -> Annex Bool
checkKey a key file numcopies = do
a_ok <- a key
copies_ok <- checkKeyNumCopies key file numcopies
return $ a_ok && copies_ok
checkKeyOnly :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool
checkKeyOnly = checkKey (\_ -> return True)
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

@ -16,7 +16,6 @@ import Data.Maybe
import System.Posix.Files import System.Posix.Files
import System.FilePath import System.FilePath
import qualified Backend.File
import Messages import Messages
import qualified Annex import qualified Annex
import Locations import Locations
@ -42,10 +41,10 @@ genBackend size
| shaCommand size == Nothing = Nothing | shaCommand size == Nothing = Nothing
| otherwise = Just b | otherwise = Just b
where where
b = Backend.File.backend b = Types.Backend.Backend
{ name = shaName size { name = shaName size
, getKey = keyValue size , getKey = keyValue size
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size , fsckKey = checkKeyChecksum size
} }
genBackendE :: SHASize -> Maybe (Backend Annex) genBackendE :: SHASize -> Maybe (Backend Annex)

View file

@ -11,7 +11,6 @@ import Control.Monad.State
import System.FilePath import System.FilePath
import System.Posix.Files import System.Posix.Files
import qualified Backend.File
import Types.Backend import Types.Backend
import Types import Types
import Types.Key import Types.Key
@ -20,9 +19,10 @@ backends :: [Backend Annex]
backends = [backend] backends = [backend]
backend :: Backend Annex backend :: Backend Annex
backend = Backend.File.backend { backend = Types.Backend.Backend {
name = "WORM", name = "WORM",
getKey = keyValue getKey = keyValue,
fsckKey = const (return True)
} }
{- The key includes the file size, modification time, and the {- The key includes the file size, modification time, and the

View file

@ -1,19 +0,0 @@
{- git-annex backend list
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module BackendList (allBackends) where
-- When adding a new backend, import it here and add it to the list.
import qualified Backend.WORM
import qualified Backend.SHA
import Types
allBackends :: [Backend Annex]
allBackends = concat
[ Backend.WORM.backends
, Backend.SHA.backends
]

View file

@ -22,7 +22,6 @@ import qualified Git
import Content import Content
import Types import Types
import Command import Command
import BackendList
import Version import Version
import Options import Options
import Messages import Messages
@ -32,7 +31,7 @@ import UUID
dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO () dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO ()
dispatch args cmds options header gitrepo = do dispatch args cmds options header gitrepo = do
setupConsole setupConsole
state <- Annex.new gitrepo allBackends state <- Annex.new gitrepo
(actions, state') <- Annex.run state $ parseCmd args header cmds options (actions, state') <- Annex.run state $ parseCmd args header cmds options
tryRun state' $ [startup] ++ actions ++ [shutdown] tryRun state' $ [startup] ++ actions ++ [shutdown]

View file

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

View file

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

View file

@ -8,12 +8,15 @@
module Command.Drop where module Command.Drop where
import Command import Command
import qualified Backend import qualified Remote
import qualified Annex
import LocationLog import LocationLog
import Types import Types
import Content import Content
import Messages import Messages
import Utility import Utility
import Trust
import Config
command :: [Command] command :: [Command]
command = [repoCommand "drop" paramPath seek 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 {- Indicates a file's content is not wanted anymore, and should be removed
- if it's safe to do so. -} - if it's safe to do so. -}
start :: CommandStartAttrFile start :: CommandStartAttrFile
start (file, attr) = isAnnexed file $ \(key, backend) -> do start (file, attr) = isAnnexed file $ \(key, _) -> do
inbackend <- Backend.hasKey key present <- inAnnex key
if inbackend if present
then do then do
showStart "drop" file showStart "drop" file
next $ perform key backend numcopies next $ perform key numcopies
else stop else stop
where where
numcopies = readMaybe attr :: Maybe Int numcopies = readMaybe attr :: Maybe Int
perform :: Key -> Backend Annex -> Maybe Int -> CommandPerform perform :: Key -> Maybe Int -> CommandPerform
perform key backend numcopies = do perform key numcopies = do
success <- Backend.removeKey backend key numcopies success <- dropKey key numcopies
if success if success
then next $ cleanup key then next $ cleanup key
else stop else stop
@ -47,3 +50,44 @@ cleanup key = do
whenM (inAnnex key) $ removeAnnex key whenM (inAnnex key) $ removeAnnex key
logStatus key InfoMissing logStatus key InfoMissing
return True 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 Command.Move
import qualified Remote import qualified Remote
import qualified Git import qualified Git
import Backend
import Types.Key import Types.Key
import Utility import Utility
@ -64,9 +63,7 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
r <- Remote.byName name r <- Remote.byName name
showNote $ "from " ++ Remote.name r ++ "..." showNote $ "from " ++ Remote.name r ++ "..."
next $ Command.Move.fromCleanup r True key next $ Command.Move.fromCleanup r True key
droplocal = do droplocal = Command.Drop.perform key (Just 0) -- force drop
backend <- keyBackend key
Command.Drop.perform key backend (Just 0) -- force drop
performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform performOther :: (Git.Repo -> Key -> FilePath) -> Key -> CommandPerform
performOther filespec key = do performOther filespec key = do

View file

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

View file

@ -9,10 +9,15 @@ module Command.Fsck where
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import System.Directory
import Data.List
import System.Posix.Files
import Command import Command
import qualified Backend
import qualified Annex import qualified Annex
import qualified Remote
import qualified Types.Backend
import qualified Types.Key
import UUID import UUID
import Types import Types
import Messages import Messages
@ -20,6 +25,9 @@ import Utility
import Content import Content
import LocationLog import LocationLog
import Locations import Locations
import Trust
import DataUnits
import Config
command :: [Command] command :: [Command]
command = [repoCommand "fsck" (paramOptional $ paramRepeating paramPath) seek 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 -- the location log is checked first, so that if it has bad data
-- that gets corrected -- that gets corrected
locationlogok <- verifyLocationLog key file locationlogok <- verifyLocationLog key file
backendok <- Backend.fsckKey backend key (Just file) numcopies backendok <- fsckKey backend key (Just file) numcopies
if locationlogok && backendok if locationlogok && backendok
then next $ return True then next $ return True
else stop else stop
@ -80,3 +88,68 @@ verifyLocationLog key file = do
fix g u s = do fix g u s = do
showNote "fixing location log" showNote "fixing location log"
logChange g key u s 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 module Command.Get where
import Command import Command
import qualified Backend
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
import Types import Types
@ -24,7 +23,7 @@ seek :: [CommandSeek]
seek = [withFilesInGit start] seek = [withFilesInGit start]
start :: CommandStartString start :: CommandStartString
start file = isAnnexed file $ \(key, backend) -> do start file = isAnnexed file $ \(key, _) -> do
inannex <- inAnnex key inannex <- inAnnex key
if inannex if inannex
then stop then stop
@ -32,14 +31,52 @@ start file = isAnnexed file $ \(key, backend) -> do
showStart "get" file showStart "get" file
from <- Annex.getState Annex.fromremote from <- Annex.getState Annex.fromremote
case from of case from of
Nothing -> next $ perform key backend Nothing -> next $ perform key
Just name -> do Just name -> do
src <- Remote.byName name src <- Remote.byName name
next $ Command.Move.fromPerform src False key next $ Command.Move.fromPerform src False key
perform :: Key -> Backend Annex -> CommandPerform perform :: Key -> CommandPerform
perform key backend = do perform key = do
ok <- getViaTmp key (Backend.retrieveKeyFile backend key) ok <- getViaTmp key (getKeyFile key)
if ok if ok
then next $ return True -- no cleanup needed then next $ return True -- no cleanup needed
else stop 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 Command
import qualified Annex import qualified Annex
import qualified Backend import qualified Backend
import qualified Types.Key
import Locations import Locations
import Types import Types
import Content import Content
@ -32,18 +33,20 @@ start :: CommandStartBackendFile
start (file, b) = isAnnexed file $ \(key, oldbackend) -> do start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
exists <- inAnnex key exists <- inAnnex key
newbackend <- choosebackend b newbackend <- choosebackend b
upgradable <- Backend.upgradableKey oldbackend key if (newbackend /= oldbackend || upgradableKey key) && exists
if (newbackend /= oldbackend || upgradable) && exists
then do then do
showStart "migrate" file showStart "migrate" file
next $ perform file key newbackend next $ perform file key newbackend
else stop else stop
where where
choosebackend Nothing = do choosebackend Nothing = return . head =<< Backend.orderedList
backends <- Backend.list
return $ head backends
choosebackend (Just backend) = return backend 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 :: FilePath -> Key -> Backend Annex -> CommandPerform
perform file oldkey newbackend = do perform file oldkey newbackend = do
g <- Annex.gitRepo g <- Annex.gitRepo
@ -55,9 +58,9 @@ perform file oldkey newbackend = do
let src = gitAnnexLocation g oldkey let src = gitAnnexLocation g oldkey
let tmpfile = gitAnnexTmpDir g </> takeFileName file let tmpfile = gitAnnexTmpDir g </> takeFileName file
liftIO $ createLink src tmpfile liftIO $ createLink src tmpfile
stored <- Backend.storeFileKey tmpfile $ Just newbackend k <- Backend.genKey tmpfile $ Just newbackend
liftIO $ cleantmp tmpfile liftIO $ cleantmp tmpfile
case stored of case k of
Nothing -> stop Nothing -> stop
Just (newkey, _) -> do Just (newkey, _) -> do
ok <- getViaTmpUnchecked newkey $ \t -> do ok <- getViaTmpUnchecked newkey $ \t -> do

View file

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

View file

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

View file

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

View file

@ -86,3 +86,16 @@ remoteNotIgnored r = do
match a = do match a = do
n <- Annex.getState a n <- Annex.getState a
return $ n == Git.repoRemoteName r return $ n == Git.repoRemoteName r
{- If a value is specified, it is used; otherwise the default is looked up
- in git config. forcenumcopies overrides everything. -}
getNumCopies :: Maybe Int -> Annex Int
getNumCopies v =
Annex.getState Annex.forcenumcopies >>= maybe (use v) (return . id)
where
use (Just n) = return n
use Nothing = do
g <- Annex.gitRepo
return $ read $ Git.configGet g config "1"
config = "annex.numcopies"

View file

@ -14,10 +14,10 @@ module Remote (
removeKey, removeKey,
hasKey, hasKey,
hasKeyCheap, hasKeyCheap,
keyPossibilities, keyPossibilities,
keyPossibilitiesTrusted, keyPossibilitiesTrusted,
forceTrust, forceTrust,
remoteTypes, remoteTypes,
genList, genList,
byName, byName,
@ -25,6 +25,8 @@ module Remote (
remotesWithUUID, remotesWithUUID,
remotesWithoutUUID, remotesWithoutUUID,
prettyPrintUUIDs, prettyPrintUUIDs,
showTriedRemotes,
showLocations,
remoteLog, remoteLog,
readRemoteLog, readRemoteLog,
@ -40,6 +42,7 @@ import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Data.Char import Data.Char
import Data.String.Utils
import qualified Branch import qualified Branch
import Types import Types
@ -49,6 +52,7 @@ import qualified Annex
import Config import Config
import Trust import Trust
import LocationLog import LocationLog
import Messages
import qualified Remote.Git import qualified Remote.Git
import qualified Remote.S3 import qualified Remote.S3
@ -181,9 +185,34 @@ keyPossibilities' withtrusted key = do
return (sort validremotes, validtrusteduuids) return (sort validremotes, validtrusteduuids)
{- Displays known locations of a key. -}
showLocations :: Key -> [UUID] -> Annex ()
showLocations key exclude = do
g <- Annex.gitRepo
u <- getUUID g
uuids <- keyLocations key
untrusteduuids <- trustGet UnTrusted
let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
ppuuidswanted <- Remote.prettyPrintUUIDs uuidswanted
ppuuidsskipped <- Remote.prettyPrintUUIDs uuidsskipped
showLongNote $ message ppuuidswanted ppuuidsskipped
where
filteruuids l x = filter (`notElem` x) l
message [] [] = "No other repository is known to contain the file."
message rs [] = "Try making some of these repositories available:\n" ++ rs
message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
message rs us = message rs [] ++ message [] us
showTriedRemotes :: [Remote Annex] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++
(join ", " $ map name remotes)
forceTrust :: TrustLevel -> String -> Annex () forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = do forceTrust level remotename = do
r <- Remote.nameToUUID remotename r <- nameToUUID remotename
Annex.changeState $ \s -> Annex.changeState $ \s ->
s { Annex.forcetrust = (r, level):Annex.forcetrust s } s { Annex.forcetrust = (r, level):Annex.forcetrust s }

View file

@ -112,7 +112,7 @@ inAnnex r key = if Git.repoIsUrl r
checklocal = do checklocal = do
-- run a local check inexpensively, -- run a local check inexpensively,
-- by making an Annex monad using the remote -- by making an Annex monad using the remote
a <- Annex.new r [] a <- Annex.new r
Annex.eval a (Content.inAnnex key) Annex.eval a (Content.inAnnex key)
checkremote = do checkremote = do
showNote ("checking " ++ Git.repoDescribe r ++ "...") showNote ("checking " ++ Git.repoDescribe r ++ "...")
@ -142,7 +142,7 @@ copyToRemote r key
let keysrc = gitAnnexLocation g key let keysrc = gitAnnexLocation g key
-- run copy from perspective of remote -- run copy from perspective of remote
liftIO $ do liftIO $ do
a <- Annex.new r [] a <- Annex.new r
Annex.eval a $ do Annex.eval a $ do
ok <- Content.getViaTmp key $ ok <- Content.getViaTmp key $
rsyncOrCopyFile r keysrc rsyncOrCopyFile r keysrc

View file

@ -16,22 +16,8 @@ data Backend a = Backend {
name :: String, name :: String,
-- converts a filename to a key -- converts a filename to a key
getKey :: FilePath -> a (Maybe Key), getKey :: FilePath -> a (Maybe Key),
-- stores a file's contents to a key
storeFileKey :: FilePath -> Key -> a Bool,
-- retrieves a key's contents to a file
retrieveKeyFile :: Key -> FilePath -> a Bool,
-- removes a key, optionally checking that enough copies are stored
-- elsewhere
removeKey :: Key -> Maybe Int -> a Bool,
-- checks if a backend is storing the content of a key
hasKey :: Key -> a Bool,
-- called during fsck to check a key -- called during fsck to check a key
-- (second parameter may be the filename associated with it) fsckKey :: Key -> a Bool
-- (third parameter may be the number of copies that there should
-- be of the key)
fsckKey :: Key -> Maybe FilePath -> Maybe Int -> a Bool,
-- Is a newer repesentation possible for a key?
upgradableKey :: Key -> a Bool
} }
instance Show (Backend a) where instance Show (Backend a) where

View file

@ -191,17 +191,16 @@ logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex)) lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex))
lookupFile1 file = do lookupFile1 file = do
bs <- Annex.getState Annex.supportedBackends
tl <- liftIO $ try getsymlink tl <- liftIO $ try getsymlink
case tl of case tl of
Left _ -> return Nothing Left _ -> return Nothing
Right l -> makekey bs l Right l -> makekey l
where where
getsymlink = do getsymlink = do
l <- readSymbolicLink file l <- readSymbolicLink file
return $ takeFileName l return $ takeFileName l
makekey bs l = do makekey l = do
case maybeLookupBackendName bs bname of case maybeLookupBackendName bname of
Nothing -> do Nothing -> do
unless (null kname || null bname || unless (null kname || null bname ||
not (isLinkToAnnex l)) $ not (isLinkToAnnex l)) $

View file

@ -25,7 +25,6 @@ import System.Path (recurseDir)
import System.IO.HVFS (SystemFS(..)) import System.IO.HVFS (SystemFS(..))
import qualified Annex import qualified Annex
import qualified BackendList
import qualified Backend import qualified Backend
import qualified Git import qualified Git
import qualified Locations import qualified Locations
@ -483,7 +482,7 @@ annexeval :: Types.Annex a -> IO a
annexeval a = do annexeval a = do
g <- Git.repoFromCwd g <- Git.repoFromCwd
g' <- Git.configRead g g' <- Git.configRead g
s <- Annex.new g' BackendList.allBackends s <- Annex.new g'
Annex.eval s a Annex.eval s a
innewrepo :: Assertion -> Assertion innewrepo :: Assertion -> Assertion
@ -684,4 +683,4 @@ backendWORM :: Types.Backend Types.Annex
backendWORM = backend_ "WORM" backendWORM = backend_ "WORM"
backend_ :: String -> Types.Backend Types.Annex backend_ :: String -> Types.Backend Types.Annex
backend_ name = Backend.lookupBackendName BackendList.allBackends name backend_ name = Backend.lookupBackendName name