cb9cf30c48
This improves performance to a small extent in several places. Sponsored-by: Tobias Ammann on Patreon
103 lines
3.1 KiB
Haskell
103 lines
3.1 KiB
Haskell
{- git-annex v9 -> v10 upgrade support
|
|
-
|
|
- Copyright 2022 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Upgrade.V9 where
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Types.Upgrade
|
|
import Annex.Content
|
|
import Annex.Perms
|
|
import Annex.LockFile
|
|
import Annex.Version
|
|
import Git.ConfigTypes
|
|
import Types.RepoVersion
|
|
import Logs.Upgrade
|
|
import Utility.Daemon
|
|
|
|
import Data.Time.Clock.POSIX
|
|
|
|
upgrade :: Bool -> Annex UpgradeResult
|
|
upgrade automatic
|
|
| automatic = ifM oldprocessesdanger
|
|
( return UpgradeDeferred
|
|
, performUpgrade automatic
|
|
)
|
|
| otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getRead Annex.force))
|
|
( do
|
|
warning $ unlines unsafeupgrade
|
|
return UpgradeDeferred
|
|
, performUpgrade automatic
|
|
)
|
|
where
|
|
{- Wait until a year after the v9 upgrade, to give time for
|
|
- any old processes that were running before the v9 upgrade
|
|
- to finish. Such old processes lock content using the old method,
|
|
- and it is not safe for such to still be running after
|
|
- this upgrade. -}
|
|
oldprocessesdanger = timeOfUpgrade (RepoVersion 9) >>= \case
|
|
Nothing -> pure True
|
|
Just t -> do
|
|
now <- liftIO getPOSIXTime
|
|
if now - 365*24*60*60 > t
|
|
then return True
|
|
else not <$> assistantrunning
|
|
|
|
{- Skip upgrade when git-annex assistant (or watch) is running,
|
|
- because these are long-running daemons that could conceivably
|
|
- run for an entire year and so predate the v9 upgrade. -}
|
|
assistantrunning = do
|
|
pidfile <- fromRepo gitAnnexPidFile
|
|
isJust <$> liftIO (checkDaemon (fromRawFilePath pidfile))
|
|
|
|
unsafeupgrade =
|
|
[ "Not upgrading from v9 to v10, because there may be git-annex"
|
|
, "processes running that predate the v9 upgrade. Upgrading with"
|
|
, "such processes running could lead to data loss. This upgrade"
|
|
, "will be deferred until one year after the v9 upgrade to make"
|
|
, "sure there are no such old processes running."
|
|
, "(Use --force to upgrade immediately.)"
|
|
]
|
|
|
|
performUpgrade :: Bool -> Annex UpgradeResult
|
|
performUpgrade automatic = do
|
|
unless automatic $
|
|
showAction "v9 to v10"
|
|
|
|
{- Take a lock to ensure that there are no other git-annex
|
|
- processes running that are using the old content locking method. -}
|
|
withExclusiveLock gitAnnexContentLockLock $ do
|
|
{- When core.sharedRepository is set, object files
|
|
- used to have their write bits set. That can now be
|
|
- removed, if the user the upgrade is running as has
|
|
- permission to remove it.
|
|
- (Otherwise, a later fsck will fix up the permissions.) -}
|
|
withShared $ \sr -> case sr of
|
|
GroupShared -> removewrite sr
|
|
AllShared -> removewrite sr
|
|
_ -> return ()
|
|
|
|
{- Set the new version while still holding the lock,
|
|
- so that any other process waiting for the lock will
|
|
- be able to detect that the upgrade happened. -}
|
|
setVersion newver
|
|
|
|
return UpgradeSuccess
|
|
where
|
|
newver = RepoVersion 10
|
|
|
|
removewrite sr = do
|
|
ks <- listKeys InAnnex
|
|
forM_ ks $ \k -> do
|
|
obj <- calcRepo (gitAnnexLocation k)
|
|
keystatus <- getKeyStatus k
|
|
case keystatus of
|
|
KeyPresent -> void $ tryIO $
|
|
freezeContent'' sr obj (Just newver)
|
|
KeyUnlockedThin -> return ()
|
|
KeyLockedThin -> return ()
|
|
KeyMissing -> return ()
|