shared repository content file permissions for v9

v9 will not need to write to annex content files in order to lock them,
so freezeContent removes the write bit in a shared repository, the same
as in any other repository.

checkContentWritePerm makes sure that the write perm is not set, which
will let git-annex fsck fix up the permissions. Upgrading to v9
will need to fix the permissions as well, but it seems likely there will
be situations where the user git-annex is running an upgrade as cannot,
so it will have to leave the write bit set. In such a case, git-annex
fsck can fix it later.

Sponsored-by: Dartmouth College's Datalad project

Annex/Init.hs

@@ -282,7 +282,7 @@ probeCrippledFileSystem' tmp freezecontent thawcontent = do
 		-- running as root). But some crippled
 		-- filesystems ignore write bit removals or ignore
 		-- permissions entirely.
-		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f)))
+		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f) Nothing))
 			( return (True, ["Filesystem does not allow removing write bit from files."])
 			, liftIO $ ifM ((== 0) <$> getRealUserID)
 				( return (False, [])

Annex/Perms.hs

@@ -32,6 +32,8 @@ import Utility.FileMode
 import Git
 import Git.ConfigTypes
 import qualified Annex
+import Annex.Version
+import Types.RepoVersion
 import Config
 import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
@@ -127,11 +129,14 @@ createWorkTreeDirectory dir = do
 {- Normally, blocks writing to an annexed file, and modifies file
  - permissions to allow reading it.
  -
- - When core.sharedRepository is set, the write bits are not removed from
+ - Before v9, when core.sharedRepository is set, the write bits are not
- - the file, but instead the appropriate group write bits are set. This is
+ - removed from the file, but instead the appropriate group write bits
- - necessary to let other users in the group lock the file. But, in a
+ - are set. This is necessary to let other users in the group lock the file.
- - shared repository, the current user may not be able to change a file
+ - v9 improved this by using separate lock files, so the content file does
- - owned by another user, so failure to set this mode is ignored.
+ - not need to be writable when using it.
+ -
+ - In a shared repository, the current user may not be able to change
+ - a file owned by another user, so failure to change modes is ignored.
  -
  - Note that, on Linux, xattrs can sometimes prevent removing
  - certain permissions from a file with chmod. (Maybe some ACLs too?) 
@@ -148,13 +153,27 @@ freezeContent' sr file = do
 	go sr
 	freezeHook file
   where
-	go GroupShared = liftIO $ void $ tryIO $ modifyFileMode file $
+	go GroupShared = ifM (versionNeedsWritableContentFiles <$> getVersion)
-		addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
+		( liftIO $ ignoresharederr $ modmode $ addModes
-	go AllShared = liftIO $ void $ tryIO $ modifyFileMode file $
+			[ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
-		addModes (readModes ++ writeModes)
+		, liftIO $ ignoresharederr $
-	go _ = liftIO $ modifyFileMode file $
+			nowriteadd [ownerReadMode, groupReadMode]
+		)
+	go AllShared = ifM (versionNeedsWritableContentFiles <$> getVersion)
+		( liftIO $ ignoresharederr $ modmode $ addModes
+			(readModes ++ writeModes)
+		, liftIO $ ignoresharederr $ 
+			nowriteadd readModes
+		)
+	go _ = liftIO $ nowriteadd [ownerReadMode]
+
+	ignoresharederr = void . tryIO
+
+	modmode = modifyFileMode file
+
+	nowriteadd readmodes = modmode $ 
 		removeModes writeModes .
-		addModes [ownerReadMode]
+		addModes readmodes
 
 {- Checks if the write permissions are as freezeContent should set them.
  -
@@ -166,14 +185,21 @@ freezeContent' sr file = do
 checkContentWritePerm :: RawFilePath -> Annex (Maybe Bool)
 checkContentWritePerm file = ifM crippledFileSystem
 	( return (Just True)
-	, withShared (\sr -> liftIO (checkContentWritePerm' sr file))
+	, do
+		rv <- getVersion
+		withShared (\sr -> liftIO (checkContentWritePerm' sr file rv))
 	)
 
-checkContentWritePerm' :: SharedRepository -> RawFilePath -> IO (Maybe Bool)
+checkContentWritePerm' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> IO (Maybe Bool)
-checkContentWritePerm' sr file = case sr of
+checkContentWritePerm' sr file rv = case sr of
-	GroupShared -> want sharedret
+	GroupShared
+		| versionNeedsWritableContentFiles rv -> want sharedret
 			(includemodes [ownerWriteMode, groupWriteMode])
-	AllShared -> want sharedret (includemodes writeModes)
+		| otherwise -> want sharedret (excludemodes writeModes)
+	AllShared
+		| versionNeedsWritableContentFiles rv -> 
+			want sharedret (includemodes writeModes)
+		| otherwise -> want sharedret (excludemodes writeModes)
 	_ -> want Just (excludemodes writeModes)
   where
 	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)

Annex/Version.hs

@@ -1,6 +1,6 @@
 {- git-annex repository versioning
  -
- - 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.
  -}
@@ -54,3 +54,8 @@ setVersion (RepoVersion v) = setConfig versionField (show v)
 
 removeVersion :: Annex ()
 removeVersion = unsetConfig versionField
+
+versionNeedsWritableContentFiles :: Maybe RepoVersion -> Bool
+versionNeedsWritableContentFiles (Just v) 
+	| v >= RepoVersion 9 = False
+versionNeedsWritableContentFiles _ = True