8820091b4c
When starting up the assistant, it'll remind about the current repository, if it doesn't have checks. And when a removable drive is plugged in, it will remind if a repository on it lacks checks. Since that might be annoying, the reminders can be turned off. This commit was sponsored by Nedialko Andreev.
70 lines
2.3 KiB
Haskell
70 lines
2.3 KiB
Haskell
{- git-annex assistant thread to handle fixing problems with repositories
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Threads.ProblemFixer (
|
|
problemFixerThread
|
|
) where
|
|
|
|
import Assistant.Common
|
|
import Assistant.Types.RepoProblem
|
|
import Assistant.RepoProblem
|
|
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 Annex.UUID
|
|
import Utility.ThreadScheduler
|
|
|
|
{- Waits for problems with a repo, and tries to fsck the repo and repair
|
|
- the problem. -}
|
|
problemFixerThread :: UrlRenderer -> NamedThread
|
|
problemFixerThread urlrenderer = namedThread "ProblemFixer" $
|
|
go =<< getRepoProblems
|
|
where
|
|
go problems = do
|
|
mapM_ (handleProblem urlrenderer) problems
|
|
liftIO $ threadDelaySeconds (Seconds 60)
|
|
-- Problems may have been re-reported while they were being
|
|
-- fixed, so ignore those. If a new unique problem happened
|
|
-- 60 seconds after the last was fixed, we're unlikely
|
|
-- to do much good anyway.
|
|
go =<< filter (\p -> not (any (sameRepoProblem p) problems))
|
|
<$> getRepoProblems
|
|
|
|
handleProblem :: UrlRenderer -> RepoProblem -> Assistant ()
|
|
handleProblem urlrenderer repoproblem = do
|
|
fixed <- ifM ((==) (problemUUID repoproblem) <$> liftAnnex getUUID)
|
|
( handleLocalRepoProblem urlrenderer
|
|
, maybe (return False) (handleRemoteProblem urlrenderer)
|
|
=<< liftAnnex (remoteFromUUID $ problemUUID repoproblem)
|
|
)
|
|
when fixed $
|
|
liftIO $ afterFix repoproblem
|
|
|
|
handleRemoteProblem :: UrlRenderer -> Remote -> Assistant Bool
|
|
handleRemoteProblem urlrenderer rmt
|
|
| Git.repoIsLocal r && not (Git.repoIsLocalUnknown r) =
|
|
ifM (liftIO $ checkAvailable True rmt)
|
|
( do
|
|
fixedlocks <- repairStaleGitLocks r
|
|
fsckresults <- showFscking urlrenderer (Just rmt) $ tryNonAsync $
|
|
Git.Fsck.findBroken True r
|
|
repaired <- repairWhenNecessary urlrenderer (Remote.uuid rmt) (Just rmt) fsckresults
|
|
return $ fixedlocks || repaired
|
|
, return False
|
|
)
|
|
| otherwise = return False
|
|
where
|
|
r = Remote.repo rmt
|
|
|
|
{- This is not yet used, and should probably do a fsck. -}
|
|
handleLocalRepoProblem :: UrlRenderer -> Assistant Bool
|
|
handleLocalRepoProblem _urlrenderer = do
|
|
repairStaleGitLocks =<< liftAnnex gitRepo
|