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 :: FilePath -> Key -> Annex (Bool)
dummyStore file key = return True dummyStore file key = return True
{- Just check if the .git/annex/ file for the key exists. {- 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. -}
checkKeyFile :: Key -> Annex Bool checkKeyFile :: Key -> Annex Bool
checkKeyFile k = do checkKeyFile k = inAnnex k
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)]
{- Try to find a copy of the file in one of the remotes, {- Try to find a copy of the file in one of the remotes,
- 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.withKey key remotes <- Remotes.keyPossibilities key
if (null remotes) if (null remotes)
then do then do
showNote "not available" showNote "not available"
@ -97,7 +88,6 @@ copyFromRemote r key file = do
getlocal = boolSystem "cp" ["-a", location, file] getlocal = boolSystem "cp" ["-a", location, file]
getssh = do getssh = do
liftIO $ putStrLn "" -- make way for scp progress bar liftIO $ putStrLn "" -- make way for scp progress bar
-- TODO double-shell-quote path for scp
boolSystem "scp" [sshlocation, file] boolSystem "scp" [sshlocation, file]
location = annexLocation r key location = annexLocation r key
sshlocation = (Git.urlHost r) ++ ":" ++ location sshlocation = (Git.urlHost r) ++ ":" ++ location
@ -112,7 +102,7 @@ checkRemoveKey key = do
then return True then return True
else do else do
g <- Annex.gitRepo g <- Annex.gitRepo
remotes <- Remotes.withKey key remotes <- Remotes.keyPossibilities key
let numcopies = read $ Git.configGet g config "1" let numcopies = read $ Git.configGet g config "1"
if (numcopies > length remotes) if (numcopies > length remotes)
then notEnoughCopies numcopies (length remotes) [] then notEnoughCopies numcopies (length remotes) []
@ -124,18 +114,11 @@ checkRemoveKey key = do
then return True then return True
else notEnoughCopies need have bad else notEnoughCopies need have bad
findcopies need have (r:rs) bad = do findcopies need have (r:rs) bad = do
all <- Annex.supportedBackends haskey <- Remotes.inAnnex r key
result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) case (haskey) of
case (result) of
Right True -> findcopies need (have+1) rs bad Right True -> findcopies need (have+1) rs bad
Right False -> findcopies need have rs bad Right False -> findcopies need have rs bad
Left _ -> findcopies need have rs (r: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 notEnoughCopies need have bad = do
unsafe unsafe
showLongNote $ showLongNote $

12
Core.hs
View file

@ -62,11 +62,19 @@ gitAttributes repo = do
Git.run repo ["commit", "-m", "git-annex setup", Git.run repo ["commit", "-m", "git-annex setup",
attributes] 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 -> Annex Bool
inAnnex key = do inAnnex key = do
g <- Annex.gitRepo 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. -} {- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath calcGitLink :: FilePath -> Key -> Annex FilePath

View file

@ -2,8 +2,9 @@
module Remotes ( module Remotes (
list, list,
withKey, keyPossibilities,
tryGitConfigRead tryGitConfigRead,
inAnnex
) where ) where
import Control.Exception import Control.Exception
@ -18,18 +19,19 @@ import Maybe
import Types import Types
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Annex import qualified Annex
import qualified Backend
import LocationLog import LocationLog
import Locations import Locations
import UUID import UUID
import Core import qualified Core
{- Human visible list of remotes. -} {- Human visible list of remotes. -}
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 list of remotes that the LocationLog indicate may have a key. -}
withKey :: Key -> Annex [Git.Repo] keyPossibilities :: Key -> Annex [Git.Repo]
withKey key = do keyPossibilities key = do
g <- Annex.gitRepo g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key uuids <- liftIO $ keyLocations g key
allremotes <- remotesByCost allremotes <- remotesByCost
@ -50,20 +52,35 @@ withKey key = do
let expensive = filter Git.repoIsUrl allremotes let expensive = filter Git.repoIsUrl allremotes
doexpensive <- filterM cachedUUID expensive doexpensive <- filterM cachedUUID expensive
if (not $ null doexpensive) if (not $ null doexpensive)
then showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..." then Core.showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
else return () else return ()
let todo = cheap ++ doexpensive let todo = cheap ++ doexpensive
if (not $ null todo) if (not $ null todo)
then do then do
e <- mapM tryGitConfigRead todo e <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ FlagBool True Annex.flagChange "remotesread" $ FlagBool True
withKey key keyPossibilities key
else reposByUUID allremotes uuids else reposByUUID allremotes uuids
where where
cachedUUID r = do cachedUUID r = do
u <- getUUID r u <- getUUID r
return $ null u 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. -} {- Cost Ordered list of remotes. -}
remotesByCost :: Annex [Git.Repo] remotesByCost :: Annex [Git.Repo]
remotesByCost = do remotesByCost = do