fsck: Warn when core.sharedRepository is set and an annex object file's write bit is not set and cannot be set due to the file being owned by a different user.

Made all Annex.Perms file mode changing functions ignore errors when
core.sharedRepository is set, because the file might be owned by someone
else. I don't fancy getting bug reports about crashes due to set modes in
this configuration, which is a very foot-shooty configuration in the first
place.

The fsck warning is necessary because old repos kept files mode 444, which
doesn't allow locking them, and so if the mode remains 444 due to the file
being owned by someone else, the user should be told about it.

1 files changed, 29 insertions, 11 deletions

diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 4d525c127..644402587 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -12,6 +12,7 @@ module Annex.Perms (
 	createAnnexDirectory,
 	noUmask,
 	freezeContent,
+	isContentWritePermOk,
 	thawContent,
 	chmodContent,
 	createContentDir,
@@ -44,10 +45,10 @@ setAnnexPerm :: Bool -> FilePath -> Annex ()
 setAnnexPerm isdir file = unlessM crippledFileSystem $
 	withShared $ liftIO . go
   where
-	go GroupShared = modifyFileMode file $ addModes $
+	go GroupShared = void $ tryIO $ modifyFileMode file $ addModes $
 		groupSharedModes ++
 		if isdir then [ ownerExecuteMode, groupExecuteMode ] else []
-	go AllShared = modifyFileMode file $ addModes $
+	go AllShared = void $ tryIO $ modifyFileMode file $ addModes $
 		readModes ++
 		[ ownerWriteMode, groupWriteMode ] ++
 		if isdir then executeModes else []
@@ -85,28 +86,45 @@ createAnnexDirectory dir = walk dir [] =<< top
  -
  - When core.sharedRepository is set, the write bits are not removed from
  - the file, but instead the appropriate group write bits are set. This is
- - necessary to let other users in the group lock the file.
+ - necessary to let other users in the group lock the file. But, in a
+ - shared repository, the current user may not be able to change a file
+ - owned by another user, so failure to set this mode is ignored.
  -}
 freezeContent :: FilePath -> Annex ()
 freezeContent file = unlessM crippledFileSystem $
 	withShared go
   where
-	go GroupShared = liftIO $ modifyFileMode file $
+	go GroupShared = liftIO $ void $ tryIO $ modifyFileMode file $
 		addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
-	go AllShared = liftIO $ modifyFileMode file $
+	go AllShared = liftIO $ void $ tryIO $ modifyFileMode file $
 		addModes (readModes ++ writeModes)
 	go _ = liftIO $ modifyFileMode file $
 		removeModes writeModes .
 		addModes [ownerReadMode]
 
+isContentWritePermOk :: FilePath -> Annex Bool
+isContentWritePermOk file = ifM crippledFileSystem
+	( return True
+	, withShared go
+	)
+  where
+	go GroupShared = want [ownerWriteMode, groupWriteMode]
+	go AllShared = want writeModes
+	go _ = return True
+	want wantmode = do
+		mmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+		return $ case mmode of
+			Nothing -> True
+			Just havemode -> havemode == combineModes (havemode:wantmode)
+
 {- Adjusts read mode of annexed file per core.sharedRepository setting. -}
 chmodContent :: FilePath -> Annex ()
 chmodContent file = unlessM crippledFileSystem $
 	withShared go
   where
-	go GroupShared = liftIO $ modifyFileMode file $
+	go GroupShared = liftIO $ void $ tryIO $ modifyFileMode file $
 		addModes [ownerReadMode, groupReadMode]
-	go AllShared = liftIO $ modifyFileMode file $
+	go AllShared = liftIO $ void $ tryIO $ modifyFileMode file $
 		addModes readModes
 	go _ = liftIO $ modifyFileMode file $
 		addModes [ownerReadMode]
@@ -116,8 +134,8 @@ chmodContent file = unlessM crippledFileSystem $
 thawContent :: FilePath -> Annex ()
 thawContent file = thawPerms $ withShared go
   where
-	go GroupShared = liftIO $ groupWriteRead file
-	go AllShared = liftIO $ groupWriteRead file
+	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead file
+	go AllShared = liftIO $ void $ tryIO $ groupWriteRead file
 	go _ = liftIO $ allowWrite file
 
 {- Runs an action that thaws a file's permissions. This will probably
@@ -139,8 +157,8 @@ freezeContentDir file = unlessM crippledFileSystem $
 	withShared go
   where
 	dir = parentDir file
-	go GroupShared = liftIO $ groupWriteRead dir
-	go AllShared = liftIO $ groupWriteRead dir
+	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead dir
+	go AllShared = liftIO $ void $ tryIO $ groupWriteRead dir
 	go _ = liftIO $ preventWrite dir
 
 thawContentDir :: FilePath -> Annex ()