git-annex/Utility/FileMode.hs
Joey Hess b47c9fd587 honor core.sharedRepository settings in lockContent
The content file may not be owned by the user running git-annex, in which
case, setting the owner write bit was not enough to let lockContent
act on the file. However, with some core.sharedRepository configs, the file
should be writable by the user's group. So, the thing to do is to call
thawContent on it.
2015-05-19 14:53:19 -04:00

150 lines
4 KiB
Haskell

{- File mode utilities.
-
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.FileMode where
import System.IO
import Control.Monad
import System.PosixCompat.Types
import Utility.PosixFiles
#ifndef mingw32_HOST_OS
import System.Posix.Files
#endif
import Foreign (complement)
import Utility.Exception
{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode f convert = do
s <- getFileStatus f
let old = fileMode s
let new = convert old
when (new /= old) $
setFileMode f new
{- Adds the specified FileModes to the input mode, leaving the rest
- unchanged. -}
addModes :: [FileMode] -> FileMode -> FileMode
addModes ms m = combineModes (m:ms)
{- Removes the specified FileModes from the input mode. -}
removeModes :: [FileMode] -> FileMode -> FileMode
removeModes ms m = m `intersectFileModes` complement (combineModes ms)
writeModes :: [FileMode]
writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
readModes :: [FileMode]
readModes = [ownerReadMode, groupReadMode, otherReadMode]
executeModes :: [FileMode]
executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
otherGroupModes :: [FileMode]
otherGroupModes =
[ groupReadMode, otherReadMode
, groupWriteMode, otherWriteMode
]
{- Removes the write bits from a file. -}
preventWrite :: FilePath -> IO ()
preventWrite f = modifyFileMode f $ removeModes writeModes
{- Turns a file's owner write bit back on. -}
allowWrite :: FilePath -> IO ()
allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]
{- Turns a file's owner read bit back on. -}
allowRead :: FilePath -> IO ()
allowRead f = modifyFileMode f $ addModes [ownerReadMode]
{- Allows owner and group to read and write to a file. -}
groupSharedModes :: [FileMode]
groupSharedModes =
[ ownerWriteMode, groupWriteMode
, ownerReadMode, groupReadMode
]
groupWriteRead :: FilePath -> IO ()
groupWriteRead f = modifyFileMode f $ addModes groupSharedModes
checkMode :: FileMode -> FileMode -> Bool
checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
{- Checks if a file mode indicates it's a symlink. -}
isSymLink :: FileMode -> Bool
#ifdef mingw32_HOST_OS
isSymLink _ = False
#else
isSymLink = checkMode symbolicLinkMode
#endif
{- Checks if a file has any executable bits set. -}
isExecutable :: FileMode -> Bool
isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
{- Runs an action without that pesky umask influencing it, unless the
- passed FileMode is the standard one. -}
noUmask :: FileMode -> IO a -> IO a
#ifndef mingw32_HOST_OS
noUmask mode a
| mode == stdFileMode = a
| otherwise = withUmask nullFileMode a
#else
noUmask _ a = a
#endif
withUmask :: FileMode -> IO a -> IO a
#ifndef mingw32_HOST_OS
withUmask umask a = bracket setup cleanup go
where
setup = setFileCreationMask umask
cleanup = setFileCreationMask
go _ = a
#else
withUmask _ a = a
#endif
combineModes :: [FileMode] -> FileMode
combineModes [] = 0
combineModes [m] = m
combineModes (m:ms) = foldl unionFileModes m ms
isSticky :: FileMode -> Bool
#ifdef mingw32_HOST_OS
isSticky _ = False
#else
isSticky = checkMode stickyMode
stickyMode :: FileMode
stickyMode = 512
setSticky :: FilePath -> IO ()
setSticky f = modifyFileMode f $ addModes [stickyMode]
#endif
{- Writes a file, ensuring that its modes do not allow it to be read
- or written by anyone other than the current user,
- before any content is written.
-
- When possible, this is done using the umask.
-
- On a filesystem that does not support file permissions, this is the same
- as writeFile.
-}
writeFileProtected :: FilePath -> String -> IO ()
writeFileProtected file content = writeFileProtected' file
(\h -> hPutStr h content)
writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
writeFileProtected' file writer = withUmask 0o0077 $
withFile file WriteMode $ \h -> do
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
writer h