blob: 4f6585b2ea210f5939139c263f83f762867c450c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
{- git-annex upgrade support
-
- Copyright 2010-2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Upgrade where
import Annex.Common
import Types.Upgrade
import qualified Annex
import qualified Git
import Config
import Annex.Path
import Annex.Version
import Types.RepoVersion
import Logs.Upgrade
#ifndef mingw32_HOST_OS
import qualified Upgrade.V0
import qualified Upgrade.V1
#endif
import qualified Upgrade.V2
import qualified Upgrade.V3
import qualified Upgrade.V4
import qualified Upgrade.V5
import qualified Upgrade.V6
import qualified Upgrade.V7
import qualified Upgrade.V8
import qualified Upgrade.V9
import qualified Data.Map as M
import Data.Time.Clock.POSIX
checkUpgrade :: RepoVersion -> Annex ()
checkUpgrade = maybe noop giveup <=< needsUpgrade
needsUpgrade :: RepoVersion -> Annex (Maybe String)
needsUpgrade v
| v `elem` supportedVersions = case M.lookup v autoUpgradeableVersions of
Just newv | newv /= v -> ifM (annexAutoUpgradeRepository <$> Annex.getGitConfig)
( runupgrade newv
, ok
)
_ -> ok
| otherwise = case M.lookup v autoUpgradeableVersions of
Nothing
| v `elem` upgradeableVersions ->
err "Upgrade this repository: git-annex upgrade"
| otherwise ->
err "Upgrade git-annex."
Just newv -> ifM (annexAutoUpgradeRepository <$> Annex.getGitConfig)
( runupgrade newv
, err "Automatic upgrade is disabled by annex.autoupgraderepository configuration. To upgrade this repository: git-annex upgrade"
)
where
err msg = do
g <- Annex.gitRepo
p <- liftIO $ absPath $ Git.repoPath g
return $ Just $ unwords
[ "Repository", fromRawFilePath p
, "is at"
, if v `elem` supportedVersions
then "supported"
else "unsupported"
, "version"
, show (fromRepoVersion v) ++ "."
, msg
]
ok = return Nothing
runupgrade newv = tryNonAsync (upgrade True newv) >>= \case
Right True -> ok
Right False -> err "Automatic upgrade failed!"
Left ex -> err $ "Automatic upgrade exception! " ++ show ex
upgrade :: Bool -> RepoVersion -> Annex Bool
upgrade automatic destversion = go =<< getVersion
where
go (Just v)
| v >= destversion = return True
| otherwise = ifM upgradingRemote
( upgraderemote
, up v >>= \case
UpgradeSuccess -> do
let v' = incrversion v
upgradedto v'
go (Just v')
UpgradeFailed -> return False
UpgradeDeferred -> return True
)
go Nothing = return True
incrversion v = RepoVersion (fromRepoVersion v + 1)
#ifndef mingw32_HOST_OS
up (RepoVersion 0) = Upgrade.V0.upgrade
up (RepoVersion 1) = Upgrade.V1.upgrade
#else
up (RepoVersion 0) = giveup "upgrade from v0 on Windows not supported"
up (RepoVersion 1) = giveup "upgrade from v1 on Windows not supported"
#endif
up (RepoVersion 2) = Upgrade.V2.upgrade
up (RepoVersion 3) = Upgrade.V3.upgrade automatic
up (RepoVersion 4) = Upgrade.V4.upgrade automatic
up (RepoVersion 5) = Upgrade.V5.upgrade automatic
up (RepoVersion 6) = Upgrade.V6.upgrade automatic
up (RepoVersion 7) = Upgrade.V7.upgrade automatic
up (RepoVersion 8) = Upgrade.V8.upgrade automatic
up (RepoVersion 9) = Upgrade.V9.upgrade automatic
up _ = return UpgradeDeferred
-- Upgrade local remotes by running git-annex upgrade in them.
-- This avoids complicating the upgrade code by needing to handle
-- upgrading a git repo other than the current repo.
upgraderemote = do
rp <- fromRawFilePath <$> fromRepo Git.repoPath
ok <- gitAnnexChildProcess "upgrade"
[ Param "--quiet"
, Param "--autoonly"
]
(\p -> p { cwd = Just rp })
(\_ _ _ pid -> waitForProcess pid >>= return . \case
ExitSuccess -> True
_ -> False
)
when ok
reloadConfig
return ok
upgradedto v = do
setVersion v
writeUpgradeLog v =<< liftIO getPOSIXTime
upgradingRemote :: Annex Bool
upgradingRemote = isJust <$> fromRepo Git.remoteName
|
