This commit is contained in:
Joey Hess 2010-12-29 16:21:38 -04:00
parent 39d0bcb793
commit d475aac375
3 changed files with 29 additions and 21 deletions

View file

@ -16,7 +16,6 @@ module Backend.File (backend, checkKey) where
import Control.Monad.State import Control.Monad.State
import System.Directory import System.Directory
import Data.List (intersect)
import TypeInternals import TypeInternals
import LocationLog import LocationLog
@ -50,7 +49,8 @@ dummyStore _ _ = return True
- and copy it over to this one. -} - and copy it over to this one. -}
copyKeyFile :: Key -> FilePath -> Annex Bool copyKeyFile :: Key -> FilePath -> Annex Bool
copyKeyFile key file = do copyKeyFile key file = do
remotes <- Remotes.keyPossibilities key (trusted, untrusted) <- Remotes.keyPossibilities key
let remotes = trusted ++ untrusted
if null remotes if null remotes
then do then do
showNote "not available" showNote "not available"
@ -92,16 +92,11 @@ checkRemoveKey key numcopiesM = do
if force || numcopiesM == Just 0 if force || numcopiesM == Just 0
then return True then return True
else do else do
g <- Annex.gitRepo (trusted, untrusted) <- Remotes.keyPossibilities key
locations <- liftIO $ keyLocations g key
trusted <- getTrusted
let trustedcopies = length $ intersect locations trusted
remotes <- Remotes.keyPossibilities key
untrustedremotes <- reposWithoutUUID remotes trusted
numcopies <- getNumCopies numcopiesM numcopies <- getNumCopies numcopiesM
if numcopies > length untrustedremotes if numcopies > length untrusted
then notEnoughCopies numcopies (length untrustedremotes) [] then notEnoughCopies numcopies (length untrusted) []
else findcopies numcopies trustedcopies untrustedremotes [] else findcopies numcopies (length trusted) untrusted []
where where
findcopies need have [] bad findcopies need have [] bad
| have >= need = return True | have >= need = return True

View file

@ -110,8 +110,8 @@ toCleanup move remote key tmpfile = do
fromStart :: Bool -> SubCmdStartString fromStart :: Bool -> SubCmdStartString
fromStart move file = isAnnexed file $ \(key, _) -> do fromStart move file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote remote <- Remotes.commandLineRemote
l <- Remotes.keyPossibilities key (trusted, untrusted) <- Remotes.keyPossibilities key
if null $ filter (\r -> Remotes.same r remote) l if null $ filter (\r -> Remotes.same r remote) (trusted ++ untrusted)
then return Nothing then return Nothing
else do else do
showAction move file showAction move file

View file

@ -24,7 +24,7 @@ import qualified Data.Map as Map
import Data.String.Utils import Data.String.Utils
import System.Directory hiding (copyFile) import System.Directory hiding (copyFile)
import System.Posix.Directory import System.Posix.Directory
import Data.List import Data.List (intersect, sortBy)
import Control.Monad (when, unless, filterM) import Control.Monad (when, unless, filterM)
import Types import Types
@ -43,11 +43,11 @@ import qualified SysConfig
list :: [Git.Repo] -> String list :: [Git.Repo] -> String
list remotes = join ", " $ map Git.repoDescribe remotes list remotes = join ", " $ map Git.repoDescribe remotes
{- Cost ordered list of remotes that the LocationLog indicate may have a key. -} {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
keyPossibilities :: Key -> Annex [Git.Repo] - The first list is of remotes that are trusted to have the key; the
- second is of untrusted remotes that may have the key. -}
keyPossibilities :: Key -> Annex ([Git.Repo], [Git.Repo])
keyPossibilities key = do keyPossibilities key = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
allremotes <- remotesByCost allremotes <- remotesByCost
-- To determine if a remote has a key, its UUID needs to be known. -- To determine if a remote has a key, its UUID needs to be known.
-- The locally cached UUIDs of remotes can fall out of date if -- The locally cached UUIDs of remotes can fall out of date if
@ -56,7 +56,7 @@ keyPossibilities key = do
-- sure we only do it once per git-annex run. -- sure we only do it once per git-annex run.
remotesread <- Annex.flagIsSet "remotesread" remotesread <- Annex.flagIsSet "remotesread"
if remotesread if remotesread
then reposByUUID allremotes uuids then partition allremotes
else do else do
-- We assume that it's cheap to read the config -- We assume that it's cheap to read the config
-- of non-URL remotes, so that is done each time. -- of non-URL remotes, so that is done each time.
@ -74,11 +74,24 @@ keyPossibilities key = do
_ <- mapM tryGitConfigRead todo _ <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ FlagBool True Annex.flagChange "remotesread" $ FlagBool True
keyPossibilities key keyPossibilities key
else reposByUUID allremotes uuids else partition allremotes
where where
cachedUUID r = do cachedUUID r = do
u <- getUUID r u <- getUUID r
return $ null u return $ null u
partition allremotes = do
g <- Annex.gitRepo
validuuids <- liftIO $ keyLocations g key
alltrusted <- getTrusted
-- get uuids trusted to have the key
-- note that validuuids is assumed to not have dups
let validtrusted = intersect validuuids alltrusted
-- remotes that match uuids that have the key
validremotes <- reposByUUID allremotes validuuids
-- partition out the trusted and untrusted remotes
trustedremotes <- reposByUUID validremotes validtrusted
untrustedremotes <- reposWithoutUUID validremotes alltrusted
return (trustedremotes, untrustedremotes)
{- Checks if a given remote has the content for a key inAnnex. {- Checks if a given remote has the content for a key inAnnex.
- If the remote cannot be accessed, returns a Left error. - If the remote cannot be accessed, returns a Left error.