Warn about unsupported core.sharedRepository=0xxx when set

This spams the user with a lot of messages, but it seems like busywork to
avoid that and only warn once, since this warning will go away when it gets
implemented.

Also fix parsing of the octal value.

Sponsored-by: Kevin Mueller on Patreon

Annex/Perms.hs

@@ -1,6 +1,6 @@
 {- git-annex file permissions
  -
- - Copyright 2012-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -45,6 +45,7 @@ import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
 
 import System.PosixCompat.Files (fileMode, intersectFileModes, nullFileMode, groupWriteMode, ownerWriteMode, ownerReadMode, groupReadMode, stdFileMode, ownerExecuteMode, groupExecuteMode)
+import Numeric
 
 withShared :: (SharedRepository -> Annex a) -> Annex a
 withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig
@@ -64,21 +65,28 @@ setAnnexPerm = setAnnexPerm' Nothing
 
 setAnnexPerm' :: Maybe ([FileMode] -> FileMode -> FileMode) -> Bool -> RawFilePath -> Annex ()
 setAnnexPerm' modef isdir file = unlessM crippledFileSystem $
-	withShared $ liftIO . go
+	withShared go
   where
-	go GroupShared = void $ tryIO $ modifyFileMode file $ modef' $
+	go GroupShared = void $ liftIO $ tryIO $ modifyFileMode file $ modef' $
 		groupSharedModes ++
 		if isdir then [ ownerExecuteMode, groupExecuteMode ] else []
-	go AllShared = void $ tryIO $ modifyFileMode file $ modef' $
+	go AllShared = void $ liftIO $ tryIO $ modifyFileMode file $ modef' $
 		readModes ++
 		[ ownerWriteMode, groupWriteMode ] ++
 		if isdir then executeModes else []
-	go _ = case modef of
+	go UnShared = case modef of
 		Nothing -> noop
-		Just f -> void $ tryIO $
+		Just f -> void $ liftIO $ tryIO $
 			modifyFileMode file $ f []
+	go (UmaskShared n) = do
+		warnUmaskSharedUnsupported n
+		go UnShared
 	modef' = fromMaybe addModes modef
 
+warnUmaskSharedUnsupported :: Int -> Annex ()
+warnUmaskSharedUnsupported n = warning $ UnquotedString $
+	"core.sharedRepository set to a umask override (0" ++ showOct n "" ++ ") is not supported by git-annex; ignoring that configuration"
+
 resetAnnexFilePerm :: RawFilePath -> Annex ()
 resetAnnexFilePerm = resetAnnexPerm False
 
@@ -101,11 +109,14 @@ resetAnnexPerm isdir file = unlessM crippledFileSystem $ do
  - taken into account; this is for use with actions that create the file
  - and apply the umask automatically. -}
 annexFileMode :: Annex FileMode
-annexFileMode = withShared $ return . go
+annexFileMode = withShared go
   where
-	go GroupShared = sharedmode
+	go GroupShared = return sharedmode
-	go AllShared = combineModes (sharedmode:readModes)
+	go AllShared = return $ combineModes (sharedmode:readModes)
-	go _ = stdFileMode
+	go UnShared = return stdFileMode
+	go (UmaskShared n) = do
+		warnUmaskSharedUnsupported n
+		go UnShared
 	sharedmode = combineModes groupSharedModes
 
 {- Creates a directory inside the gitAnnexDir (or possibly the dbdir), 
@@ -178,7 +189,10 @@ freezeContent'' sr file rv = do
 			(readModes ++ writeModes)
 		else liftIO $ ignoresharederr $ 
 			nowriteadd readModes
-	go _ = liftIO $ nowriteadd [ownerReadMode]
+	go UnShared = liftIO $ nowriteadd [ownerReadMode]
+	go (UmaskShared n) = do
+		warnUmaskSharedUnsupported n
+		go UnShared
 
 	ignoresharederr = void . tryIO
 
@@ -206,8 +220,8 @@ checkContentWritePerm file = ifM crippledFileSystem
 	, do
 		rv <- getVersion
 		hasfreezehook <- hasFreezeHook
-		withShared $ \sr -> liftIO $
+		withShared $ \sr ->
-			checkContentWritePerm' sr file rv hasfreezehook
+			liftIO $ checkContentWritePerm' sr file rv hasfreezehook
 	)
 
 checkContentWritePerm' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> Bool -> IO (Maybe Bool)
@@ -222,7 +236,9 @@ checkContentWritePerm' sr file rv hasfreezehook
 			| versionNeedsWritableContentFiles rv -> 
 				want sharedret (includemodes writeModes)
 			| otherwise -> want sharedret (excludemodes writeModes)
-		_ -> want Just (excludemodes writeModes)
+		UnShared -> want Just (excludemodes writeModes)
+		UmaskShared _ ->
+			checkContentWritePerm' UnShared file rv hasfreezehook
   where
 	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)
 		>>= return . \case
@@ -247,7 +263,10 @@ thawContent' sr file = do
   where
 	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead file
 	go AllShared = liftIO $ void $ tryIO $ groupWriteRead file
-	go _ = liftIO $ allowWrite file
+	go UnShared = liftIO $ allowWrite file
+	go (UmaskShared n) = do
+		warnUmaskSharedUnsupported n
+		go UnShared
 
 {- Runs an action that thaws a file's permissions. This will probably
  - fail on a crippled filesystem. But, if file modes are supported on a
@@ -273,7 +292,10 @@ freezeContentDir file = do
 	dir = parentDir file
 	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead dir
 	go AllShared = liftIO $ void $ tryIO $ groupWriteRead dir
-	go _ = liftIO $ preventWrite dir
+	go UnShared = liftIO $ preventWrite dir
+	go (UmaskShared n) = do
+		warnUmaskSharedUnsupported n
+		go UnShared
 
 thawContentDir :: RawFilePath -> Annex ()
 thawContentDir file = do

CHANGELOG

@@ -29,6 +29,7 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
     --json-error-messages is enabled, output a JSON object indicating the
     problem. (But git ls-files --error-unmatch still displays errors about
     such files in some situations.)
+  * Warn about unsupported core.sharedRepository=0xxx when set.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Git/ConfigTypes.hs

@@ -1,6 +1,6 @@
 {- git config types
  -
- - Copyright 2012, 2017 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,6 +10,7 @@
 module Git.ConfigTypes where
 
 import Data.Char
+import Numeric
 import qualified Data.ByteString.Char8 as S8
 
 import Common
@@ -31,7 +32,8 @@ getSharedRepository r =
 			"all" -> AllShared
 			"world" -> AllShared
 			"everybody" -> AllShared
-			_ -> maybe UnShared UmaskShared (readish (decodeBS v))
+			_ -> maybe UnShared UmaskShared 
+				(fmap fst $ headMaybe $ readOct $ decodeBS v)
 		Just NoConfigValue -> UnShared
 		Nothing -> UnShared
 

doc/todo/sharedRepository_mode_not_supported_by_git-annex/comment_2_7140ad0abbb54f5a4e20b165a08793e2._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 2"""
+ date="2023-04-26T16:50:23Z"
+ content="""
+I don't think it would be that hard to implement, I count 6 places, all in
+Annex.Perms that don't handle UmaskShared.
+
+For now I've made all of them display a warning.
+
+(Note that your warning patch to datalad is probably buggy, 
+since core.sharedrepository=1 and =2 are supported by git-annex.
+(As legacy alternatives to "group" and "everybody".))
+"""]]