avoid reading configs for URL remotes every time

This commit is contained in:
Joey Hess 2010-10-22 14:28:47 -04:00
parent 46ac66a438
commit 9ec5d90b6a
4 changed files with 50 additions and 22 deletions

View file

@ -79,7 +79,7 @@ copyKeyFile key file = do
{- Tries to copy a file from a remote. -} {- Tries to copy a file from a remote. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
copyFromRemote r key file = do copyFromRemote r key file = do
if (Git.repoIsLocal r) if (not $ Git.repoIsUrl r)
then getlocal then getlocal
else if (Git.repoIsSsh r) else if (Git.repoIsSsh r)
then getssh then getssh

View file

@ -8,6 +8,7 @@ module Remotes (
import Control.Exception import Control.Exception
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Control.Monad (filterM)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.String.Utils import Data.String.Utils
import Data.Either.Utils import Data.Either.Utils
@ -20,6 +21,7 @@ import qualified Annex
import LocationLog import LocationLog
import Locations import Locations
import UUID import UUID
import Core
{- Human visible list of remotes. -} {- Human visible list of remotes. -}
list :: [Git.Repo] -> String list :: [Git.Repo] -> String
@ -31,23 +33,36 @@ withKey key = do
g <- Annex.gitRepo g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key uuids <- liftIO $ keyLocations g key
allremotes <- remotesByCost allremotes <- remotesByCost
-- This only uses cached data, so may not include new remotes -- To determine if a remote has a key, its UUID needs to be known.
-- or remotes whose uuid has changed (eg by a different drive being -- The locally cached UIIDs of remotes can fall out of date if
-- mounted at their location). So unless it happens to find all -- eg, a different drive is mounted at the same location.
-- remotes, try harder, loading the remotes' configs. -- But, reading the config of remotes can be expensive, so make
remotes <- reposByUUID allremotes uuids -- sure we only do it once per git-annex run.
remotesread <- Annex.flagIsSet "remotesread" remotesread <- Annex.flagIsSet "remotesread"
if ((length allremotes /= length remotes) && not remotesread) if (remotesread)
then tryharder allremotes uuids then reposByUUID allremotes uuids
else return remotes else do
-- We assume that it's cheap to read the config
-- of non-URL remotes, so that is done each time.
-- But reading the config of an URL remote is
-- only done when there is no cached UUID value.
let cheap = filter (not . Git.repoIsUrl) allremotes
let expensive = filter Git.repoIsUrl allremotes
doexpensive <- filterM cachedUUID expensive
if (0 < length doexpensive)
then showNote $ "getting UUIDs for " ++ (list doexpensive) ++ "..."
else return ()
let todo = cheap ++ doexpensive
if (0 < length todo)
then do
e <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ FlagBool True
withKey key
else reposByUUID allremotes uuids
where where
tryharder allremotes uuids = do cachedUUID r = do
-- more expensive; read each remote's config u <- getUUID r
eitherremotes <- mapM tryGitConfigRead allremotes return $ 0 == length u
let allremotes' = map fromEither eitherremotes
remotes' <- reposByUUID allremotes' uuids
Annex.flagChange "remotesread" $ FlagBool True
return remotes'
{- Cost Ordered list of remotes. -} {- Cost Ordered list of remotes. -}
remotesByCost :: Annex [Git.Repo] remotesByCost :: Annex [Git.Repo]
@ -55,10 +70,11 @@ remotesByCost = do
g <- Annex.gitRepo g <- Annex.gitRepo
reposByCost $ Git.remotes g reposByCost $ Git.remotes g
{- Orders a list of git repos by cost. -} {- Orders a list of git repos by cost, and throws out ignored ones. -}
reposByCost :: [Git.Repo] -> Annex [Git.Repo] reposByCost :: [Git.Repo] -> Annex [Git.Repo]
reposByCost l = do reposByCost l = do
costpairs <- mapM costpair l notignored <- filterM repoNotIgnored l
costpairs <- mapM costpair notignored
return $ fst $ unzip $ sortBy bycost $ costpairs return $ fst $ unzip $ sortBy bycost $ costpairs
where where
costpair r = do costpair r = do
@ -76,13 +92,22 @@ repoCost r = do
g <- Annex.gitRepo g <- Annex.gitRepo
if ((length $ config g r) > 0) if ((length $ config g r) > 0)
then return $ read $ config g r then return $ read $ config g r
else if (Git.repoIsLocal r) else if (Git.repoIsUrl r)
then return 100 then return 200
else return 200 else return 100
where where
config g r = Git.configGet g (configkey r) "" config g r = Git.configGet g (configkey r) ""
configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost" configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost"
{- Checks if a repo should be ignored. -}
repoNotIgnored :: Git.Repo -> Annex Bool
repoNotIgnored r = do
g <- Annex.gitRepo
return ("true" /= config g r)
where
config g r = Git.configGet g (configkey r) ""
configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-ignore"
{- The git configs for the git repo's remotes is not read on startup {- The git configs for the git repo's remotes is not read on startup
- because reading it may be expensive. This function tries to read the - because reading it may be expensive. This function tries to read the
- config for a specified remote, and updates state. If successful, it - config for a specified remote, and updates state. If successful, it
@ -95,7 +120,7 @@ tryGitConfigRead r = do
-- for other reasons; catch all possible exceptions -- for other reasons; catch all possible exceptions
result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo))) result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo)))
case (result) of case (result) of
Left err -> return $ Left r Left e -> return $ Left r
Right r' -> do Right r' -> do
g <- Annex.gitRepo g <- Annex.gitRepo
let l = Git.remotes g let l = Git.remotes g

1
debian/changelog vendored
View file

@ -1,6 +1,7 @@
git-annex (0.02) UNRELEASED; urgency=low git-annex (0.02) UNRELEASED; urgency=low
* New fromkey subcommand, for registering urls, etc. * New fromkey subcommand, for registering urls, etc.
* Can scp annexed files from remotes.
-- Joey Hess <joeyh@debian.org> Thu, 21 Oct 2010 16:38:00 -0400 -- Joey Hess <joeyh@debian.org> Thu, 21 Oct 2010 16:38:00 -0400

View file

@ -154,6 +154,8 @@ Like other git commands, git-annex is configured via `.git/config`.
repositories. Note that other factors may be configured when pushing repositories. Note that other factors may be configured when pushing
files to repositories, in particular, whether the repository is on files to repositories, in particular, whether the repository is on
a filesystem with sufficient free space. a filesystem with sufficient free space.
* `remote.<name>.annex-ignore` -- If set to "true", prevents git-annex
from ever using this remote.
* `remote.<name>.annex-uuid` -- git-annex caches UUIDs of repositories * `remote.<name>.annex-uuid` -- git-annex caches UUIDs of repositories
here. here.