avoid annexFileMode special case

This makes annexFileMode be just an application of setAnnexPerm',
which avoids having 2 functions that do different versions of the same
thing.

Fixes some buggy behavior for some combinations of core.sharedRepository
and umask.

Sponsored-by: Jack Hill on Patreon

Annex/Content.hs

@@ -102,6 +102,7 @@ import Logs.Location
 import Utility.InodeCache
 import Utility.CopyFile
 import Utility.Metered
+import Utility.FileMode
 import qualified Utility.RawFilePath as R
 
 import qualified System.FilePath.ByteString as P
@@ -171,7 +172,7 @@ lockContentForRemoval key fallback a = lockContentUsing lock key fallback $
 type ContentLocker = RawFilePath -> Maybe LockFile -> (Annex (Maybe LockHandle), Maybe (Annex (Maybe LockHandle)))
 
 #ifndef mingw32_HOST_OS
-posixLocker :: (Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle)
+posixLocker :: (Maybe ModeSetter -> LockFile -> Annex (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle)
 posixLocker takelock lockfile = do
 	mode <- annexFileMode
 	modifyContentDirWhenExists lockfile $

Annex/LockFile.hs

@@ -36,7 +36,7 @@ lockFileCached file = go =<< fromLockCache file
 	go Nothing = do
 #ifndef mingw32_HOST_OS
 		mode <- annexFileMode
-		lockhandle <- noUmask mode $ lockShared (Just mode) file
+		lockhandle <- lockShared (Just mode) file
 #else
 		lockhandle <- liftIO $ waitToLock $ lockShared file
 #endif
@@ -69,7 +69,7 @@ withSharedLock lockfile a = debugLocks $ do
 	bracket (lock mode lockfile) (liftIO . dropLock) (const a)
   where
 #ifndef mingw32_HOST_OS
-	lock mode = noUmask mode . lockShared (Just mode)
+	lock mode = lockShared (Just mode)
 #else
 	lock _mode = liftIO . waitToLock . lockShared
 #endif
@@ -90,7 +90,7 @@ takeExclusiveLock lockfile = debugLocks $ do
 	lock mode lockfile
   where
 #ifndef mingw32_HOST_OS
-	lock mode = noUmask mode . lockExclusive (Just mode)
+	lock mode = lockExclusive (Just mode)
 #else
 	lock _mode = liftIO . waitToLock . lockExclusive
 #endif
@@ -104,7 +104,7 @@ tryExclusiveLock lockfile a = debugLocks $ do
 	bracket (lock mode lockfile) (liftIO . unlock) go
   where
 #ifndef mingw32_HOST_OS
-	lock mode = noUmask mode . tryLockExclusive (Just mode)
+	lock mode = tryLockExclusive (Just mode)
 #else
 	lock _mode = liftIO . lockExclusive
 #endif

Annex/LockPool/PosixOrPid.hs

@@ -26,6 +26,7 @@ import qualified Annex
 import qualified Utility.LockPool.Posix as Posix
 import qualified Utility.LockPool.PidLock as Pid
 import qualified Utility.LockPool.LockHandle as H
+import Utility.FileMode
 import Utility.LockPool.LockHandle (LockHandle, dropLock)
 import Utility.LockFile.Posix (openLockFile)
 import Utility.LockPool.STM (LockFile, LockMode(..))
@@ -36,16 +37,16 @@ import Git.Quote
 
 import System.Posix
 
-lockShared :: Maybe FileMode -> LockFile -> Annex LockHandle
+lockShared :: Maybe ModeSetter -> LockFile -> Annex LockHandle
 lockShared m f = pidLock m f LockShared $ Posix.lockShared m f
 
-lockExclusive :: Maybe FileMode -> LockFile -> Annex LockHandle
+lockExclusive :: Maybe ModeSetter -> LockFile -> Annex LockHandle
 lockExclusive m f = pidLock m f LockExclusive $ Posix.lockExclusive m f
 
-tryLockShared :: Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)
+tryLockShared :: Maybe ModeSetter -> LockFile -> Annex (Maybe LockHandle)
 tryLockShared m f = tryPidLock m f LockShared $ Posix.tryLockShared m f
 
