move code around and rename thread; no functional changes

This commit is contained in:
Joey Hess 2013-10-29 13:41:44 -04:00
parent d068ec79ff
commit fabb0c50b7
10 changed files with 130 additions and 122 deletions

View file

@ -28,6 +28,8 @@ import Assistant.Types.UrlRenderer
import Assistant.WebApp.Types
import qualified Data.Text as T
#endif
import qualified Utility.Lsof as Lsof
import Utility.ThreadScheduler
import Control.Concurrent.Async
@ -105,3 +107,43 @@ runRepair u mrmt destructiverepair = do
backgroundfsck params = liftIO $ void $ async $ do
program <- readProgramFile
batchCommand program (Param "fsck" : params)
{- 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