add upgrade.log

The upgrade from V9 uses this to avoid an automatic upgrade until 1 year
after the V9 update. It can also be used in future such situations.

Sponsored-by: Dartmouth College's Datalad project

Annex/Locations.hs

@@ -1,6 +1,6 @@
 {- git-annex file locations
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -44,6 +44,8 @@ module Annex.Locations (
 	gitAnnexFsckDbDirOld,
 	gitAnnexFsckDbLock,
 	gitAnnexFsckResultsLog,
+	gitAnnexUpgradeLog,
+	gitAnnexUpgradeLock,
 	gitAnnexSmudgeLog,
 	gitAnnexSmudgeLock,
 	gitAnnexMoveLog,
@@ -345,6 +347,13 @@ gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath
 gitAnnexFsckResultsLog u r = 
 	gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u
 
+{- .git/annex/upgrade.log is used to record repository version upgrades. -}
+gitAnnexUpgradeLog :: Git.Repo -> RawFilePath
+gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log"
+
+gitAnnexUpgradeLock :: Git.Repo -> RawFilePath
+gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck"
+
 {- .git/annex/smudge.log is used to log smudges worktree files that need to
  - be updated. -}
 gitAnnexSmudgeLog :: Git.Repo -> RawFilePath

Logs/Upgrade.hs

@@ -0,0 +1,52 @@
+{- git-annex upgrade log
+ -
+ - This file is stored locally in .git/annex/, not in the git-annex branch.
+ -
+ - The format: "version timestamp"
+ -
+ - Copyright 2022 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Logs.Upgrade (
+	writeUpgradeLog,
+	readUpgradeLog,
+	timeOfUpgrade,
+) where
+
+import Annex.Common
+import Utility.TimeStamp
+import Logs.File
+import Types.RepoVersion
+
+import Data.Time.Clock.POSIX
+
+writeUpgradeLog :: RepoVersion -> POSIXTime-> Annex ()
+writeUpgradeLog v t = do
+	logfile <- fromRepo gitAnnexUpgradeLog
+	appendLogFile logfile gitAnnexUpgradeLock $ encodeBL $
+		show (fromRepoVersion v) ++ " " ++ show t
+
+readUpgradeLog :: Annex [(RepoVersion, POSIXTime)]
+readUpgradeLog = do
+	logfile <- fromRawFilePath <$> fromRepo gitAnnexUpgradeLog
+	ifM (liftIO $ doesFileExist logfile)
+		( mapMaybe parse . lines
+			<$> liftIO (readFileStrict logfile)
+		, return []
+		)
+  where
+	parse line = case (readish sint, parsePOSIXTime ts) of
+		(Just v, Just t) -> Just (RepoVersion v, t)
+		_ -> Nothing
+	  where
+		(sint, ts) = separate (== ' ') line
+
+timeOfUpgrade :: RepoVersion -> Annex (Maybe POSIXTime)
+timeOfUpgrade want = do
+	l <- readUpgradeLog
+	return $ case filter (\(v, _) -> v == want) l of
+		[] -> Nothing
+		l' -> Just (minimum (map snd l'))
+

Upgrade.hs

@@ -17,6 +17,7 @@ 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
@@ -31,6 +32,7 @@ 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
@@ -85,7 +87,7 @@ upgrade automatic destversion = do
 
 	postupgrade newversion = ifM upgradingRemote
 		( reloadConfig
-		, maybe noop setVersion newversion
+		, maybe noop upgradedto newversion
 		)
 
 #ifndef mingw32_HOST_OS
@@ -120,5 +122,9 @@ upgrade automatic destversion = do
 				_ -> (False, Nothing)
 			)
 
+	upgradedto v = do
+		setVersion v
+		writeUpgradeLog v =<< liftIO getPOSIXTime
+
 upgradingRemote :: Annex Bool
 upgradingRemote = isJust <$> fromRepo Git.remoteName

Upgrade/V8.hs

@@ -13,20 +13,7 @@ import Utility.Daemon
 
 upgrade :: Bool -> Annex UpgradeResult
 upgrade automatic = do
-	-- Skip running when git-annex assistant (or watch) is running,
-	-- because these are long-running daemons that could conceivably
-	-- run for an entire year, and so still be running when the v10
-	-- upgrade happens. If the assistant then tried to drop a file
-	-- after the v10 upgrade, it would use the wrong content file
-	-- locking, which could lead to data loss. The remotedaemon does
-	-- not drop content, so will not block the upgrade.
-	pidfile <- fromRepo gitAnnexPidFile
-	liftIO (checkDaemon (fromRawFilePath pidfile)) >>= \case
-		Just _pid
-			| automatic -> return UpgradeDeferred
-			| otherwise -> giveup "Cannot upgrade to v9 when git-annex assistant or watch daemon is running."
-		Nothing -> do
-			unless automatic $
-				showAction "v8 to v9"
+	unless automatic $
+		showAction "v8 to v9"
 
-			return UpgradeSuccess
+	return UpgradeSuccess

Upgrade/V9.hs

@@ -13,9 +13,41 @@ import Annex.Content
 import Annex.Perms
 import Git.ConfigTypes
 import Types.RepoVersion
+import Logs.Upgrade
+import Utility.Daemon
+
+import Data.Time.Clock.POSIX
 
 upgrade :: Bool -> Annex UpgradeResult
-upgrade automatic = do
+upgrade automatic
+	| automatic = do
+		-- For automatic upgrade, wait until a year after the v9
+		-- upgrade. This is 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.
+		timeOfUpgrade (RepoVersion 9) >>= \case
+			Nothing -> performUpgrade automatic
+			Just t -> do
+				now <- liftIO getPOSIXTime
+				if now - 365*24*60*60 > t
+					then return UpgradeDeferred
+					else checkassistantrunning $
+						performUpgrade automatic
+	| otherwise = performUpgrade automatic
+  where
+	-- Skip upgrade when git-annex assistant (or watch) is running,
+	-- because these are long-running daemons that could conceivably
+	-- run for an entire year.
+	checkassistantrunning a = do
+		pidfile <- fromRepo gitAnnexPidFile
+		liftIO (checkDaemon (fromRawFilePath pidfile)) >>= \case
+			Just _pid -> return UpgradeDeferred
+			Nothing -> a
+
+performUpgrade :: Bool -> Annex UpgradeResult
+performUpgrade automatic = do
 	unless automatic $
 		showAction "v9 to v10"
 

git-annex.cabal

@@ -943,6 +943,7 @@ Executable git-annex
     Logs.UUID
     Logs.UUIDBased
     Logs.Unused
+    Logs.Upgrade
     Logs.View
     Logs.Web
     Messages