-tryLockExclusive :: Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)
+tryLockExclusive :: Maybe ModeSetter -> LockFile -> Annex (Maybe LockHandle)
 tryLockExclusive m f = tryPidLock m f LockExclusive $ Posix.tryLockExclusive m f
 
 checkLocked :: LockFile -> Annex (Maybe Bool)
@@ -68,7 +69,7 @@ pidLockCheck :: IO a -> (LockFile -> IO a) -> Annex a
 pidLockCheck posixcheck pidcheck = debugLocks $
 	liftIO . maybe posixcheck pidcheck =<< pidLockFile
 
-pidLock :: Maybe FileMode -> LockFile -> LockMode -> IO LockHandle -> Annex LockHandle
+pidLock :: Maybe ModeSetter -> LockFile -> LockMode -> IO LockHandle -> Annex LockHandle
 pidLock m f lockmode posixlock = debugLocks $ go =<< pidLockFile
   where
 	go Nothing = liftIO posixlock
@@ -77,7 +78,7 @@ pidLock m f lockmode posixlock = debugLocks $ go =<< pidLockFile
 		liftIO $ dummyPosixLock m f
 		Pid.waitLock f lockmode timeout pidlock (warning . UnquotedString)
 
-tryPidLock :: Maybe FileMode -> LockFile -> LockMode -> IO (Maybe LockHandle) -> Annex (Maybe LockHandle)
+tryPidLock :: Maybe ModeSetter -> LockFile -> LockMode -> IO (Maybe LockHandle) -> Annex (Maybe LockHandle)
 tryPidLock m f lockmode posixlock = debugLocks $ liftIO . go =<< pidLockFile
   where
 	go Nothing = posixlock
@@ -88,5 +89,5 @@ tryPidLock m f lockmode posixlock = debugLocks $ liftIO . go =<< pidLockFile
 -- The posix lock file is created even when using pid locks, in order to
 -- avoid complicating any code that might expect to be able to see that
 -- lock file. But, it's not locked.
-dummyPosixLock :: Maybe FileMode -> LockFile -> IO ()
+dummyPosixLock :: Maybe ModeSetter -> LockFile -> IO ()
 dummyPosixLock m f = bracket (openLockFile ReadLock m f) closeFd (const noop)

Annex/Perms.hs

@@ -15,7 +15,6 @@ module Annex.Perms (
 	annexFileMode,
 	createAnnexDirectory,
 	createWorkTreeDirectory,
-	noUmask,
 	freezeContent,
 	freezeContent',
 	freezeContent'',
@@ -60,24 +59,26 @@ setAnnexDirPerm = setAnnexPerm True
  - don't change the mode, but with core.sharedRepository set,
  - allow the group to write, etc. -}
 setAnnexPerm :: Bool -> RawFilePath -> Annex ()
-setAnnexPerm = setAnnexPerm' Nothing
+setAnnexPerm isdir file = setAnnexPerm' Nothing isdir >>= \go -> liftIO (go file)
 
-setAnnexPerm' :: Maybe ([FileMode] -> FileMode -> FileMode) -> Bool -> RawFilePath -> Annex ()
+setAnnexPerm' :: Maybe ([FileMode] -> FileMode -> FileMode) -> Bool -> Annex (RawFilePath -> IO ())
-setAnnexPerm' modef isdir file = unlessM crippledFileSystem $
+setAnnexPerm' modef isdir = ifM crippledFileSystem
-	withShared go
+	( return (const noop)
+	, withShared $ \s -> return $ \file -> go s file
+	)
   where
-	go GroupShared = void $ liftIO $ tryIO $ modifyFileMode file $ modef' $
+	go GroupShared file = void $ tryIO $ modifyFileMode file $ modef' $
 		groupSharedModes ++
 		if isdir then [ ownerExecuteMode, groupExecuteMode ] else []
-	go AllShared = void $ liftIO $ tryIO $ modifyFileMode file $ modef' $
+	go AllShared file = void $ tryIO $ modifyFileMode file $ modef' $
 		readModes ++
 		[ ownerWriteMode, groupWriteMode ] ++
 		if isdir then executeModes else []
-	go UnShared = case modef of
+	go UnShared file = case modef of
 		Nothing -> noop
-		Just f -> void $ liftIO $ tryIO $
+		Just f -> void $ tryIO $
 			modifyFileMode file $ f []
