diff options
-rw-r--r-- | Remote/Git.hs | 56 | ||||
-rw-r--r-- | doc/design/assistant/blog/day_17__push_queue_prune.mdwn | 19 |
2 files changed, 49 insertions, 26 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index df74a769c..60a881803 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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 diff --git a/doc/design/assistant/blog/day_17__push_queue_prune.mdwn b/doc/design/assistant/blog/day_17__push_queue_prune.mdwn new file mode 100644 index 000000000..54ee75fb8 --- /dev/null +++ b/doc/design/assistant/blog/day_17__push_queue_prune.mdwn @@ -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. |