reorg remote key presense checking code

Also, it now checks if a key is inAnnex, ie, cached in .git/annex, not if
it is present in a remote. For the File Backend, these are equivilant, not
so for other backends.
This commit is contained in:
Joey Hess 2010-10-23 13:18:47 -04:00
parent 5a91543be3
commit 9dfbf40d1a
3 changed files with 40 additions and 32 deletions

View file

@ -44,24 +44,15 @@ mustProvide = error "must provide this field"
dummyStore :: FilePath -> Key -> Annex (Bool)
dummyStore file key = return True
{- Just check if the .git/annex/ file for the key exists.
-
- But, if running against a remote annex, need to use ssh to do it. -}
{- Just check if the .git/annex/ file for the key exists. -}
checkKeyFile :: Key -> Annex Bool
checkKeyFile k = do
g <- Annex.gitRepo
if (not $ Git.repoIsUrl g)
then inAnnex k
else do
showNote ("checking " ++ Git.repoDescribe g ++ "...")
liftIO $ boolSystem "ssh" [Git.urlHost g,
"test -e " ++ (shellEscape $ annexLocation g k)]
checkKeyFile k = inAnnex k
{- Try to find a copy of the file in one of the remotes,
- and copy it over to this one. -}
copyKeyFile :: Key -> FilePath -> Annex (Bool)
copyKeyFile key file = do
remotes <- Remotes.withKey key
remotes <- Remotes.keyPossibilities key
if (null remotes)
then do
showNote "not available"
@ -97,7 +88,6 @@ copyFromRemote r key file = do
getlocal = boolSystem "cp" ["-a", location, file]
getssh = do
liftIO $ putStrLn "" -- make way for scp progress bar
-- TODO double-shell-quote path for scp
boolSystem "scp" [sshlocation, file]
location = annexLocation r key
sshlocation = (Git.urlHost r) ++ ":" ++ location
@ -112,7 +102,7 @@ checkRemoveKey key = do
then return True
else do
g <- Annex.gitRepo
remotes <- Remotes.withKey key
remotes <- Remotes.keyPossibilities key
let numcopies = read $ Git.configGet g config "1"
if (numcopies > length remotes)
then notEnoughCopies numcopies (length remotes) []
@ -124,18 +114,11 @@ checkRemoveKey key = do
then return True
else notEnoughCopies need have bad
findcopies need have (r:rs) bad = do
all <- Annex.supportedBackends
result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool))
case (result) of
haskey <- Remotes.inAnnex r key
case (haskey) of
Right True -> findcopies need (have+1) rs bad
Right False -> findcopies need have rs bad
Left _ -> findcopies need have rs (r:bad)
remoteHasKey remote all = do
-- To check if a remote has a key, construct a new
-- Annex monad and query its backend.
a <- Annex.new remote all
(result, _) <- Annex.run a (Backend.hasKey key)
return result
notEnoughCopies need have bad = do
unsafe
showLongNote $

12
Core.hs
View file

@ -62,11 +62,19 @@ gitAttributes repo = do
Git.run repo ["commit", "-m", "git-annex setup",
attributes]
{- Checks if a given key is currently present in the annexLocation -}
{- Checks if a given key is currently present in the annexLocation.
-
- This can be run against a remote repository to check the key there. -}
inAnnex :: Key -> Annex Bool
inAnnex key = do
g <- Annex.gitRepo
liftIO $ doesFileExist $ annexLocation g key
if (not $ Git.repoIsUrl g)
then liftIO $ doesFileExist $ annexLocation g key
else do
showNote ("checking " ++ Git.repoDescribe g ++ "...")
liftIO $ boolSystem "ssh" [Git.urlHost g,
"test -e " ++
(shellEscape $ annexLocation g key)]
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath

View file

@ -2,8 +2,9 @@
module Remotes (
list,
withKey,
tryGitConfigRead
keyPossibilities,
tryGitConfigRead,
inAnnex
) where
import Control.Exception
@ -18,18 +19,19 @@ import Maybe
import Types
import qualified GitRepo as Git
import qualified Annex
import qualified Backend
import LocationLog
import Locations
import UUID
import Core
import qualified Core
{- Human visible list of remotes. -}
list :: [Git.Repo] -> String
list remotes = join ", " $ map Git.repoDescribe remotes
{- Cost ordered list of remotes that the LocationLog indicate may have a key. -}
withKey :: Key -> Annex [Git.Repo]
withKey key = do
keyPossibilities :: Key -> Annex [Git.Repo]
keyPossibilities key = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
allremotes <- remotesByCost
@ -50,20 +52,35 @@ withKey key = do
let expensive = filter Git.repoIsUrl allremotes
doexpensive <- filterM cachedUUID expensive
if (not $ null doexpensive)
then showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
then Core.showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
else return ()
let todo = cheap ++ doexpensive
if (not $ null todo)
then do
e <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ FlagBool True
withKey key
keyPossibilities key
else reposByUUID allremotes uuids
where
cachedUUID r = do
u <- getUUID r
return $ null u
{- Checks if a given remote has the content for a key inAnnex.
-
- This is done by constructing a new Annex monad using the remote.
-
- If the remote cannot be accessed, returns a Left error.
-}
inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
inAnnex remote key = do
a <- liftIO $ Annex.new remote []
liftIO $ ((try $ check a)::IO (Either IOException Bool))
where
check a = do
(result, _) <- Annex.run a (Core.inAnnex key)
return result
{- Cost Ordered list of remotes. -}
remotesByCost :: Annex [Git.Repo]
remotesByCost = do