diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-22 14:28:47 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-22 14:28:47 -0400 |
commit | 9ec5d90b6a28e28f6349635d33df0000ce9203ef (patch) | |
tree | 8c900655378db7d6f2f1aab1a110002305c3caf6 | |
parent | 46ac66a4380e238865f213ff28411283a4efbbbd (diff) |
avoid reading configs for URL remotes every time
-rw-r--r-- | Backend/File.hs | 2 | ||||
-rw-r--r-- | Remotes.hs | 67 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 2 |
4 files changed, 50 insertions, 22 deletions
diff --git a/Backend/File.hs b/Backend/File.hs index d28b92728..b99a064ae 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -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 diff --git a/Remotes.hs b/Remotes.hs index 07aafe51b..cb8f4d131 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -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 diff --git a/debian/changelog b/debian/changelog index 1c3665230..2800e54a3 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 86ac9c635..a7c6b9e48 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -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. |