assistant restart on upgrade

This commit is contained in:
Joey Hess 2013-11-22 23:12:06 -04:00
parent ad653e49cf
commit b9cdb55e0c
9 changed files with 127 additions and 25 deletions

View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Assistant.Threads.UpgradeWatcher (
upgradWatcherThread
) where
@ -13,19 +15,29 @@ import Assistant.Common
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
import Assistant.DaemonStatus
#ifdef WITH_WEBAPP
import Assistant.WebApp.Types
#endif
import Control.Concurrent.MVar
import Data.Tuple.Utils
import qualified Data.Text as T
data WatcherState = InStartupScan | Started | Upgrading
deriving (Eq)
upgradWatcherThread :: NamedThread
upgradWatcherThread = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
upgradWatcherThread :: UrlRenderer -> NamedThread
upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
where
go Nothing = debug [ "cannot determine program path" ]
go (Just program) = do
mvar <- liftIO $ newMVar InStartupScan
changed <- Just <$> asIO2 (changedFile mvar program)
changed <- Just <$> asIO2 (changedFile urlrenderer mvar program)
let hooks = mkWatchHooks
{ addHook = changed
, addSymlinkHook = changed
@ -42,10 +54,44 @@ upgradWatcherThread = namedThread "UpgradeWatcher" $ go =<< liftIO programPath
void $ swapMVar mvar Started
return r
changedFile :: MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
changedFile mvar program file _status
| program == file = do
changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()
changedFile urlrenderer mvar program file _status
| program /= file = noop
| otherwise = do
state <- liftIO $ readMVar mvar
when (state == Started) $
debug [ "saw change to", file ]
| otherwise = noop
when (state == Started) $ do
setstate Upgrading
ifM (sanityCheck program)
( handleUpgrade urlrenderer
, do
debug ["new version of", program, "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
whileM (liftIO haswriter) $ 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
haswriter = not . null
. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly])
. map snd3
<$> Lsof.query [program]
handleUpgrade :: UrlRenderer -> Assistant ()
handleUpgrade urlrenderer = do
#ifdef WITH_WEBAPP
button <- mkAlertButton True (T.pack "Finish Upgrade") urlrenderer ConfigFinishUpgradeR
void $ addAlert (upgradeReadyAlert button)
#else
noop
#endif

View file

@ -73,7 +73,7 @@ checkUpgrade urlrenderer = do
canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant ()
canUpgrade urgency urlrenderer d = do
#ifdef WITH_WEBAPP
button <- mkAlertButton False (T.pack "Upgrade") urlrenderer (ConfigUpgradeR d)
button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d)
void $ addAlert (canUpgradeAlert urgency button)
#else
noop