40ecf58d4b
This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.)
85 lines
2.6 KiB
Haskell
85 lines
2.6 KiB
Haskell
{- git-annex assistant thread to detect when upgrade is available
|
|
-
|
|
- Copyright 2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Assistant.Threads.Upgrader (
|
|
upgraderThread
|
|
) where
|
|
|
|
import Assistant.Common
|
|
import Assistant.Upgrade
|
|
|
|
import Assistant.Types.UrlRenderer
|
|
import Assistant.DaemonStatus
|
|
import Assistant.Alert
|
|
import Utility.NotificationBroadcaster
|
|
import qualified Annex
|
|
import qualified BuildInfo
|
|
import qualified Utility.DottedVersion as DottedVersion
|
|
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" $
|
|
when (isJust BuildInfo.upgradelocation) $ do
|
|
{- Check for upgrade on startup, unless it was just
|
|
- upgraded. -}
|
|
unlessM (liftIO checkSuccessfulUpgrade) $
|
|
checkUpgrade urlrenderer
|
|
h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus
|
|
go h =<< liftIO getCurrentTime
|
|
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
|
|
autoupgrade <- liftAnnex $ annexAutoUpgrade <$> Annex.getGitConfig
|
|
if autoupgrade == NoAutoUpgrade
|
|
then go h lastchecked
|
|
else do
|
|
now <- liftIO getCurrentTime
|
|
if diffUTCTime now lastchecked > halfday
|
|
then do
|
|
checkUpgrade urlrenderer
|
|
go h =<< liftIO getCurrentTime
|
|
else go h lastchecked
|
|
halfday = 12 * 60 * 60
|
|
|
|
checkUpgrade :: UrlRenderer -> Assistant ()
|
|
checkUpgrade urlrenderer = do
|
|
debug [ "Checking if an upgrade is available." ]
|
|
go =<< downloadDistributionInfo
|
|
where
|
|
go Nothing = debug [ "Failed to check if upgrade is available." ]
|
|
go (Just d) = do
|
|
let installed = DottedVersion.normalize BuildInfo.packageversion
|
|
let avail = DottedVersion.normalize $ distributionVersion d
|
|
let old = DottedVersion.normalize <$> distributionUrgentUpgrade d
|
|
if Just installed <= old
|
|
then canUpgrade High urlrenderer d
|
|
else if installed < avail
|
|
then canUpgrade Low urlrenderer d
|
|
else debug [ "No new version found." ]
|
|
|
|
canUpgrade :: AlertPriority -> UrlRenderer -> GitAnnexDistribution -> Assistant ()
|
|
canUpgrade urgency urlrenderer d = ifM autoUpgradeEnabled
|
|
( startDistributionDownload d
|
|
, do
|
|
#ifdef WITH_WEBAPP
|
|
button <- mkAlertButton True (T.pack "Upgrade") urlrenderer (ConfigStartUpgradeR d)
|
|
void $ addAlert (canUpgradeAlert urgency (distributionVersion d) button)
|
|
#else
|
|
noop
|
|
#endif
|
|
)
|