From 9dfbf40d1a8493ec191f8e79410ed9d2a9508141 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 23 Oct 2010 13:18:47 -0400 Subject: 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. --- Backend/File.hs | 29 ++++++----------------------- Core.hs | 12 ++++++++++-- Remotes.hs | 31 ++++++++++++++++++++++++------- 3 files changed, 40 insertions(+), 32 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index 3396db3e5..dbd067428 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -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 $ diff --git a/Core.hs b/Core.hs index 4941dc26b..da05823bb 100644 --- a/Core.hs +++ b/Core.hs @@ -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 diff --git a/Remotes.hs b/Remotes.hs index f24da2c22..13f66aae2 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -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 -- cgit v1.2.3