blob: ea0b578d2fdec8d151eaa2ed1a72d2a99b58b392 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
{- git-annex assistant remote checker thread
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Threads.RemoteChecker (
remoteCheckerThread
) 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.RemoteProblem
import Assistant.Sync
import Data.Function
{- Waits for problems with remotes, and tries to fsck the remote and repair
- the problem. -}
remoteCheckerThread :: UrlRenderer -> NamedThread
remoteCheckerThread urlrenderer = namedThread "RemoteChecker" $ forever $ do
mapM_ (handleProblem urlrenderer)
=<< liftIO . filterM (checkAvailable True)
=<< nubremotes <$> getRemoteProblems
liftIO $ threadDelaySeconds (Seconds 60)
where
nubremotes = nubBy ((==) `on` Remote.uuid)
handleProblem :: UrlRenderer -> Remote -> Assistant ()
handleProblem urlrenderer rmt
| Git.repoIsLocal r && not (Git.repoIsLocalUnknown r) = 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
|
