diff options
Diffstat (limited to 'Assistant/Threads/SanityChecker.hs')
-rw-r--r-- | Assistant/Threads/SanityChecker.hs | 43 |
1 files changed, 1 insertions, 42 deletions
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 |