-	go (UmaskShared n) = void $ liftIO $ tryIO $ R.setFileMode file $
+	go (UmaskShared n) file = void $ tryIO $ R.setFileMode file $
 		if isdir then umaskSharedDirectory n else n
 	modef' = fromMaybe addModes modef
 
@@ -96,20 +97,19 @@ resetAnnexPerm :: Bool -> RawFilePath -> Annex ()
 resetAnnexPerm isdir file = unlessM crippledFileSystem $ do
 	defmode <- liftIO defaultFileMode
 	let modef moremodes _oldmode = addModes moremodes defmode
-	setAnnexPerm' (Just modef) isdir file
+	setAnnexPerm' (Just modef) isdir >>= \go -> liftIO (go file)
 
-{- Gets the appropriate mode to use for creating a file in the annex
+{- Creates a ModeSetter which can be used for creating a file in the annex
- - (other than content files, which are locked down more). The umask is not
+ - (other than content files, which are locked down more). -}
- - taken into account; this is for use with actions that create the file
+annexFileMode :: Annex ModeSetter
- - and apply the umask automatically. -}
+annexFileMode = do
-annexFileMode :: Annex FileMode
+	modesetter <- setAnnexPerm' Nothing False
-annexFileMode = withShared (pure . go)
+	withShared (\s -> pure $ mk s modesetter)
   where
