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. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
copyFromRemote r key file = do
if (Git.repoIsLocal r)
if (not $ Git.repoIsUrl r)
then getlocal
else if (Git.repoIsSsh r)
then getssh

View file

@ -8,6 +8,7 @@ module Remotes (
import Control.Exception
import Control.Monad.State (liftIO)
import Control.Monad (filterM)
import qualified Data.Map as Map
import Data.String.Utils
import Data.Either.Utils
@ -20,6 +21,7 @@ import qualified Annex
import LocationLog
import Locations
import UUID
import Core
{- Human visible list of remotes. -}
list :: [Git.Repo] -> String
@ -31,23 +33,36 @@ withKey key = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
allremotes <- remotesByCost
-- This only uses cached data, so may not include new remotes
-- or remotes whose uuid has changed (eg by a different drive being
-- mounted at their location). So unless it happens to find all
-- remotes, try harder, loading the remotes' configs.
remotes <- reposByUUID allremotes uuids
-- To determine if a remote has a key, its UUID needs to be known.
-- The locally cached UIIDs of remotes can fall out of date if
-- eg, a different drive is mounted at the same location.
-- But, reading the config of remotes can be expensive, so make
-- sure we only do it once per git-annex run.
remotesread <- Annex.flagIsSet "remotesread"
if ((length allremotes /= length remotes) && not remotesread)
then tryharder allremotes uuids
else return remotes
if (remotesread)
then reposByUUID allremotes uuids
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
tryharder allremotes uuids = do
-- more expensive; read each remote's config
eitherremotes <- mapM tryGitConfigRead allremotes
let allremotes' = map fromEither eitherremotes
remotes' <- reposByUUID allremotes' uuids
Annex.flagChange "remotesread" $ FlagBool True
return remotes'
cachedUUID r = do
u <- getUUID r
return $ 0 == length u
{- Cost Ordered list of remotes. -}
remotesByCost :: Annex [Git.Repo]
@ -55,10 +70,11 @@ remotesByCost = do
g <- Annex.gitRepo
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 l = do
costpairs <- mapM costpair l
notignored <- filterM repoNotIgnored l
costpairs <- mapM costpair notignored
return $ fst $ unzip $ sortBy bycost $ costpairs
where
costpair r = do
@ -76,13 +92,22 @@ repoCost r = do
g <- Annex.gitRepo
if ((length $ config g r) > 0)
then return $ read $ config g r
else if (Git.repoIsLocal r)
then return 100
else return 200
else if (Git.repoIsUrl r)
then return 200
else return 100
where
config g r = Git.configGet g (configkey r) ""
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
- because reading it may be expensive. This function tries to read the
- 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
result <- liftIO $ (try (Git.configRead r)::IO (Either SomeException (Git.Repo)))
case (result) of
Left err -> return $ Left r
Left e -> return $ Left r
Right r' -> do
g <- Annex.gitRepo
let l = Git.remotes g

1
debian/changelog vendored
View file

@ -1,6 +1,7 @@
git-annex (0.02) UNRELEASED; urgency=low
* 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

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
files to repositories, in particular, whether the repository is on
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
here.