Merge branch 'master' into assistant

This commit is contained in:
Joey Hess 2012-06-26 22:31:32 -04:00
commit 3ede3a8097
2 changed files with 49 additions and 26 deletions

View file

@ -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,7 +203,8 @@ 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 =
guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do
ensureInitialized ensureInitialized
whenM (Annex.Content.inAnnex key) $ do whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $ Annex.Content.lockContent key $
@ -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

View file

@ -0,0 +1,19 @@
Not much available time today, only a few hours.
Main thing I did was fixed up the failed push tracking to use a better data
structure. No need for a queue of failed pushes, all it needs is a map of
remotes that have an outstanding failed push, and a timestamp. Now it
won't grow in memory use forever anymore. :)
Finding the right thread mutex type for this turned out to be a bit of a
challenge. I ended up with a STM TMVar, which is left empty when there are
no pushes to retry, so the thread using it blocks until there are some. And,
it can be updated transactionally, without races.
I also fixed a bug outside the git-annex assistant code. It was possible to
crash git-annex if a local git repository was configured as a remote, and
the repository was not available on startup. git-annex now ignores such
remotes. This does impact the assistant, since it is a long running process
and git repositories will come and go. Now it ignores any that
were not available when it started up. This will need to be dealt with when
making it support removable drives.