v9 upgrade implemented

Seems to work ok. Unsure yet about the actual locking changes being
correct.

This is not the end of the story with upgrades, because it is unsafe for
this upgrade as implemented to run in a repository where an old
git-annex process is already running. The old process would use the old
locking method, and not notice files locked by the new, and this could
result in data loss. This problem will need to be dealt with before this
branch is suitable for merging.

Sponsored-by: Dartmouth College's Datalad project

Annex/Perms.hs

@@ -1,6 +1,6 @@
 {- git-annex file permissions
  -
- - Copyright 2012-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -16,6 +16,7 @@ module Annex.Perms (
 	noUmask,
 	freezeContent,
 	freezeContent',
+	freezeContent'',
 	checkContentWritePerm,
 	checkContentWritePerm',
 	thawContent,
@@ -149,22 +150,23 @@ freezeContent file = unlessM crippledFileSystem $
 	withShared $ \sr -> freezeContent' sr file
 
 freezeContent' :: SharedRepository -> RawFilePath -> Annex ()
-freezeContent' sr file = do
+freezeContent' sr file = freezeContent'' sr file =<< getVersion
+
+freezeContent'' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> Annex ()
+freezeContent'' sr file rv = do
 	go sr
 	freezeHook file
   where
-	go GroupShared = ifM (versionNeedsWritableContentFiles <$> getVersion)
+	go GroupShared = if versionNeedsWritableContentFiles rv
-		( liftIO $ ignoresharederr $ modmode $ addModes
+		then liftIO $ ignoresharederr $ modmode $ addModes
 			[ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
-		, liftIO $ ignoresharederr $
+		else liftIO $ ignoresharederr $
 			nowriteadd [ownerReadMode, groupReadMode]
-		)
+	go AllShared = if versionNeedsWritableContentFiles rv
-	go AllShared = ifM (versionNeedsWritableContentFiles <$> getVersion)
+		then liftIO $ ignoresharederr $ modmode $ addModes
-		( liftIO $ ignoresharederr $ modmode $ addModes
 			(readModes ++ writeModes)
-		, liftIO $ ignoresharederr $ 
+		else liftIO $ ignoresharederr $ 
 			nowriteadd readModes
-		)
 	go _ = liftIO $ nowriteadd [ownerReadMode]
 
 	ignoresharederr = void . tryIO

Upgrade/V8.hs

@@ -8,10 +8,37 @@
 module Upgrade.V8 where
 
 import Annex.Common
+import Annex.Content
+import Annex.Perms
+import Git.ConfigTypes
+import Types.RepoVersion
 
 upgrade :: Bool -> Annex Bool
 upgrade automatic = do
 	unless automatic $
 		showAction "v8 to v9"
 
+	{- 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 ()
+
 	return True
+  where
+	newver = Just (RepoVersion 9)
+
+	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 newver
+				KeyUnlockedThin -> return ()
+				KeyLockedThin -> return ()
+				KeyMissing -> return ()