avoid chown call if the current file mode is same as new

Not only an optimisation. fsck always tried to preventWrite to make sure
file modes are good, and in a shared repo, that will fail on directories
not owned by the current user. Although there may be other problems with
such a setup.
This commit is contained in:
Joey Hess 2012-04-21 11:57:17 -04:00
parent 5cc76098ca
commit cbf9a9420e

View file

@ -7,16 +7,24 @@
module Utility.FileMode where module Utility.FileMode where
import System.Posix.Files import Common
import System.Posix.Types import System.Posix.Types
import Foreign (complement) import Foreign (complement)
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode f convert = do
s <- getFileStatus f
let cur = fileMode s
let new = convert cur
when (new /= cur) $
setFileMode f new
{- Removes a FileMode from a file. {- Removes a FileMode from a file.
- For example, call with otherWriteMode to chmod o-w -} - For example, call with otherWriteMode to chmod o-w -}
unsetFileMode :: FilePath -> FileMode -> IO () unsetFileMode :: FilePath -> FileMode -> IO ()
unsetFileMode f m = do unsetFileMode f m = modifyFileMode f $
s <- getFileStatus f \cur -> cur `intersectFileModes` complement m
setFileMode f $ fileMode s `intersectFileModes` complement m
{- Removes the write bits from a file. -} {- Removes the write bits from a file. -}
preventWrite :: FilePath -> IO () preventWrite :: FilePath -> IO ()
@ -27,9 +35,8 @@ preventWrite f = unsetFileMode f writebits
{- Turns a file's write bit back on. -} {- Turns a file's write bit back on. -}
allowWrite :: FilePath -> IO () allowWrite :: FilePath -> IO ()
allowWrite f = do allowWrite f = modifyFileMode f $
s <- getFileStatus f \cur -> cur `unionFileModes` ownerWriteMode
setFileMode f $ fileMode s `unionFileModes` ownerWriteMode
{- Checks if a file mode indicates it's a symlink. -} {- Checks if a file mode indicates it's a symlink. -}
isSymLink :: FileMode -> Bool isSymLink :: FileMode -> Bool