improved messages when a file is not available in remotes

This commit is contained in:
Joey Hess 2010-10-19 14:13:48 -04:00
parent ed3f6653b6
commit 4f8d28819d
2 changed files with 32 additions and 36 deletions

View file

@ -55,15 +55,15 @@ copyKeyFile key file = do
remotes <- Remotes.withKey key remotes <- Remotes.withKey key
if (0 == length remotes) if (0 == length remotes)
then do then do
showNote $ "No available git remotes have the file." showNote "not available"
showLocations key showLocations key
return False return False
else trycopy remotes remotes else trycopy remotes remotes
where where
trycopy full [] = do trycopy full [] = do
showNote $ showNote "not available"
"need access to one of these remotes: " ++ showTriedRemotes full
(Remotes.list full) showLocations key
return False return False
trycopy full (r:rs) = do trycopy full (r:rs) = do
-- annexLocation needs the git config to have been -- annexLocation needs the git config to have been
@ -71,8 +71,8 @@ copyKeyFile key file = do
-- if it hasn't been already -- if it hasn't been already
result <- Remotes.tryGitConfigRead r result <- Remotes.tryGitConfigRead r
case (result) of case (result) of
Nothing -> trycopy full rs Left err -> trycopy full rs
Just r' -> do Right r' -> do
showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
liftIO $ copyFromRemote r' key file liftIO $ copyFromRemote r' key file
@ -86,7 +86,7 @@ copyFromRemote r key file = do
getlocal = boolSystem "cp" ["-a", location, file] getlocal = boolSystem "cp" ["-a", location, file]
getremote = return False -- TODO implement get from remote getremote = return False -- TODO implement get from remote
location = annexLocation r key location = annexLocation r key
showLocations :: Key -> Annex () showLocations :: Key -> Annex ()
showLocations key = do showLocations key = do
g <- Annex.gitRepo g <- Annex.gitRepo
@ -97,6 +97,10 @@ showLocations key = do
if (0 < length uuidsf) if (0 < length uuidsf)
then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
else showLongNote $ "No other repository is known to contain the file." else showLongNote $ "No other repository is known to contain the file."
showTriedRemotes remotes =
showLongNote $ "I was unable to access these remotes: " ++
(Remotes.list remotes)
{- Checks remotes to verify that enough copies of a key exist to allow {- Checks remotes to verify that enough copies of a key exist to allow
- for a key to be safely removed (with no data loss), and fails with an - for a key to be safely removed (with no data loss), and fails with an
@ -108,46 +112,37 @@ checkRemoveKey key = do
then return True then return True
else do else do
g <- Annex.gitRepo g <- Annex.gitRepo
let numcopies = read $ Git.configGet g config "1"
remotes <- Remotes.withKey key remotes <- Remotes.withKey key
let numcopies = read $ Git.configGet g config "1"
if (numcopies > length remotes) if (numcopies > length remotes)
then retNotEnoughCopiesKnown remotes numcopies then notEnoughCopies numcopies (length remotes) []
else findcopies numcopies remotes [] else findcopies numcopies 0 remotes []
where where
config = "annex.numcopies" config = "annex.numcopies"
findcopies need have [] bad =
findcopies 0 _ _ = return True -- success, enough copies found if (have >= need)
findcopies _ [] bad = notEnoughCopiesSeen bad then return True
findcopies n (r:rs) bad = do else notEnoughCopies need have bad
findcopies need have (r:rs) bad = do
all <- Annex.supportedBackends all <- Annex.supportedBackends
result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool))
case (result) of case (result) of
Right True -> findcopies (n-1) rs bad Right True -> findcopies need (have+1) rs bad
Right False -> findcopies n rs bad Right False -> findcopies need have rs bad
Left _ -> findcopies n rs (r:bad) Left _ -> findcopies need have rs (r:bad)
remoteHasKey r all = do remoteHasKey r all = do
-- To check if a remote has a key, construct a new -- To check if a remote has a key, construct a new
-- Annex monad and query its backend. -- Annex monad and query its backend.
a <- Annex.new r all a <- Annex.new r all
(result, _) <- Annex.run a (Backend.hasKey key) (result, _) <- Annex.run a (Backend.hasKey key)
return result return result
notEnoughCopiesSeen bad = do notEnoughCopies need have bad = do
unsafe
if (0 /= length bad) then listbad bad else return ()
showLocations key
hint
return False
listbad bad =
showLongNote $
"I was unable to access these remotes: " ++
(Remotes.list bad)
retNotEnoughCopiesKnown remotes numcopies = do
unsafe unsafe
showLongNote $ showLongNote $
"Could only verify the existence of " ++ "Could only verify the existence of " ++
(show $ length remotes) ++ (show have) ++ " out of " ++ (show need) ++
" out of " ++ (show numcopies) ++
" necessary copies" " necessary copies"
if (0 /= length bad) then showTriedRemotes bad else return ()
showLocations key showLocations key
hint hint
return False return False

View file

@ -10,6 +10,7 @@ import Control.Exception
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
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 List import List
import Maybe import Maybe
@ -42,8 +43,8 @@ withKey key = do
where where
tryharder allremotes uuids = do tryharder allremotes uuids = do
-- more expensive; read each remote's config -- more expensive; read each remote's config
mayberemotes <- mapM tryGitConfigRead allremotes eitherremotes <- mapM tryGitConfigRead allremotes
let allremotes' = catMaybes mayberemotes let allremotes' = map fromEither eitherremotes
remotes' <- reposByUUID allremotes' uuids remotes' <- reposByUUID allremotes' uuids
Annex.flagChange RemotesRead True Annex.flagChange RemotesRead True
return remotes' return remotes'
@ -86,7 +87,7 @@ repoCost r = do
- 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
- returns the updated git repo. -} - returns the updated git repo. -}
tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo)
tryGitConfigRead r = do tryGitConfigRead r = do
if (Map.null $ Git.configMap r) if (Map.null $ Git.configMap r)
then do then do
@ -94,15 +95,15 @@ 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 Nothing Left err -> 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
let g' = Git.remotesAdd g $ let g' = Git.remotesAdd g $
exchange l r' exchange l r'
Annex.gitRepoChange g' Annex.gitRepoChange g'
return $ Just r' return $ Right r'
else return $ Just r else return $ Right r -- config already read
where where
exchange [] new = [] exchange [] new = []
exchange (old:ls) new = exchange (old:ls) new =