-	go GroupShared = sharedmode
+	mk GroupShared = ModeSetter stdFileMode
-	go AllShared = combineModes (sharedmode:readModes)
+	mk AllShared = ModeSetter stdFileMode
-	go UnShared = stdFileMode
+	mk UnShared = ModeSetter stdFileMode
-	go (UmaskShared n) = n
+	mk (UmaskShared mode) = ModeSetter mode
-	sharedmode = combineModes groupSharedModes
 
 {- Creates a directory inside the gitAnnexDir (or possibly the dbdir), 
  - creating any parent directories up to and including the gitAnnexDir.

Annex/Ssh.hs

@@ -311,7 +311,7 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles
 		let lockfile = socket2lock socketfile
 		unlockFile lockfile
 		mode <- annexFileMode
-		noUmask mode (tryLockExclusive (Just mode) lockfile) >>= \case
+		tryLockExclusive (Just mode) lockfile >>= \case
 			Nothing -> noop
 			Just lck -> do
 				forceStopSsh socketfile

Annex/Transfer.hs

@@ -31,6 +31,7 @@ import Annex.Perms
 import Annex.Action
 import Utility.Metered
 import Utility.ThreadScheduler
+import Utility.FileMode
 import Annex.LockPool
 import Types.Key
 import qualified Types.Remote as Remote
@@ -144,7 +145,7 @@ runTransfer' ignorelock t eventualbackend afile stalldetection retrydecider tran
 					else recordFailedTransfer t info
 				return v
 	
-	prep :: RawFilePath -> Annex () -> FileMode -> Annex (Maybe LockHandle, Bool)
+	prep :: RawFilePath -> Annex () -> ModeSetter -> Annex (Maybe LockHandle, Bool)
 #ifndef mingw32_HOST_OS
 	prep tfile createtfile mode = catchPermissionDenied (const prepfailed) $ do
 		let lck = transferLockFile tfile

CHANGELOG

@@ -33,6 +33,8 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
   * Bug fix: Create .git/annex/, .git/annex/fsckdb,
     .git/annex/sentinal, .git/annex/sentinal.cache, and
     .git/annex/journal/* with permissions configured by core.sharedRepository.
+  * Bug fix: Lock files were created with wrong modes for some combinations
+    of core.sharedRepository and umask.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Remote/Helper/Hooks.hs

@@ -87,7 +87,7 @@ runHooks r starthook stophook a = do
 		unlockFile lck
 #ifndef mingw32_HOST_OS
 		mode <- annexFileMode
-		v <- noUmask mode $ tryLockExclusive (Just mode) lck
+		v <- tryLockExclusive (Just mode) lck
 #else
 		v <- liftIO $ lockExclusive lck
 #endif

Utility/FileMode.hs

@@ -1,6 +1,6 @@
 {- File mode utilities.
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -103,16 +103,19 @@ checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
 isExecutable :: FileMode -> Bool
 isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
 
-{- Runs an action without that pesky umask influencing it, unless the
+data ModeSetter = ModeSetter FileMode (RawFilePath -> IO ())
- - passed FileMode is the standard one. -}
+
-noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
+{- Runs an action which should create the file, passing it the desired
-#ifndef mingw32_HOST_OS
+ - initial file mode. Then runs the ModeSetter's action on the file, which
-noUmask mode a
+ - can adjust the initial mode if umask prevented the file from being
-	| mode == stdFileMode = a
+ - created with the right mode. -}
-	| otherwise = withUmask nullFileMode a
+applyModeSetter :: Maybe ModeSetter -> RawFilePath -> (Maybe FileMode -> IO a) -> IO a
-#else
+applyModeSetter (Just (ModeSetter mode modeaction)) file a = do
-noUmask _ a = a
+	r <- a (Just mode)
-#endif
+	void $ tryIO $ modeaction file
+	return r
+applyModeSetter Nothing _ a = 
+	a Nothing
 
 withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
 #ifndef mingw32_HOST_OS
@@ -172,8 +175,8 @@ writeFileProtected file content = writeFileProtected' file
 	(\h -> hPutStr h content)
 
 writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO ()
-writeFileProtected' file writer = protectedOutput $
+writeFileProtected' file writer = do
-	withFile (fromRawFilePath file) WriteMode $ \h -> do
+	h <- protectedOutput $ openFile (fromRawFilePath file) WriteMode
 	void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
 	writer h
 

Utility/LockFile/PidLock.hs

@@ -83,8 +83,7 @@ trySideLock :: PidLockFile -> (SideLockHandle -> IO a) -> IO a
 trySideLock lockfile a = do
 	sidelock <- sideLockFile lockfile
 	mlck <- catchDefaultIO Nothing $ 
-		withUmask nullFileMode $
+		Posix.tryLockExclusive (Just modesetter) sidelock
-			Posix.tryLockExclusive (Just mode) sidelock
 	-- Check the lock we just took, in case we opened a side lock file
 	-- belonging to another process that will have since deleted it.
 	case mlck of
@@ -100,6 +99,7 @@ trySideLock lockfile a = do
 	-- delete another user's lock file there, so could not
 	-- delete a stale lock.
 	mode = combineModes (readModes ++ writeModes)
+	modesetter = ModeSetter mode (\f -> modifyFileMode f (const mode))
 
 dropSideLock :: SideLockHandle -> IO ()
 dropSideLock Nothing = return ()

Utility/LockFile/Posix.hs

@@ -1,6 +1,6 @@
 {- Posix lock files
  -
- - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -22,6 +22,7 @@ module Utility.LockFile.Posix (
 
 import Utility.Exception
 import Utility.Applicative
+import Utility.FileMode
 import Utility.LockFile.LockStatus
 
 import System.IO
@@ -36,31 +37,31 @@ type LockFile = RawFilePath
 newtype LockHandle = LockHandle Fd
 
 -- Takes a shared lock, blocking until the lock is available.
-lockShared :: Maybe FileMode -> LockFile -> IO LockHandle
+lockShared :: Maybe ModeSetter -> LockFile -> IO LockHandle
 lockShared = lock ReadLock
 
 -- Takes an exclusive lock, blocking until the lock is available.
-lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle
+lockExclusive :: Maybe ModeSetter -> LockFile -> IO LockHandle
 lockExclusive = lock WriteLock
 
 -- Tries to take a shared lock, but does not block.
-tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
+tryLockShared :: Maybe ModeSetter -> LockFile -> IO (Maybe LockHandle)
 tryLockShared = tryLock ReadLock
 
 -- Tries to take an exclusive lock, but does not block.
-tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
+tryLockExclusive :: Maybe ModeSetter -> LockFile -> IO (Maybe LockHandle)
 tryLockExclusive = tryLock WriteLock
 
 -- Setting the FileMode allows creation of a new lock file.
 -- If it's Nothing then this only succeeds when the lock file already exists.
-lock :: LockRequest -> Maybe FileMode -> LockFile -> IO LockHandle
+lock :: LockRequest -> Maybe ModeSetter -> LockFile -> IO LockHandle
 lock lockreq mode lockfile = do
 	l <- openLockFile lockreq mode lockfile
 	waitToSetLock l (lockreq, AbsoluteSeek, 0, 0)
 	return (LockHandle l)
 
 -- Tries to take an lock, but does not block.
-tryLock :: LockRequest -> Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
+tryLock :: LockRequest -> Maybe ModeSetter -> LockFile -> IO (Maybe LockHandle)
 tryLock lockreq mode lockfile = uninterruptibleMask_ $ do
 	l <- openLockFile lockreq mode lockfile
 	v <- tryIO $ setLock l (lockreq, AbsoluteSeek, 0, 0)
@@ -71,9 +72,10 @@ tryLock lockreq mode lockfile = uninterruptibleMask_ $ do
 		Right _ -> return $ Just $ LockHandle l
 
 -- Close on exec flag is set so child processes do not inherit the lock.
-openLockFile :: LockRequest -> Maybe FileMode -> LockFile -> IO Fd
+openLockFile :: LockRequest -> Maybe ModeSetter -> LockFile -> IO Fd
 openLockFile lockreq filemode lockfile = do
-	l <- openFd lockfile openfor filemode defaultFileFlags
+	l <- applyModeSetter filemode lockfile $ \filemode' ->
+		openFd lockfile openfor filemode' defaultFileFlags
 	setFdOption l CloseOnExec True
 	return l
   where

Utility/LockPool/Posix.hs

@@ -24,6 +24,7 @@ import Utility.LockFile.LockStatus
 import qualified Utility.LockPool.STM as P
 import Utility.LockPool.STM (LockFile, LockMode(..))
 import Utility.LockPool.LockHandle
+import Utility.FileMode
 
 import System.IO
 import System.Posix
@@ -32,25 +33,25 @@ import Control.Applicative
 import Prelude
 
 -- Takes a shared lock, blocking until the lock is available.
-lockShared :: Maybe FileMode -> LockFile -> IO LockHandle
+lockShared :: Maybe ModeSetter -> LockFile -> IO LockHandle
 lockShared mode file = fst <$> makeLockHandle P.lockPool file
 	(\p f -> P.waitTakeLock p f LockShared)
 	(\f _ -> mk <$> F.lockShared mode f)
 
 -- Takes an exclusive lock, blocking until the lock is available.
-lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle
+lockExclusive :: Maybe ModeSetter -> LockFile -> IO LockHandle
 lockExclusive mode file = fst <$> makeLockHandle P.lockPool file
 	(\p f -> P.waitTakeLock p f LockExclusive)
 	(\f _ -> mk <$> F.lockExclusive mode f)
 
 -- Tries to take a shared lock, but does not block.
-tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
+tryLockShared :: Maybe ModeSetter -> LockFile -> IO (Maybe LockHandle)
 tryLockShared mode file = fmap fst <$> tryMakeLockHandle P.lockPool file
 	(\p f -> P.tryTakeLock p f LockShared)
 	(\f _ -> fmap mk <$> F.tryLockShared mode f)
 
 -- Tries to take an exclusive lock, but does not block.
-tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
+tryLockExclusive :: Maybe ModeSetter -> LockFile -> IO (Maybe LockHandle)
 tryLockExclusive mode file = fmap fst <$> tryMakeLockHandle P.lockPool file
 	(\p f -> P.tryTakeLock p f LockExclusive)
 	(\f _ -> fmap mk <$> F.tryLockExclusive mode f)

doc/bugs/wrong_modes_for_some_lock_files_withcoresharedrepository.mdwn

@@ -2,13 +2,13 @@ With core.sharedRepository=0666, some lock files get created mode 644
 (with umask 0022).
 
 With core.sharedRepository=group, some lock files get created mode 660,
-rather than 644 (with umask 0022).
+rather than 664 (with umask 0022).
 
 Root of the problem is uses of annexFileMode. 
 
 Some callers use noUmask with it, which works in cases other than these (at
 least with umask 0022). But in the core.sharedRepository=group case, the
-umask is cleared by noUmask, which is why the g+r bit is not set.
+umask is cleared by noUmask, which is why the o+r bit is not set.
 
 Some callers don't use noUmask with it, and when
 core.sharedRepository=0666, that results in the umask being applied
@@ -20,3 +20,5 @@ Fix will probably involve getting rid of annexFileMode, and noUmask, and
 creating the lock file with default umask, then fixing up the mode if necessary,
 before using it. Ie, the same pattern used everywhere else in git-annex.
 --[[Joey]]
+
+> [[fixed|done]] --[[Joey]]