query remotes for uuids

(not cached yet)

Backend/File.hs

@@ -49,13 +49,16 @@ copyKeyFile key file = do
 			-- annexLocation needs the git config to have been
 			-- read for a remote, so do that now,
 			-- if it hasn't been already
-			r' <- Remotes.ensureGitConfigRead r
+			result <- Remotes.tryGitConfigRead r
-			result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ()))
+			case (result) of
-        		case (result) of
+				Nothing -> trycopy full rs
-		                Left err -> do
+				Just r' -> do
-					liftIO $ hPutStrLn stderr (show err)
+					result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ()))
-					trycopy full rs
+		        		case (result) of
-		                Right succ -> return True
+				                Left err -> do
+							liftIO $ hPutStrLn stderr (show err)
+							trycopy full rs
+				                Right succ -> return True
 
 {- Tries to copy a file from a remote, exception on error. -}
 copyFromRemote :: Git.Repo -> Key -> FilePath -> IO ()
@@ -67,6 +70,8 @@ copyFromRemote r key file = do
 		else getremote
 	return ()
 	where
-		getlocal = rawSystem "cp" ["-a", location, file]
+		getlocal = do
+			rawSystem "cp" ["-a", location, file]
+			putStrLn "cp done"
 		getremote = error "get via network not yet implemented!"
 		location = annexLocation r backend key

Remotes.hs

@@ -3,19 +3,21 @@
 module Remotes (
 	list,
 	withKey,
-	ensureGitConfigRead
+	tryGitConfigRead
 ) where
 
 import Control.Monad.State (liftIO)
+import IO
 import qualified Data.Map as Map
 import Data.String.Utils
+import List
+import Maybe
 import Types
 import qualified GitRepo as Git
 import qualified Annex
 import LocationLog
 import Locations
 import UUID
-import List
 
 {- Human visible list of remotes. -}
 list :: [Git.Repo] -> String
@@ -27,12 +29,25 @@ withKey key = do
 	g <- Annex.gitRepo
 	uuids <- liftIO $ keyLocations g key
 	allremotes <- remotesByCost
+	-- this only uses cached data, so may not find new remotes
 	remotes <- reposByUUID allremotes uuids
 	if (0 == length remotes)
-		then error $ "no configured git remotes have: " ++ (keyFile key) ++ "\n" ++
+		then tryharder allremotes uuids
+		else return remotes
+	where
+		tryharder allremotes uuids = do
+			-- more expensive; check each remote's config
+			mayberemotes <- mapM tryGitConfigRead allremotes
+			let allremotes' = catMaybes mayberemotes
+			remotes' <- reposByUUID allremotes' uuids
+			if (0 == length remotes')
+				then err uuids
+				else return remotes'
+		err uuids = 
+			error $ "no available git remotes have: " ++
+			(keyFile key) ++ "\n" ++
 			"It has been seen before in these repositories:\n" ++
 			prettyPrintUUIDs uuids
-		else return remotes
 
 {- Cost Ordered list of remotes. -}
 remotesByCost :: Annex [Git.Repo]
@@ -69,20 +84,25 @@ repoCost r = do
 		configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-cost"
 
 {- The git configs for the git repo's remotes is not read on startup
- - because reading it may be expensive. This function ensures that it is
+ - because reading it may be expensive. This function tries to read the
- - read for a specified remote, and updates state. It returns the
+ - config for a specified remote, and updates state. If successful, it
- - updated git repo also. -}
+ - returns the updated git repo. -}
-ensureGitConfigRead :: Git.Repo -> Annex Git.Repo
+tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo)
-ensureGitConfigRead r = do
+tryGitConfigRead r = do
 	if (Map.null $ Git.configMap r)
 		then do
-			r' <- liftIO $ Git.configRead r
+			liftIO $ putStrLn $ "read config for " ++ (show r)
-			g <- Annex.gitRepo
+			result <- liftIO $ try (Git.configRead r)
-			let l = Git.remotes g
+			case (result) of
-			let g' = Git.remotesAdd g $ exchange l r'
+				Left err -> return Nothing
-			Annex.gitRepoChange g'
+				Right r' -> do
-			return r'
+					g <- Annex.gitRepo
-		else return r
+					let l = Git.remotes g
+					let g' = Git.remotesAdd g $
+						exchange l r'
+					Annex.gitRepoChange g'
+					return $ Just r'
+		else return $ Just r
 	where 
 		exchange [] new = []
 		exchange (old:ls) new =