add support for fully automatic upgrades

The Upgrader avoids checking for upgrades on startup when it was just
upgraded. This avoids an upgrade loop if something goes wrong. One example
of something going wrong would be if the upgrade info file and the
distribution file get out of sync (or the distribution file is cached in
a proxy), so it thinks it has upgraded to a new version, but has really
not.
This commit is contained in:
Joey Hess 2013-11-24 13:20:58 -04:00
parent f04786f984
commit 6165284e39
4 changed files with 22 additions and 14 deletions

View file

@ -153,7 +153,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
#endif #endif
, assist $ netWatcherThread , assist $ netWatcherThread
, assist $ upgraderThread urlrenderer , assist $ upgraderThread urlrenderer
, assist $ upgradWatcherThread urlrenderer , assist $ upgradeWatcherThread urlrenderer
, assist $ netWatcherFallbackThread , assist $ netWatcherFallbackThread
, assist $ transferScannerThread urlrenderer , assist $ transferScannerThread urlrenderer
, assist $ cronnerThread urlrenderer , assist $ cronnerThread urlrenderer

View file

@ -8,7 +8,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Assistant.Threads.UpgradeWatcher ( module Assistant.Threads.UpgradeWatcher (
upgradWatcherThread upgradeWatcherThread
) where ) where
import Assistant.Common import Assistant.Common
@ -30,9 +30,9 @@ import qualified Data.Text as T
data WatcherState = InStartupScan | Started | Upgrading data WatcherState = InStartupScan | Started | Upgrading
deriving (Eq) deriving (Eq)
upgradWatcherThread :: UrlRenderer -> NamedThread upgradeWatcherThread :: UrlRenderer -> NamedThread
upgradWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do upgradeWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
whenM (liftIO $ checkSuccessfulUpgrade) $ whenM (liftIO checkSuccessfulUpgrade) $
showSuccessfulUpgrade urlrenderer showSuccessfulUpgrade urlrenderer
go =<< liftIO upgradeFlagFile go =<< liftIO upgradeFlagFile
where where

View file

@ -12,6 +12,8 @@ module Assistant.Threads.Upgrader (
) where ) where
import Assistant.Common import Assistant.Common
import Assistant.Upgrade
import Assistant.Types.UrlRenderer import Assistant.Types.UrlRenderer
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.Alert import Assistant.Alert
@ -31,11 +33,14 @@ import Data.Time.Clock
import qualified Data.Text as T import qualified Data.Text as T
upgraderThread :: UrlRenderer -> NamedThread upgraderThread :: UrlRenderer -> NamedThread
upgraderThread urlrenderer = namedThread "Upgrader" $ do upgraderThread urlrenderer = namedThread "Upgrader" $
checkUpgrade urlrenderer
when (isJust Build.SysConfig.upgradelocation) $ do when (isJust Build.SysConfig.upgradelocation) $ do
{- Check for upgrade on startup, unless it was just
- upgraded. -}
unlessM (liftIO checkSuccessfulUpgrade) $
checkUpgrade urlrenderer
h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus
go h Nothing go h =<< liftIO getCurrentTime
where where
{- Wait for a network connection event. Then see if it's been {- Wait for a network connection event. Then see if it's been
- half a day since the last upgrade check. If so, proceed with - half a day since the last upgrade check. If so, proceed with
@ -47,10 +52,10 @@ upgraderThread urlrenderer = namedThread "Upgrader" $ do
then go h lastchecked then go h lastchecked
else do else do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
if maybe True (\t -> diffUTCTime now t > halfday) lastchecked if diffUTCTime now lastchecked > halfday
then do then do
checkUpgrade urlrenderer checkUpgrade urlrenderer
go h =<< Just <$> liftIO getCurrentTime go h =<< liftIO getCurrentTime
else go h lastchecked else go h lastchecked
halfday = 12 * 60 * 60 halfday = 12 * 60 * 60
@ -71,13 +76,16 @@ checkUpgrade urlrenderer = do
else debug [ "No new version found." ] else debug [ "No new version found." ]
canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant () canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant ()
canUpgrade urgency urlrenderer d = do canUpgrade urgency urlrenderer d = ifM autoUpgradeEnabled
( startDistributionDownload d
, do
#ifdef WITH_WEBAPP #ifdef WITH_WEBAPP
button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d) button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d)
void $ addAlert (canUpgradeAlert urgency button) void $ addAlert (canUpgradeAlert urgency button)
#else #else
noop noop
#endif #endif
)
getDistributionInfo :: Assistant (Maybe GitAnnexDistribution) getDistributionInfo :: Assistant (Maybe GitAnnexDistribution)
getDistributionInfo = do getDistributionInfo = do

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.7 KiB