aboutsummaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/ProblemChecker.hs53
-rw-r--r--Assistant/Threads/RemoteChecker.hs46
-rw-r--r--Assistant/Threads/SanityChecker.hs43
3 files changed, 54 insertions, 88 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"
diff --git a/Assistant/Threads/RemoteChecker.hs b/Assistant/Threads/RemoteChecker.hs
deleted file mode 100644
index ea0b578d2..000000000
--- a/Assistant/Threads/RemoteChecker.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{- 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
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index d8ffa41f4..916cf52c4 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -14,6 +14,7 @@ module Assistant.Threads.SanityChecker (
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.Alert
+import Assistant.Repair
import qualified Git.LsFiles
import qualified Git.Command
import qualified Git.Config
@@ -23,8 +24,6 @@ import Utility.LogFile
import Utility.Batch
import Utility.NotificationBroadcaster
import Config
-import qualified Git
-import qualified Utility.Lsof as Lsof
import Utility.HumanTime
import Data.Time.Clock.POSIX
@@ -146,46 +145,6 @@ checkLogSize n = do
where
filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
-{- Detect when a git lock file exists and has no git process currently
- - writing to it. This strongly suggests it is a stale lock file.
- -
- - However, this could be on a network filesystem. Which is not very safe
- - anyway (the assistant relies on being able to check when files have
- - no writers to know when to commit them). Just in case, when the lock
- - file appears stale, we delay for one minute, and check its size. If
- - the size changed, delay for another minute, and so on. This will at
- - least work to detect is another machine is writing out a new index
- - file, since git does so by writing the new content to index.lock.
- -}
-checkStaleGitLocks :: Assistant ()
-checkStaleGitLocks = do
- lockfiles <- filter (not . isInfixOf "gc.pid")
- . filter (".lock" `isSuffixOf`)
- <$> (liftIO . dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir)
- =<< liftAnnex (fromRepo Git.localGitDir))
- checkStaleLocks lockfiles
-checkStaleLocks :: [FilePath] -> Assistant ()
-checkStaleLocks lockfiles = go =<< getsizes
- where
- getsize lf = catchMaybeIO $
- (\s -> (lf, fileSize s)) <$> getFileStatus lf
- getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles
- go [] = return ()
- go l = ifM (liftIO $ null <$> Lsof.query ("--" : map fst l))
- ( do
- waitforit "to check stale git lock file"
- l' <- getsizes
- if l' == l
- then liftIO $ mapM_ nukeFile (map fst l)
- else go l'
- , do
- waitforit "for git lock file writer"
- go =<< getsizes
- )
- waitforit why = do
- notice ["Waiting for 60 seconds", why]
- liftIO $ threadDelaySeconds $ Seconds 60
-
oneMegabyte :: Int
oneMegabyte = 1000000