diff options
| -rw-r--r-- | Backend/File.hs | 55 | ||||
| -rw-r--r-- | Remotes.hs | 13 |
2 files changed, 32 insertions, 36 deletions
diff --git a/Backend/File.hs b/Backend/File.hs index 6944a8b62..4ea25daa7 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -55,15 +55,15 @@ copyKeyFile key file = do remotes <- Remotes.withKey key if (0 == length remotes) then do - showNote $ "No available git remotes have the file." + showNote "not available" showLocations key return False else trycopy remotes remotes where trycopy full [] = do - showNote $ - "need access to one of these remotes: " ++ - (Remotes.list full) + showNote "not available" + showTriedRemotes full + showLocations key return False trycopy full (r:rs) = do -- annexLocation needs the git config to have been @@ -71,8 +71,8 @@ copyKeyFile key file = do -- if it hasn't been already result <- Remotes.tryGitConfigRead r case (result) of - Nothing -> trycopy full rs - Just r' -> do + Left err -> trycopy full rs + Right r' -> do showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." liftIO $ copyFromRemote r' key file @@ -86,7 +86,7 @@ copyFromRemote r key file = do getlocal = boolSystem "cp" ["-a", location, file] getremote = return False -- TODO implement get from remote location = annexLocation r key - + showLocations :: Key -> Annex () showLocations key = do g <- Annex.gitRepo @@ -97,6 +97,10 @@ showLocations key = do if (0 < length uuidsf) then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids 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 - 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 else do g <- Annex.gitRepo - let numcopies = read $ Git.configGet g config "1" remotes <- Remotes.withKey key + let numcopies = read $ Git.configGet g config "1" if (numcopies > length remotes) - then retNotEnoughCopiesKnown remotes numcopies - else findcopies numcopies remotes [] + then notEnoughCopies numcopies (length remotes) [] + else findcopies numcopies 0 remotes [] where config = "annex.numcopies" - - findcopies 0 _ _ = return True -- success, enough copies found - findcopies _ [] bad = notEnoughCopiesSeen bad - findcopies n (r:rs) bad = do + findcopies need have [] bad = + if (have >= need) + then return True + else notEnoughCopies need have bad + findcopies need have (r:rs) bad = do all <- Annex.supportedBackends result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) case (result) of - Right True -> findcopies (n-1) rs bad - Right False -> findcopies n rs bad - Left _ -> findcopies n rs (r:bad) + Right True -> findcopies need (have+1) rs bad + Right False -> findcopies need have rs bad + Left _ -> findcopies need have rs (r:bad) remoteHasKey r all = do -- To check if a remote has a key, construct a new -- Annex monad and query its backend. a <- Annex.new r all (result, _) <- Annex.run a (Backend.hasKey key) return result - notEnoughCopiesSeen 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 + notEnoughCopies need have bad = do unsafe showLongNote $ "Could only verify the existence of " ++ - (show $ length remotes) ++ - " out of " ++ (show numcopies) ++ + (show have) ++ " out of " ++ (show need) ++ " necessary copies" + if (0 /= length bad) then showTriedRemotes bad else return () showLocations key hint return False diff --git a/Remotes.hs b/Remotes.hs index 828dc753f..a0894f418 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -10,6 +10,7 @@ import Control.Exception import Control.Monad.State (liftIO) import qualified Data.Map as Map import Data.String.Utils +import Data.Either.Utils import List import Maybe @@ -42,8 +43,8 @@ withKey key = do where tryharder allremotes uuids = do -- more expensive; read each remote's config - mayberemotes <- mapM tryGitConfigRead allremotes - let allremotes' = catMaybes mayberemotes + eitherremotes <- mapM tryGitConfigRead allremotes + let allremotes' = map fromEither eitherremotes remotes' <- reposByUUID allremotes' uuids Annex.flagChange RemotesRead True return remotes' @@ -86,7 +87,7 @@ repoCost r = do - because reading it may be expensive. This function tries to read the - config for a specified remote, and updates state. If successful, it - returns the updated git repo. -} -tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo) +tryGitConfigRead :: Git.Repo -> Annex (Either Git.Repo Git.Repo) tryGitConfigRead r = do if (Map.null $ Git.configMap r) then do @@ -94,15 +95,15 @@ 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 Nothing + Left err -> return $ Left r Right r' -> do g <- Annex.gitRepo let l = Git.remotes g let g' = Git.remotesAdd g $ exchange l r' Annex.gitRepoChange g' - return $ Just r' - else return $ Just r + return $ Right r' + else return $ Right r -- config already read where exchange [] new = [] exchange (old:ls) new = |