summaryrefslogtreecommitdiff
path: root/Upgrade.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2019-09-01 13:29:55 -0400
committerJoey Hess <joeyh@joeyh.name>2019-09-01 13:42:26 -0400
commitf8451953542b88f270e0b5f8dc4c37d8089c2183 (patch)
tree2821beb42e9c52aebc7d4e00d41e014c1a05d092 /Upgrade.hs
parentb421004d759e7f6e5d2119306d1db15a88365dc1 (diff)
Added annex.autoupgraderepository configuration
Can be set to false to prevent any automatic repository upgrades. Also, removed direct mode specific upgrade code in Annex.Init, and made needsUpgrade always include the name/path of the repo, so if there's a problem it's clear what repo has the problem. And, made needsUpgrade catch any exceptions that might occur during the upgrade, so it can display a more useful error message than just the exception.
Diffstat (limited to 'Upgrade.hs')
-rw-r--r--Upgrade.hs26
1 files changed, 19 insertions, 7 deletions
diff --git a/Upgrade.hs b/Upgrade.hs
index 353572574a..981710de47 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -1,6 +1,6 @@
{- git-annex upgrade support
-
- - Copyright 2010, 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@@ -10,6 +10,8 @@
module Upgrade where
import Annex.Common
+import qualified Annex
+import qualified Git
import Annex.Version
import Types.RepoVersion
#ifndef mingw32_HOST_OS
@@ -36,14 +38,23 @@ needsUpgrade v
err "Upgrade this repository: git-annex upgrade"
| otherwise ->
err "Upgrade git-annex."
- Just newv -> ifM (upgrade True newv)
- ( ok
- , err "Automatic upgrade failed!"
+ Just newv -> ifM (annexAutoUpgradeRepository <$> Annex.getGitConfig)
+ ( tryNonAsync (upgrade True newv) >>= \case
+ Right True -> ok
+ Right False -> "Automatic upgrade failed!"
+ Left err -> "Automatic upgrade exception! " ++ show err
+ , err "Automatic upgrade is disabled by annex.autoupgraderepository configuration. To upgrade this repository: git-annex upgrade"
)
where
- err msg = return $ Just $ "Repository version " ++
- show (fromRepoVersion v) ++
- " is not supported. " ++ msg
+ err msg = do
+ g <- Annex.gitRepo
+ p <- liftIO $ absPath $ Git.repoPath g
+ return $ Just $ unwords
+ [ "Repository", p
+ , "is at unsupported version"
+ , show (fromRepoVersion v) ++ "."
+ , msg
+ ]
ok = return Nothing
upgrade :: Bool -> RepoVersion -> Annex Bool
@@ -74,3 +85,4 @@ upgrade automatic destversion = do
up (RepoVersion 5) = Upgrade.V5.upgrade automatic
up (RepoVersion 6) = Upgrade.V6.upgrade automatic
up _ = return True
+