check for unstaged old symlinks in the sanity checker

This commit is contained in:
Joey Hess 2012-06-13 19:25:47 -04:00
parent 4b9b9b4947
commit 8919c2e4da
3 changed files with 39 additions and 14 deletions

View file

@ -72,7 +72,7 @@ startDaemon foreground
-- is taking place.
_ <- forkIO $ commitThread st changechan
_ <- forkIO $ daemonStatusThread st dstatus
_ <- forkIO $ sanityCheckerThread st dstatus
_ <- forkIO $ sanityCheckerThread st dstatus changechan
watchThread st dstatus changechan
stopDaemon :: Annex ()

View file

@ -77,7 +77,7 @@ writeDaemonStatusFile file status =
[ "lastRunning:" ++ show now
, "scanComplete:" ++ show (scanComplete status)
, "sanityCheckRunning:" ++ show (sanityCheckRunning status)
, "lastSanityCheck:" ++ show (lastSanityCheck status)
, "lastSanityCheck:" ++ maybe "" show (lastSanityCheck status)
]
readDaemonStatusFile :: FilePath -> IO DaemonStatus

View file

@ -8,15 +8,18 @@ module Assistant.SanityChecker (
) where
import Common.Annex
import qualified Git.LsFiles
import Assistant.DaemonStatus
import Assistant.ThreadedMonad
import Assistant.Committer
import Utility.ThreadScheduler
import qualified Assistant.Watcher
import Data.Time.Clock.POSIX
{- This thread wakes up occasionally to make sure the tree is in good shape. -}
sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> IO ()
sanityCheckerThread st status = forever $ do
sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO ()
sanityCheckerThread st status changechan = forever $ do
waitForNextCheck st status
runThreadState st $
@ -24,15 +27,13 @@ sanityCheckerThread st status = forever $ do
{ sanityCheckRunning = True }
now <- getPOSIXTime -- before check started
ok <- catchBoolIO $ runThreadState st check
catchIO (check st status changechan)
(runThreadState st . warning . show)
runThreadState st $ do
modifyDaemonStatus status $ \s -> s
{ sanityCheckRunning = False
, lastSanityCheck =
if ok
then Just now
else lastSanityCheck s
, lastSanityCheck = Just now
}
{- Only run one check per day, from the time of the last check. -}
@ -45,12 +46,36 @@ waitForNextCheck st status = do
where
calcdelay _ Nothing = oneDay
calcdelay now (Just lastcheck)
| lastcheck < now = oneDay - truncate (now - lastcheck)
| lastcheck < now = max oneDay $
oneDay - truncate (now - lastcheck)
| otherwise = oneDay
check :: Annex Bool
check = do
return True
oneDay :: Int
oneDay = 24 * 60 * 60
{- It's important to stay out of the Annex monad as much as possible while
- running potentially expensive parts of this check, since remaining in it
- will block the watcher. -}
check :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO ()
check st status changechan = do
g <- runThreadState st $ do
showSideAction "Running daily check"
fromRepo id
-- Find old unstaged symlinks, and add them to git.
unstaged <- Git.LsFiles.notInRepo False ["."] g
now <- getPOSIXTime
forM_ unstaged $ \file -> do
ms <- catchMaybeIO $ getSymbolicLinkStatus file
case ms of
Just s | toonew (statusChangeTime s) now -> noop
| isSymbolicLink s ->
addsymlink file ms
_ -> noop
where
toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
slop = fromIntegral tenMinutes
insanity m = runThreadState st $ warning m
addsymlink file s = do
insanity $ "found unstaged symlink: " ++ file
Assistant.Watcher.runHandler st status changechan
Assistant.Watcher.onAddSymlink file s