1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
{- File mode utilities.
-
- Copyright 2010-2017 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.FileMode (
module Utility.FileMode,
FileMode,
) where
import System.IO
import Control.Monad
import System.PosixCompat.Types
import System.PosixCompat.Files
#ifndef mingw32_HOST_OS
import System.Posix.Files (symbolicLinkMode)
import Control.Monad.IO.Class (liftIO)
#endif
import Control.Monad.IO.Class (MonadIO)
import Foreign (complement)
import Control.Monad.Catch
import Utility.Exception
{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode f convert = void $ modifyFileMode' f convert
modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
modifyFileMode' f convert = do
s <- getFileStatus f
let old = fileMode s
let new = convert old
when (new /= old) $
setFileMode f new
return old
{- Runs an action after changing a file's mode, then restores the old mode. -}
withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
withModifiedFileMode file convert a = bracket setup cleanup go
where
setup = modifyFileMode' file convert
cleanup oldmode = modifyFileMode file (const oldmode)
go _ = a
{- 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 :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
noUmask mode a
| mode == stdFileMode = a
| otherwise = withUmask nullFileMode a
#else
noUmask _ a = a
#endif
withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
#ifndef mingw32_HOST_OS
withUmask umask a = bracket setup cleanup go
where
setup = liftIO $ setFileCreationMask umask
cleanup = liftIO . setFileCreationMask
go _ = a
#else
withUmask _ a = a
#endif
getUmask :: IO FileMode
#ifndef mingw32_HOST_OS
getUmask = bracket setup cleanup return
where
setup = setFileCreationMask nullFileMode
cleanup = setFileCreationMask
#else
getUmask = return nullFileMode
#endif
defaultFileMode :: IO FileMode
defaultFileMode = do
umask <- getUmask
return $ intersectFileModes (complement umask) stdFileMode
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 = protectedOutput $
withFile file WriteMode $ \h -> do
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
writer h
protectedOutput :: IO a -> IO a
protectedOutput = withUmask 0o0077
|
