summaryrefslogtreecommitdiff
path: root/Assistant/Threads/ProblemChecker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads/ProblemChecker.hs')
-rw-r--r--Assistant/Threads/ProblemChecker.hs53
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"