summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-22 14:28:47 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-22 14:28:47 -0400
commit9ec5d90b6a28e28f6349635d33df0000ce9203ef (patch)
tree8c900655378db7d6f2f1aab1a110002305c3caf6
parent46ac66a4380e238865f213ff28411283a4efbbbd (diff)
avoid reading configs for URL remotes every time
-rw-r--r--Backend/File.hs2
-rw-r--r--Remotes.hs67
-rw-r--r--debian/changelog1
-rw-r--r--doc/git-annex.mdwn2
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.