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:
parent
674768abac
commit
9f1577f746
25 changed files with 308 additions and 445 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.)"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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" $
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue