diff options
| -rw-r--r-- | Assistant.hs | 3 | ||||
| -rw-r--r-- | Assistant/NamedThread.hs | 25 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 62 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 35 | ||||
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 5 | ||||
| -rw-r--r-- | Assistant/Types/DaemonStatus.hs | 6 | ||||
| -rw-r--r-- | Assistant/Types/NamedThread.hs | 8 | ||||
| -rw-r--r-- | Locations.hs | 1 | ||||
| -rw-r--r-- | debian/changelog | 4 | ||||
| -rw-r--r-- | doc/bugs/Stale_lock_files_on_Android.mdwn | 3 |
10 files changed, 101 insertions, 51 deletions
diff --git a/Assistant.hs b/Assistant.hs index c14f1e0df..ad4ed4833 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -136,6 +136,9 @@ startDaemon assistant foreground listenhost startbrowser = do , assist $ configMonitorThread , assist $ glacierThread , watch $ watchThread + -- must come last so that all threads that wait + -- on it have already started waiting + , watch $ sanityCheckerStartupThread ] liftIO waitForTermination diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs index edebe830f..f29f0cf36 100644 --- a/Assistant/NamedThread.hs +++ b/Assistant/NamedThread.hs @@ -16,6 +16,7 @@ import Assistant.Types.DaemonStatus import Assistant.Types.UrlRenderer import Assistant.DaemonStatus import Assistant.Monad +import Utility.NotificationBroadcaster import Control.Concurrent import Control.Concurrent.Async @@ -34,7 +35,7 @@ import qualified Data.Text as T - Named threads are run by a management thread, so if they crash - an alert is displayed, allowing the thread to be restarted. -} startNamedThread :: UrlRenderer -> NamedThread -> Assistant () -startNamedThread urlrenderer namedthread@(NamedThread name a) = do +startNamedThread urlrenderer (NamedThread afterstartupsanitycheck name a) = do m <- startedThreads <$> getDaemonStatus case M.lookup name m of Nothing -> start @@ -44,14 +45,24 @@ startNamedThread urlrenderer namedthread@(NamedThread name a) = do Right Nothing -> noop _ -> start where - start = do + start + | afterstartupsanitycheck = do + status <- getDaemonStatus + h <- liftIO $ newNotificationHandle False $ + startupSanityCheckNotifier status + startwith $ runmanaged $ + liftIO $ waitNotification h + | otherwise = startwith $ runmanaged noop + startwith runner = do d <- getAssistant id - aid <- liftIO $ runmanaged $ d { threadName = name } - restart <- asIO $ startNamedThread urlrenderer namedthread + aid <- liftIO $ runner $ d { threadName = name } + restart <- asIO $ startNamedThread urlrenderer (NamedThread False name a) modifyDaemonStatus_ $ \s -> s { startedThreads = M.insertWith' const name (aid, restart) (startedThreads s) } - runmanaged d = do - aid <- async $ runAssistant d a + runmanaged first d = do + aid <- async $ runAssistant d $ do + void first + a void $ forkIO $ manager d aid return aid manager d aid = do @@ -75,7 +86,7 @@ startNamedThread urlrenderer namedthread@(NamedThread name a) = do #endif namedThreadId :: NamedThread -> Assistant (Maybe ThreadId) -namedThreadId (NamedThread name _) = do +namedThreadId (NamedThread _ name _) = do m <- startedThreads <$> getDaemonStatus return $ asyncThreadId . fst <$> M.lookup name m diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 64fbc2fb6..7d6057924 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -1,11 +1,12 @@ {- git-annex assistant sanity checker - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} module Assistant.Threads.SanityChecker ( + sanityCheckerStartupThread, sanityCheckerDailyThread, sanityCheckerHourlyThread ) where @@ -20,10 +21,20 @@ import Utility.ThreadScheduler import qualified Assistant.Threads.Watcher as Watcher import Utility.LogFile import Utility.Batch +import Utility.NotificationBroadcaster import Config +import qualified Git +import qualified Utility.Lsof as Lsof import Data.Time.Clock.POSIX +{- This thread runs once at startup, and most other threads wait for it + - to finish. (However, the webapp thread does not, to prevent the UI + - being nonresponsive.) -} +sanityCheckerStartupThread :: NamedThread +sanityCheckerStartupThread = namedThreadUnchecked "SanityCheckerStartup" $ + startupCheck + {- This thread wakes up hourly for inxepensive frequent sanity checks. -} sanityCheckerHourlyThread :: NamedThread sanityCheckerHourlyThread = namedThread "SanityCheckerHourly" $ forever $ do @@ -69,6 +80,14 @@ waitForNextCheck = do oneDay - truncate (now - lastcheck) | otherwise = oneDay +startupCheck :: Assistant () +startupCheck = do + checkStaleGitLocks + + {- Notify other threads that the startup sanity check is done. -} + status <- getDaemonStatus + liftIO $ sendNotification $ startupSanityCheckNotifier status + {- 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. -} @@ -128,6 +147,46 @@ 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 (annexDir `isInfixOf`) + =<< 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 @@ -136,3 +195,4 @@ oneHour = 60 * 60 oneDay :: Int oneDay = 24 * oneHour + diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 9b9321014..c10d03eeb 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -122,7 +122,6 @@ waitFor sig next = do {- Initial scartup scan. The action should return once the scan is complete. -} startupScan :: IO a -> Assistant a startupScan scanner = do - checkStaleIndexLock liftAnnex $ showAction "scanning" alertWhile' startupScanAlert $ do r <- liftIO scanner @@ -143,40 +142,6 @@ startupScan scanner = do return (True, r) -{- Detect when .git/index.lock exists and has no git process currently - - writing to it. This strongly suggests it is a stale lock file, because - - git writes the new index to index.lock and renames it over top. - - - - 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 file - - appears stale, we delay for one minute, and check its size. If the size - - changed, delay for another minute, and so on. - -} -checkStaleIndexLock :: Assistant () -checkStaleIndexLock = do - dir <- liftAnnex $ fromRepo Git.localGitDir - checkStale $ dir </> "index.lock" -checkStale :: FilePath -> Assistant () -checkStale indexlock = go =<< getsize - where - getsize = liftIO $ catchMaybeIO $ fileSize <$> getFileStatus indexlock - go Nothing = return () - go oldsize = ifM (liftIO $ null <$> Lsof.query ["--", indexlock]) - ( do - waitforit "to check stale" - size <- getsize - if size == oldsize - then liftIO $ nukeFile indexlock - else go size - , do - waitforit "for writer on" - go =<< getsize - ) - waitforit why = do - notice ["Waiting for 60 seconds", why, indexlock] - liftIO $ threadDelaySeconds $ Seconds 60 - {- Hardcoded ignores, passed to the DirWatcher so it can avoid looking - at the entire .git directory. Does not include .gitignores. -} ignored :: FilePath -> Bool diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 0fb038b6a..4620b0387 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -83,7 +83,10 @@ webAppThread assistantdata urlrenderer noannex listenhost postfirstrun onstartup urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile go addr webapp htmlshim (Just urlfile) where - thread = namedThread "WebApp" + -- The webapp thread does not wait for the startupSanityCheckThread + -- to finish, so that the user interface remains responsive while + -- that's going on. + thread = namedThreadUnchecked "WebApp" getreldir | noannex = return Nothing | otherwise = Just <$> diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs index 17e535b6d..65190fe40 100644 --- a/Assistant/Types/DaemonStatus.hs +++ b/Assistant/Types/DaemonStatus.hs @@ -31,9 +31,9 @@ data DaemonStatus = DaemonStatus , scanComplete :: Bool -- Time when a previous process of the daemon was running ok , lastRunning :: Maybe POSIXTime - -- True when the sanity checker is running + -- True when the daily sanity checker is running , sanityCheckRunning :: Bool - -- Last time the sanity checker ran + -- Last time the daily sanity checker ran , lastSanityCheck :: Maybe POSIXTime -- True when a scan for file transfers is running , transferScanRunning :: Bool @@ -62,6 +62,7 @@ data DaemonStatus = DaemonStatus , alertNotifier :: NotificationBroadcaster -- Broadcasts notifications when the syncRemotes change , syncRemotesNotifier :: NotificationBroadcaster + , startupSanityCheckNotifier :: NotificationBroadcaster -- When the XMPP client is connected, this will contain the XMPP -- address. , xmppClientID :: Maybe ClientID @@ -93,4 +94,5 @@ newDaemonStatus = DaemonStatus <*> newNotificationBroadcaster <*> newNotificationBroadcaster <*> newNotificationBroadcaster + <*> newNotificationBroadcaster <*> pure Nothing diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs index a65edc20d..5dd1364ad 100644 --- a/Assistant/Types/NamedThread.hs +++ b/Assistant/Types/NamedThread.hs @@ -11,7 +11,11 @@ import Assistant.Monad import Assistant.Types.ThreadName {- Information about a named thread that can be run. -} -data NamedThread = NamedThread ThreadName (Assistant ()) +data NamedThread = NamedThread Bool ThreadName (Assistant ()) namedThread :: String -> Assistant () -> NamedThread -namedThread = NamedThread . ThreadName +namedThread = NamedThread True . ThreadName + +{- A named thread that can start running before the startup sanity check. -} +namedThreadUnchecked :: String -> Assistant () -> NamedThread +namedThreadUnchecked = NamedThread False . ThreadName diff --git a/Locations.hs b/Locations.hs index 9b7bb575b..3978442d0 100644 --- a/Locations.hs +++ b/Locations.hs @@ -10,6 +10,7 @@ module Locations ( fileKey, keyPaths, keyPath, + annexDir, objectDir, gitAnnexLocation, gitAnnexLink, diff --git a/debian/changelog b/debian/changelog index 4bbdffb3f..6768077fd 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,9 +3,7 @@ git-annex (4.20131003) UNRELEASED; urgency=low * Automatically and safely detect and recover from dangling .git/annex/index.lock files, which would prevent git from committing to the git-annex branch, eg after a crash. - * watcher: Detect at startup time when there is a stale .git/lock, - and remove it so it does not interfere with the automatic - commits of changed files. + * assistant: Detect stale git lock files at startup time, and remove them. * addurl: Better sanitization of generated filenames. * Better sanitization of problem characters when generating URL and WORM keys. diff --git a/doc/bugs/Stale_lock_files_on_Android.mdwn b/doc/bugs/Stale_lock_files_on_Android.mdwn index a7b0d3342..b3451a153 100644 --- a/doc/bugs/Stale_lock_files_on_Android.mdwn +++ b/doc/bugs/Stale_lock_files_on_Android.mdwn @@ -39,3 +39,6 @@ fatal: Unable to create '/mnt/sdcard/reference/.git/index.lock': File exists. > The '/mnt/sdcard/reference/.git/index.lock' lock file will now be > automatically dealt with. Have not done anything about the refs/remotes > lock files yet. --[[Joey]] +> +> Now the assistant deals with all stale git lock files on startup. +> [[done]] --[[Joey]] |