From 31d43c63a49e63f8527b9a7ca6c14f3cd1401a78 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 22 Nov 2013 16:04:20 -0400
Subject: [PATCH] annex.autoupgrade setting

---
 Assistant/Threads/Upgrader.hs | 18 ++++++++++++------
 Types/Distribution.hs         | 16 ++++++++++++++++
 Types/GitConfig.hs            |  3 +++
 doc/git-annex.mdwn            | 17 ++++++++++++++++-
 4 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/Assistant/Threads/Upgrader.hs b/Assistant/Threads/Upgrader.hs
index 95000fbef1..c6cf825205 100644
--- a/Assistant/Threads/Upgrader.hs
+++ b/Assistant/Threads/Upgrader.hs
@@ -17,6 +17,7 @@ import Assistant.DaemonStatus
 import Assistant.Alert
 import Utility.NotificationBroadcaster
 import Utility.Tmp
+import qualified Annex
 import qualified Build.SysConfig
 import qualified Utility.Url as Url
 import qualified Annex.Url as Url
@@ -31,6 +32,7 @@ import qualified Data.Text as T
 
 upgraderThread :: UrlRenderer -> NamedThread
 upgraderThread urlrenderer = namedThread "Upgrader" $ do
+	checkUpgrade urlrenderer
 	when (isJust Build.SysConfig.upgradelocation) $ do
 		h <- liftIO . newNotificationHandle False . networkConnectedNotifier =<< getDaemonStatus
 		go h Nothing
@@ -40,12 +42,16 @@ upgraderThread urlrenderer = namedThread "Upgrader" $ do
 	 - 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
+		autoupgrade <- liftAnnex $ annexAutoUpgrade <$> Annex.getGitConfig
+		if autoupgrade == NoAutoUpgrade
+			then go h lastchecked
+			else do
+				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 ()
diff --git a/Types/Distribution.hs b/Types/Distribution.hs
index 4382dd0728..4201f49ad8 100644
--- a/Types/Distribution.hs
+++ b/Types/Distribution.hs
@@ -9,6 +9,7 @@ module Types.Distribution where
 
 import Types.Key
 import Data.Time.Clock
+import Git.Config (isTrue, boolConfig)
 
 data GitAnnexDistribution = GitAnnexDistribution
 	{ distributionUrl :: String
@@ -20,3 +21,18 @@ data GitAnnexDistribution = GitAnnexDistribution
 	deriving (Read, Show, Eq)
 
 type GitAnnexVersion = String
+
+data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade
+	deriving (Eq)
+
+toAutoUpgrade :: (Maybe String) -> AutoUpgrade
+toAutoUpgrade Nothing = AskUpgrade
+toAutoUpgrade (Just s)
+	| s == "ask" = AskUpgrade
+	| isTrue s == Just True = AutoUpgrade
+	| otherwise = NoAutoUpgrade
+
+fromAutoUpgrade :: AutoUpgrade -> String
+fromAutoUpgrade AskUpgrade = "ask"
+fromAutoUpgrade AutoUpgrade = boolConfig True
+fromAutoUpgrade NoAutoUpgrade = boolConfig False
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index b573a9a254..7224f43ff9 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -17,6 +17,7 @@ import qualified Git
 import qualified Git.Config
 import Utility.DataUnits
 import Config.Cost
+import Types.Distribution
 
 {- Main git-annex settings. Each setting corresponds to a git-config key
  - such as annex.foo -}
@@ -42,6 +43,7 @@ data GitConfig = GitConfig
 	, annexCrippledFileSystem :: Bool
 	, annexLargeFiles :: Maybe String
 	, annexFsckNudge :: Bool
+	, annexAutoUpgrade :: AutoUpgrade
 	, coreSymlinks :: Bool
 	, gcryptId :: Maybe String
 	}
@@ -70,6 +72,7 @@ extractGitConfig r = GitConfig
 	, annexCrippledFileSystem = getbool (annex "crippledfilesystem") False
 	, annexLargeFiles = getmaybe (annex "largefiles")
 	, annexFsckNudge = getbool (annex "fscknudge") True
+	, annexAutoUpgrade = toAutoUpgrade $ getmaybe (annex "autoupgrade")
 	, coreSymlinks = getbool "core.symlinks" True
 	, gcryptId = getmaybe "core.gcrypt-id"
 	}
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 15b8fd2048..25e1045db2 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -544,7 +544,7 @@ subdirectories).
   to their local `git-annex` branches. So the forgetfulness will automatically
   propigate out from its starting point until all repositories running
   git-annex have forgotten their old history. (You may need to force
-  git to push the branch to any git repositories not running git-annex.
+  git to push the branch to any git repositories not running git-annex.)
 
 * `repair`
 
@@ -1147,6 +1147,21 @@ Here are all the supported configuration settings.
   When set to false, prevents the webapp from reminding you when using
   repositories that lack consistency checks.
 
+* `annex.autoupgrade`
+
+  When set to ask (the default), the webapp will check for new versions
+  and prompt if they should be upgraded to. When set to true, automatically
+  upgrades without prompting (on some supported platforms). When set to
+  false, disables any upgrade checking.
+
+  Note that upgrade checking is only done when git-annex is installed
+  from one of the prebuilt images from its website. This does not
+  bypass eg, a Linux distribution's own upgrade handling code.
+
+  This setting also controls whether to restart the git-annex assistant
+  when the git-annex binary is detected to have changed. That is useful
+  no matter how you installed git-annex.
+
 * `annex.autocommit`
 
   Set to false to prevent the git-annex assistant from automatically