start of generalizing remotes

Goal is to support multiple different types of remotes, some of which
are not git repositories. To that end, added a Remote class, and moved
git remote specific code into Remote.GitRemote.

Remotes.hs is still present as some code has not been converted to use the
new Remote class yet.
This commit is contained in:
Joey Hess 2011-03-27 15:56:43 -04:00
parent 2821effce9
commit b40f253d6e
6 changed files with 405 additions and 39 deletions

View file

@ -14,14 +14,14 @@
module Backend.File (backend, checkKey) where
import Control.Monad.State
import System.Directory
import Control.Monad.State (liftIO)
import Data.List
import Data.String.Utils
import BackendClass
import LocationLog
import Locations
import qualified Remotes
import qualified Remote
import qualified RemoteClass
import qualified GitRepo as Git
import Content
import qualified Annex
@ -51,10 +51,10 @@ dummyStore :: FilePath -> Key -> Annex Bool
dummyStore _ _ = return True
{- Try to find a copy of the file in one of the remotes,
- and copy it over to this one. -}
- and copy it to here. -}
copyKeyFile :: Key -> FilePath -> Annex Bool
copyKeyFile key file = do
(remotes, _) <- Remotes.keyPossibilities key
(remotes, _) <- Remote.keyPossibilities key
if null remotes
then do
showNote "not available"
@ -72,18 +72,18 @@ copyKeyFile key file = do
then docopy r (trycopy full rs)
else trycopy full rs
-- This check is to avoid an ugly message if a remote is a
-- drive that is not mounted. Avoid checking inAnnex for ssh
-- remotes because that is unnecessarily slow, and the
-- locationlog should be trusted. (If the ssh remote is down
-- or really lacks the file, it's ok to show an ugly message
-- before going on to the next remote.)
-- drive that is not mounted.
probablyPresent r =
if not $ Git.repoIsUrl r
then liftIO $ doesFileExist $ gitAnnexLocation r key
if RemoteClass.hasKeyCheap r
then do
res <- RemoteClass.hasKey r key
case res of
Right b -> return b
Left _ -> return False
else return True
docopy r continue = do
showNote $ "copying from " ++ Git.repoDescribe r ++ "..."
copied <- Remotes.copyFromRemote r key file
showNote $ "copying from " ++ RemoteClass.name r ++ "..."
copied <- RemoteClass.retrieveKeyFile r key file
if copied
then return True
else continue
@ -97,9 +97,9 @@ checkRemoveKey key numcopiesM = do
if force || numcopiesM == Just 0
then return True
else do
(remotes, trusteduuids) <- Remotes.keyPossibilities key
(remotes, trusteduuids) <- Remote.keyPossibilities key
untrusteduuids <- trustGet UnTrusted
tocheck <- reposWithoutUUID remotes (trusteduuids++untrusteduuids)
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
numcopies <- getNumCopies numcopiesM
findcopies numcopies trusteduuids tocheck []
where
@ -109,9 +109,9 @@ checkRemoveKey key numcopiesM = do
findcopies need have (r:rs) bad
| length have >= need = return True
| otherwise = do
u <- getUUID r
let u = RemoteClass.uuid r
let dup = u `elem` have
haskey <- Remotes.inAnnex r key
haskey <- (RemoteClass.hasKey r) key
case (dup, haskey) of
(False, Right True) -> findcopies need (u:have) rs bad
(False, Left _) -> findcopies need have rs (r:bad)
@ -147,11 +147,11 @@ showLocations key exclude = do
message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
message rs us = message rs [] ++ message [] us
showTriedRemotes :: [Git.Repo] -> Annex ()
showTriedRemotes :: [RemoteClass.Remote] -> Annex ()
showTriedRemotes [] = return ()
showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++
Remotes.list remotes
(join ", " $ map RemoteClass.name remotes)
getNumCopies :: Maybe Int -> Annex Int
getNumCopies (Just n) = return n