diff options
| -rw-r--r-- | Assistant/Threads/UpgradeWatcher.hs | 39 |
1 files changed, 9 insertions, 30 deletions
diff --git a/Assistant/Threads/UpgradeWatcher.hs b/Assistant/Threads/UpgradeWatcher.hs index 6122d2535..c127e3b2f 100644 --- a/Assistant/Threads/UpgradeWatcher.hs +++ b/Assistant/Threads/UpgradeWatcher.hs @@ -1,4 +1,4 @@ -{- git-annex assistant thread to detect when git-annex binary is changed +{- git-annex assistant thread to detect when git-annex is upgraded - - Copyright 2013 Joey Hess <joey@kitenet.net> - @@ -15,8 +15,6 @@ import Assistant.Common import Assistant.Upgrade import Utility.DirWatcher import Utility.DirWatcher.Types -import Config.Files -import qualified Utility.Lsof as Lsof import Utility.ThreadScheduler import Assistant.Types.UrlRenderer import Assistant.Alert @@ -27,7 +25,6 @@ import qualified Build.SysConfig #endif import Control.Concurrent.MVar -import Data.Tuple.Utils import qualified Data.Text as T data WatcherState = InStartupScan | Started | Upgrading @@ -37,12 +34,12 @@ upgradWatcherThread :: UrlRenderer -> NamedThread upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do whenM (liftIO $ checkSuccessfulUpgrade) $ showSuccessfulUpgrade urlrenderer - go =<< liftIO programPath + go =<< liftIO upgradeFlagFile where go Nothing = debug [ "cannot determine program path" ] - go (Just program) = do + go (Just flagfile) = do mvar <- liftIO $ newMVar InStartupScan - changed <- Just <$> asIO2 (changedFile urlrenderer mvar program) + changed <- Just <$> asIO2 (changedFile urlrenderer mvar flagfile) let hooks = mkWatchHooks { addHook = changed , delHook = changed @@ -50,7 +47,7 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do , modifyHook = changed , delDirHook = changed } - let dir = parentDir program + let dir = parentDir flagfile let depth = length (splitPath dir) + 1 let nosubdirs f = length (splitPath f) == depth void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar) @@ -61,39 +58,21 @@ upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do return r changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant () -changedFile urlrenderer mvar program file _status - | program /= file = noop +changedFile urlrenderer mvar flagfile file _status + | flagfile /= file = noop | otherwise = do state <- liftIO $ readMVar mvar when (state == Started) $ do setstate Upgrading - ifM (sanityCheck program) + ifM (liftIO upgradeSanityCheck) ( handleUpgrade urlrenderer , do - debug ["new version of", program, "failed sanity check; not using"] + debug ["new version failed sanity check; not using"] setstate Started ) where setstate = void . liftIO . swapMVar mvar -{- The program's file has been changed. Before restarting, - - it needs to not be open for write by anything, and should run - - successfully when run with the parameter "version". - -} -sanityCheck :: FilePath -> Assistant Bool -sanityCheck program = do - untilM (liftIO $ present <&&> nowriter) $ do - debug [program, "is still being written; waiting"] - liftIO $ threadDelaySeconds (Seconds 60) - debug [program, "has changed, and seems to be ready to run"] - liftIO $ boolSystem program [Param "version"] - where - present = doesFileExist program - nowriter = null - . filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) - . map snd3 - <$> Lsof.query [program] - handleUpgrade :: UrlRenderer -> Assistant () handleUpgrade urlrenderer = do -- Wait 2 minutes for any final upgrade changes to settle. |