151 lines
4.0 KiB
Haskell
151 lines
4.0 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
|