Better fix for unavailable local remotes

Not including such remotes turned out to have other consequences,
including annex-truselevel git config being ignored. Instead, add guards
before each operation that might try to operate on such a repo.
This commit is contained in:
Joey Hess 2012-06-26 22:27:30 -04:00
parent 1eff74dd44
commit 6aee7e5a8b

View file

@ -43,7 +43,7 @@ list :: Annex [Git.Repo]
list = do
c <- fromRepo Git.config
rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
catMaybes <$> mapM configread rs
mapM configread rs
where
annexurl n = "remote." ++ n ++ ".annexurl"
tweakurl c r = do
@ -61,16 +61,11 @@ list = do
configread r = do
notignored <- repoNotIgnored r
u <- getRepoUUID r
r' <- case (repoCheap r, notignored, u) of
case (repoCheap r, notignored, u) of
(_, False, _) -> return r
(True, _, _) -> tryGitConfigRead r
(False, _, NoUUID) -> tryGitConfigRead r
_ -> return r
{- A repo with a LocalUnknown location is not currently
- accessible, so skip it. -}
if Git.repoIsLocalUnknown r'
then return Nothing
else return $ Just r'
repoCheap :: Git.Repo -> Bool
repoCheap = not . Git.repoIsUrl
@ -95,6 +90,21 @@ gen r u _ = new <$> remoteCost r defcst
remotetype = remote
}
{- Checks relatively inexpensively if a repository is available for use. -}
repoAvail :: Git.Repo -> Annex Bool
repoAvail r
| Git.repoIsHttp r = return True
| Git.repoIsUrl r = return True
| Git.repoIsLocalUnknown r = return False
| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
{- Avoids performing an action on a local repository that's not usable.
- Does not check that the repository is still available on disk. -}
guardUsable :: Git.Repo -> a -> Annex a -> Annex a
guardUsable r onerr a
| Git.repoIsLocalUnknown r = return onerr
| otherwise = a
{- Tries to read the config for a specified remote, updates state, and
- returns the updated repo. -}
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
@ -166,7 +176,7 @@ inAnnex r key
dispatch ExitSuccess = Right True
dispatch (ExitFailure 1) = Right False
dispatch _ = unknown
checklocal = dispatch <$> check
checklocal = guardUsable r unknown $ dispatch <$> check
where
check = liftIO $ catchMsgIO $ onLocal r $
Annex.Content.inAnnexSafe key
@ -175,13 +185,6 @@ inAnnex r key
dispatch (Right Nothing) = unknown
unknown = Left $ "unable to check " ++ Git.repoDescribe r
{- Checks inexpensively if a repository is available for use. -}
repoAvail :: Git.Repo -> Annex Bool
repoAvail r
| Git.repoIsHttp r = return True
| Git.repoIsUrl r = return True
| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
{- Runs an action on a local repository inexpensively, by making an annex
- monad using that repository. -}
onLocal :: Git.Repo -> Annex a -> IO a
@ -200,14 +203,15 @@ keyUrls r key = map tourl (annexLocations key)
dropKey :: Git.Repo -> Key -> Annex Bool
dropKey r key
| not $ Git.repoIsUrl r = commitOnCleanup r $ liftIO $ onLocal r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $
Annex.Content.removeAnnex key
Annex.Content.logStatus key InfoMissing
Annex.Content.saveState True
return True
| not $ Git.repoIsUrl r =
guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $
Annex.Content.removeAnnex key
Annex.Content.logStatus key InfoMissing
Annex.Content.saveState True
return True
| Git.repoIsHttp r = error "dropping from http repo not supported"
| otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
[ Params "--quiet --force"
@ -217,7 +221,7 @@ dropKey r key
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemote r key file
| not $ Git.repoIsUrl r = do
| not $ Git.repoIsUrl r = guardUsable r False $ do
params <- rsyncParams r
loc <- liftIO $ gitAnnexLocation key r
rsyncOrCopyFile params loc file
@ -227,7 +231,7 @@ copyFromRemote r key file
copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemoteCheap r key file
| not $ Git.repoIsUrl r = do
| not $ Git.repoIsUrl r = guardUsable r False $ do
loc <- liftIO $ gitAnnexLocation key r
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
| Git.repoIsSsh r =
@ -240,7 +244,7 @@ copyFromRemoteCheap r key file
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
| not $ Git.repoIsUrl r = commitOnCleanup r $ do
| not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
params <- rsyncParams r
-- run copy from perspective of remote