move code around and rename thread; no functional changes

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"

Assistant/Threads/RemoteChecker.hs

@@ -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

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