9aab70de66
Makes it safe to use git annex unlock with the watcher/assistant. And also to mix use of the watcher/assistant with regular files stored in git. Long ago, I had avoided doing this check, except during the startup scan, because it would be slow to run ls-files repeatedly. But then I added the lsof check, and to make that fast, got it to detect batch file adds. So let's move the ls-files check to also occur when it'll have a batch, and can check them all with one call. This does slow down adding a single file by just a bit, but really only a little bit. (The lsof check is probably more expensive.) It also speeds up the startup scan, especially when there are lots of new files found by the scan. Also, fixed the sleep for annex.delayadd to not run while the threadstate lock is held, so it doesn't unnecessarily freeze everything else. Also, --force no longer makes it skip the lsof check, which was not documented, and seems never a good idea.
99 lines
2.9 KiB
Haskell
99 lines
2.9 KiB
Haskell
{- git-annex assistant sanity checker
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Threads.SanityChecker (
|
|
sanityCheckerThread
|
|
) where
|
|
|
|
import Assistant.Common
|
|
import Assistant.DaemonStatus
|
|
import Assistant.ThreadedMonad
|
|
import Assistant.Changes
|
|
import Assistant.Alert
|
|
import Assistant.TransferQueue
|
|
import qualified Git.LsFiles
|
|
import Utility.ThreadScheduler
|
|
import qualified Assistant.Threads.Watcher as Watcher
|
|
|
|
import Data.Time.Clock.POSIX
|
|
|
|
thisThread :: ThreadName
|
|
thisThread = "SanityChecker"
|
|
|
|
{- This thread wakes up occasionally to make sure the tree is in good shape. -}
|
|
sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
|
|
sanityCheckerThread st dstatus transferqueue changechan = thread $ forever $ do
|
|
waitForNextCheck dstatus
|
|
|
|
debug thisThread ["starting sanity check"]
|
|
|
|
void $ alertWhile dstatus sanityCheckAlert go
|
|
|
|
debug thisThread ["sanity check complete"]
|
|
where
|
|
thread = NamedThread thisThread
|
|
go = do
|
|
modifyDaemonStatus_ dstatus $ \s -> s
|
|
{ sanityCheckRunning = True }
|
|
|
|
now <- getPOSIXTime -- before check started
|
|
r <- catchIO (check st dstatus transferqueue changechan)
|
|
$ \e -> do
|
|
runThreadState st $ warning $ show e
|
|
return False
|
|
|
|
modifyDaemonStatus_ dstatus $ \s -> s
|
|
{ sanityCheckRunning = False
|
|
, lastSanityCheck = Just now
|
|
}
|
|
|
|
return r
|
|
|
|
{- Only run one check per day, from the time of the last check. -}
|
|
waitForNextCheck :: DaemonStatusHandle -> IO ()
|
|
waitForNextCheck dstatus = do
|
|
v <- lastSanityCheck <$> getDaemonStatus dstatus
|
|
now <- getPOSIXTime
|
|
threadDelaySeconds $ Seconds $ calcdelay now v
|
|
where
|
|
calcdelay _ Nothing = oneDay
|
|
calcdelay now (Just lastcheck)
|
|
| lastcheck < now = max oneDay $
|
|
oneDay - truncate (now - lastcheck)
|
|
| otherwise = oneDay
|
|
|
|
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 -> TransferQueue -> ChangeChan -> IO Bool
|
|
check st dstatus transferqueue changechan = do
|
|
g <- runThreadState st $ 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
|
|
return True
|
|
where
|
|
toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
|
|
slop = fromIntegral tenMinutes
|
|
insanity msg = do
|
|
runThreadState st $ warning msg
|
|
void $ addAlert dstatus $ sanityCheckFixAlert msg
|
|
addsymlink file s = do
|
|
Watcher.runHandler thisThread st dstatus
|
|
transferqueue changechan
|
|
Watcher.onAddSymlink file s
|
|
insanity $ "found unstaged symlink: " ++ file
|