summaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-21 17:49:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-21 17:49:56 -0400
commit40c91a0d45a875b8ef58c42a38fb29f4a608b425 (patch)
tree1ba0bcab443dfad4301d3d824034067d57fce4c3 /Assistant/Threads
parent5ec99409fa0e4ec617f70c4c87c6f7c8460b61c4 (diff)
upgrade alerts
The webapp will check twice a day, when the network is connected, to see if it can download a distributon upgrade file. If a newer version is found, display an upgrade alert. This will need the autobuilders to set UPGRADE_LOCATION to the url it can be downloaded from when building git-annex. Only builds with that set need automatic upgrade alerts. Currently, the upgrade page just requests the user manually download and upgrade it. But, all the info is provided to do automated upgrades in the future. Note that urls used will need to all be https. This commit was sponsored by Dirk Kraft.
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/NetWatcher.hs5
-rw-r--r--Assistant/Threads/Upgrader.hs87
-rw-r--r--Assistant/Threads/WebApp.hs1
3 files changed, 92 insertions, 1 deletions
diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs
index 0d8442c69..a7124fa01 100644
--- a/Assistant/Threads/NetWatcher.hs
+++ b/Assistant/Threads/NetWatcher.hs
@@ -15,6 +15,7 @@ import Assistant.Sync
import Utility.ThreadScheduler
import qualified Types.Remote as Remote
import Assistant.DaemonStatus
+import Utility.NotificationBroadcaster
#if WITH_DBUS
import Utility.DBus
@@ -127,7 +128,9 @@ listenWicdConnections client callback =
#endif
handleConnection :: Assistant ()
-handleConnection = reconnectRemotes True =<< networkRemotes
+handleConnection = do
+ liftIO . sendNotification . networkConnectedNotifier =<< getDaemonStatus
+ reconnectRemotes True =<< networkRemotes
{- Network remotes to sync with. -}
networkRemotes :: Assistant [Remote]
diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs
new file mode 100644
index 000000000..86a42514d
--- /dev/null
+++ b/Assistant/Threads/Upgrader.hs
@@ -0,0 +1,87 @@
+{- git-annex assistant thread to detect when upgrade is needed
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Assistant.Threads.Upgrader (
+ upgraderThread
+) where
+
+import Assistant.Common
+import Assistant.Types.UrlRenderer
+import Assistant.DaemonStatus
+import Assistant.Alert
+import Utility.NotificationBroadcaster
+import Utility.Tmp
+import qualified Build.SysConfig
+import qualified Utility.Url as Url
+import qualified Annex.Url as Url
+import qualified Git.Version
+import Types.Distribution
+#ifdef WITH_WEBAPP
+import Assistant.WebApp.Types
+#endif
+
+import Data.Time.Clock
+import qualified Data.Text as T
+
+upgraderThread :: UrlRenderer -> NamedThread
+upgraderThread urlrenderer = namedThread "Upgrader" $ do
+ checkUpgrade urlrenderer -- TODO: remove
+ when (isJust Build.SysConfig.upgradelocation) $ do
+ h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus
+ go h Nothing
+ where
+ {- Wait for a network connection event. Then see if it's been
+ - half a day since the last upgrade check. If so, proceed with
+ - check. -}
+ go h lastchecked = do
+ liftIO $ waitNotification h
+ now <- liftIO getCurrentTime
+ if maybe True (\t -> diffUTCTime now t > halfday) lastchecked
+ then do
+ checkUpgrade urlrenderer
+ go h =<< Just <$> liftIO getCurrentTime
+ else go h lastchecked
+ halfday = 12 * 60 * 60
+
+checkUpgrade :: UrlRenderer -> Assistant ()
+checkUpgrade urlrenderer = do
+ debug [ "Checking if an upgrade is available." ]
+ go =<< getDistributionInfo
+ where
+ go Nothing = debug [ "Failed to check if upgrade is available." ]
+ go (Just d) = do
+ let installed = Git.Version.normalize Build.SysConfig.packageversion
+ let avail = Git.Version.normalize $ distributionVersion d
+ let old = Git.Version.normalize <$> distributionUrgentUpgrade d
+ if Just installed <= old
+ then canUpgrade Low urlrenderer d
+ else when (installed < avail) $
+ canUpgrade High urlrenderer d
+
+canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant ()
+canUpgrade urgency urlrenderer d = do
+#ifdef WITH_WEBAPP
+ button <- mkAlertButton False (T.pack "Upgrade") urlrenderer (ConfigUpgradeR d)
+ void $ addAlert (canUpgradeAlert urgency button)
+#else
+ noop
+#endif
+
+getDistributionInfo :: Assistant (Maybe GitAnnexDistribution)
+getDistributionInfo = do
+ ua <- liftAnnex Url.getUserAgent
+ liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do
+ hClose h
+ ifM (Url.downloadQuiet distributionInfoUrl [] [] tmpfile ua)
+ ( readish <$> readFileStrict tmpfile
+ , return Nothing
+ )
+
+distributionInfoUrl :: String
+distributionInfoUrl = fromJust Build.SysConfig.upgradelocation ++ "/info"
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index b380094d6..2ad61168e 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -30,6 +30,7 @@ import Assistant.WebApp.Configurators.Preferences
import Assistant.WebApp.Configurators.Edit
import Assistant.WebApp.Configurators.Delete
import Assistant.WebApp.Configurators.Fsck
+import Assistant.WebApp.Configurators.Upgrade
import Assistant.WebApp.Documentation
import Assistant.WebApp.Control
import Assistant.WebApp.OtherRepos