init: check for filesystem where write bit cannot be removed

This fixes a reversion caused by a99a84f342,
when git-annex init is run as root on a FAT filesystem mounted with
hdiutil on OSX. Such a mount point has file mode 777 for everything and
it cannot be changed. The existing crippled filesystem test tried to
write to a file after removing write bit, but that test does not run as
root (since root can write to unwritable files). So added a check of the
write permissions of the file, after attempting to remove them.

Sponsored-by: Dartmouth College's Datalad project

Annex/Init.hs

@@ -258,7 +258,7 @@ probeCrippledFileSystem'
 	-> Maybe (RawFilePath -> m ())
 	-> m (Bool, [String])
 #ifdef mingw32_HOST_OS
-probeCrippledFileSystem' _ _ _ = return (True, [])
+probeCrippledFileSystem' _ _ _ _ = return (True, [])
 #else
 probeCrippledFileSystem' tmp freezecontent thawcontent = do
 	let f = tmp P.</> "gaprobe"
@@ -275,18 +275,22 @@ probeCrippledFileSystem' tmp freezecontent thawcontent = do
 		liftIO $ createSymbolicLink f f2
 		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)
 		(fromMaybe (liftIO . preventWrite) freezecontent) (toRawFilePath f)
-		-- Should be unable to write to the file, unless
-		-- running as root, but some crippled
-		-- filesystems ignore write bit removals.
-		liftIO $ ifM ((== 0) <$> getRealUserID)
-			( return (False, [])
-			, do
-				r <- catchBoolIO $ do
-					writeFile f "2"
-					return True
-				if r
-					then return (True, ["Filesystem allows writing to files whose write bit is not set."])
-					else return (False, [])
+		-- Should be unable to write to the file (unless
+		-- running as root). But some crippled
+		-- filesystems ignore write bit removals or ignore
+		-- permissions entirely.
+		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f)))
+			( return (True, ["Filesystem does not allow removing write bit from files."])
+			, liftIO $ ifM ((== 0) <$> getRealUserID)
+				( return (False, [])
+				, do
+					r <- catchBoolIO $ do
+						writeFile f "2"
+						return True
+					if r
+						then return (True, ["Filesystem allows writing to files whose write bit is not set."])
+						else return (False, [])
+				)
 			)
 #endif
 

Annex/Perms.hs

@@ -17,6 +17,7 @@ module Annex.Perms (
 	freezeContent,
 	freezeContent',
 	checkContentWritePerm,
+	checkContentWritePerm',
 	thawContent,
 	thawContent',
 	createContentDir,
@@ -165,16 +166,18 @@ freezeContent' sr file = do
 checkContentWritePerm :: RawFilePath -> Annex (Maybe Bool)
 checkContentWritePerm file = ifM crippledFileSystem
 	( return (Just True)
-	, withShared go
+	, withShared (\sr -> liftIO (checkContentWritePerm' sr file))
 	)
-  where
-	go GroupShared = want sharedret 
-		(includemodes [ownerWriteMode, groupWriteMode])
-	go AllShared = want sharedret (includemodes writeModes)
-	go _ = want Just (excludemodes writeModes)
 
-	want mk f =
-		liftIO (catchMaybeIO $ fileMode <$> R.getFileStatus file) >>= return . \case
+checkContentWritePerm' :: SharedRepository -> RawFilePath -> IO (Maybe Bool)
+checkContentWritePerm' sr file = case sr of
+	GroupShared -> want sharedret
+		(includemodes [ownerWriteMode, groupWriteMode])
+	AllShared -> want sharedret (includemodes writeModes)
+	_ -> want Just (excludemodes writeModes)
+  where
+	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)
+		>>= return . \case
 			Just havemode -> mk (f havemode)
 			Nothing -> mk True
 	

doc/bugs/2_mac_crippled_FS__58___Unable_to_remove_all_write.mdwn

@@ -38,3 +38,6 @@ Both look like
 
 [[!meta author=yoh]]
 [[!tag projects/datalad]]
+
+> [[fixed|done]] (provisionally; can't test running git-annex as root on
+> OSX) --[[Joey]]

doc/bugs/2_mac_crippled_FS__58___Unable_to_remove_all_write/comment_1_22a1f4b025a6046e4d11f90590a6e4bd._comment

@@ -0,0 +1,34 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2021-09-01T13:48:57Z"
+ content="""
+Seems that mounting that way on OSX results in a FS where files are always mode
+777 and the permissions cannot be changed.
+
+When I tried using git-annex on such a FS, I saw:
+
+	datalads-imac:x joey$ git annex init
+	init
+	  Detected a filesystem without fifo support.
+	
+	  Disabling ssh connection caching.
+	
+	  Filesystem allows writing to files whose write bit is not set.
+	
+	  Detected a crippled filesystem.
+
+And it skips the new permissions check when on a crippled filesystem.
+
+But in that that test run, it seems it is failing to detect a crippled
+filesystem. Both because of the failure and also the test suite does
+not even run the "v8 unlocked" tests when it detects a crippled filesystem.
+
+Is the test suite running as root? Looks like probably yes. Running as
+root prevents detecting the issue that made it use a crippled FS above. And it
+seems that, when a FAT fs is mounted on OSX that way, symlinks actually work
+(!!!) so the other crippled FS tests also don't notice a problem.
+
+So, the fix should be for init to also test if it can remove the write
+bits from a file, and it should try that test even when root.
+"""]]