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:
parent
1eff74dd44
commit
6aee7e5a8b
1 changed files with 30 additions and 26 deletions
|
@ -43,7 +43,7 @@ list :: Annex [Git.Repo]
|
||||||
list = do
|
list = do
|
||||||
c <- fromRepo Git.config
|
c <- fromRepo Git.config
|
||||||
rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
|
rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
|
||||||
catMaybes <$> mapM configread rs
|
mapM configread rs
|
||||||
where
|
where
|
||||||
annexurl n = "remote." ++ n ++ ".annexurl"
|
annexurl n = "remote." ++ n ++ ".annexurl"
|
||||||
tweakurl c r = do
|
tweakurl c r = do
|
||||||
|
@ -61,16 +61,11 @@ list = do
|
||||||
configread r = do
|
configread r = do
|
||||||
notignored <- repoNotIgnored r
|
notignored <- repoNotIgnored r
|
||||||
u <- getRepoUUID r
|
u <- getRepoUUID r
|
||||||
r' <- case (repoCheap r, notignored, u) of
|
case (repoCheap r, notignored, u) of
|
||||||
(_, False, _) -> return r
|
(_, False, _) -> return r
|
||||||
(True, _, _) -> tryGitConfigRead r
|
(True, _, _) -> tryGitConfigRead r
|
||||||
(False, _, NoUUID) -> tryGitConfigRead r
|
(False, _, NoUUID) -> tryGitConfigRead r
|
||||||
_ -> return 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 :: Git.Repo -> Bool
|
||||||
repoCheap = not . Git.repoIsUrl
|
repoCheap = not . Git.repoIsUrl
|
||||||
|
@ -95,6 +90,21 @@ gen r u _ = new <$> remoteCost r defcst
|
||||||
remotetype = remote
|
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
|
{- Tries to read the config for a specified remote, updates state, and
|
||||||
- returns the updated repo. -}
|
- returns the updated repo. -}
|
||||||
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
tryGitConfigRead :: Git.Repo -> Annex Git.Repo
|
||||||
|
@ -166,7 +176,7 @@ inAnnex r key
|
||||||
dispatch ExitSuccess = Right True
|
dispatch ExitSuccess = Right True
|
||||||
dispatch (ExitFailure 1) = Right False
|
dispatch (ExitFailure 1) = Right False
|
||||||
dispatch _ = unknown
|
dispatch _ = unknown
|
||||||
checklocal = dispatch <$> check
|
checklocal = guardUsable r unknown $ dispatch <$> check
|
||||||
where
|
where
|
||||||
check = liftIO $ catchMsgIO $ onLocal r $
|
check = liftIO $ catchMsgIO $ onLocal r $
|
||||||
Annex.Content.inAnnexSafe key
|
Annex.Content.inAnnexSafe key
|
||||||
|
@ -175,13 +185,6 @@ inAnnex r key
|
||||||
dispatch (Right Nothing) = unknown
|
dispatch (Right Nothing) = unknown
|
||||||
unknown = Left $ "unable to check " ++ Git.repoDescribe r
|
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
|
{- Runs an action on a local repository inexpensively, by making an annex
|
||||||
- monad using that repository. -}
|
- monad using that repository. -}
|
||||||
onLocal :: Git.Repo -> Annex a -> IO a
|
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 :: Git.Repo -> Key -> Annex Bool
|
||||||
dropKey r key
|
dropKey r key
|
||||||
| not $ Git.repoIsUrl r = commitOnCleanup r $ liftIO $ onLocal r $ do
|
| not $ Git.repoIsUrl r =
|
||||||
ensureInitialized
|
guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do
|
||||||
whenM (Annex.Content.inAnnex key) $ do
|
ensureInitialized
|
||||||
Annex.Content.lockContent key $
|
whenM (Annex.Content.inAnnex key) $ do
|
||||||
Annex.Content.removeAnnex key
|
Annex.Content.lockContent key $
|
||||||
Annex.Content.logStatus key InfoMissing
|
Annex.Content.removeAnnex key
|
||||||
Annex.Content.saveState True
|
Annex.Content.logStatus key InfoMissing
|
||||||
return True
|
Annex.Content.saveState True
|
||||||
|
return True
|
||||||
| Git.repoIsHttp r = error "dropping from http repo not supported"
|
| Git.repoIsHttp r = error "dropping from http repo not supported"
|
||||||
| otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
|
| otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
|
||||||
[ Params "--quiet --force"
|
[ 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. -}
|
{- Tries to copy a key's content from a remote's annex to a file. -}
|
||||||
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
|
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
|
||||||
copyFromRemote r key file
|
copyFromRemote r key file
|
||||||
| not $ Git.repoIsUrl r = do
|
| not $ Git.repoIsUrl r = guardUsable r False $ do
|
||||||
params <- rsyncParams r
|
params <- rsyncParams r
|
||||||
loc <- liftIO $ gitAnnexLocation key r
|
loc <- liftIO $ gitAnnexLocation key r
|
||||||
rsyncOrCopyFile params loc file
|
rsyncOrCopyFile params loc file
|
||||||
|
@ -227,7 +231,7 @@ copyFromRemote r key file
|
||||||
|
|
||||||
copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
|
copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
|
||||||
copyFromRemoteCheap r key file
|
copyFromRemoteCheap r key file
|
||||||
| not $ Git.repoIsUrl r = do
|
| not $ Git.repoIsUrl r = guardUsable r False $ do
|
||||||
loc <- liftIO $ gitAnnexLocation key r
|
loc <- liftIO $ gitAnnexLocation key r
|
||||||
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
|
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
|
||||||
| Git.repoIsSsh r =
|
| Git.repoIsSsh r =
|
||||||
|
@ -240,7 +244,7 @@ copyFromRemoteCheap r key file
|
||||||
{- Tries to copy a key's content to a remote's annex. -}
|
{- Tries to copy a key's content to a remote's annex. -}
|
||||||
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
copyToRemote :: Git.Repo -> Key -> Annex Bool
|
||||||
copyToRemote r key
|
copyToRemote r key
|
||||||
| not $ Git.repoIsUrl r = commitOnCleanup r $ do
|
| not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do
|
||||||
keysrc <- inRepo $ gitAnnexLocation key
|
keysrc <- inRepo $ gitAnnexLocation key
|
||||||
params <- rsyncParams r
|
params <- rsyncParams r
|
||||||
-- run copy from perspective of remote
|
-- run copy from perspective of remote
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue