summaryrefslogtreecommitdiff
path: root/Assistant/Threads/ProblemChecker.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-10-29 13:41:44 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-10-29 13:41:44 -0400
commit2db78797ee58e53f06bd2d104fb203c45247e7c0 (patch)
tree3b8b7ab10eeb2cb8c787a6d57c1a03bb623ece6a /Assistant/Threads/ProblemChecker.hs
parent255354acc20f2680126b22cc02a0893d1d72d804 (diff)
move code around and rename thread; no functional changes
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"