diff options
author | Joey Hess <joey@kitenet.net> | 2013-10-29 13:41:44 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-10-29 13:41:44 -0400 |
commit | 2db78797ee58e53f06bd2d104fb203c45247e7c0 (patch) | |
tree | 3b8b7ab10eeb2cb8c787a6d57c1a03bb623ece6a /Assistant/Threads/ProblemChecker.hs | |
parent | 255354acc20f2680126b22cc02a0893d1d72d804 (diff) |
move code around and rename thread; no functional changes
Diffstat (limited to 'Assistant/Threads/ProblemChecker.hs')
-rw-r--r-- | Assistant/Threads/ProblemChecker.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/Assistant/Threads/ProblemChecker.hs b/Assistant/Threads/ProblemChecker.hs new file mode 100644 index 000000000..1a30a337e --- /dev/null +++ b/Assistant/Threads/ProblemChecker.hs @@ -0,0 +1,53 @@ +{- git-annex assistant thread to handle reported problems with repositories + - + - Copyright 2013 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.Threads.ProblemChecker ( + problemCheckerThread +) where + +import Assistant.Common +import Utility.ThreadScheduler +import Assistant.Types.UrlRenderer +import Assistant.Alert +import Remote +import qualified Types.Remote as Remote +import qualified Git.Fsck +import Assistant.Repair +import qualified Git +import Assistant.RepoProblem +import Assistant.Sync +import Annex.UUID + +{- Waits for problems with a repo, and tries to fsck the repo and repair + - the problem. -} +problemCheckerThread :: UrlRenderer -> NamedThread +problemCheckerThread urlrenderer = namedThread "ProblemChecker" $ forever $ do + mapM_ (handleProblem urlrenderer) + =<< nub <$> getRepoProblems + liftIO $ threadDelaySeconds (Seconds 60) + +handleProblem :: UrlRenderer -> UUID -> Assistant () +handleProblem urlrenderer u = ifM ((==) u <$> liftAnnex getUUID) + ( handleLocalRepoProblem urlrenderer + , maybe noop (handleRemoteProblem urlrenderer) + =<< liftAnnex (remoteFromUUID u) + ) + +handleRemoteProblem :: UrlRenderer -> Remote -> Assistant () +handleRemoteProblem urlrenderer rmt + | Git.repoIsLocal r && not (Git.repoIsLocalUnknown r) = + whenM (liftIO $ checkAvailable True rmt) $ do + fsckresults <- showFscking urlrenderer (Just $ Remote.name rmt) $ tryNonAsync $ + Git.Fsck.findBroken True r + whenM (repairWhenNecessary urlrenderer (Remote.uuid rmt) (Just rmt) fsckresults) $ + syncRemote rmt + | otherwise = noop + where + r = Remote.repo rmt + +handleLocalRepoProblem :: UrlRenderer -> Assistant () +handleLocalRepoProblem urlrenderer = error "TODO" |