Skip to content

Commit 5319d65

Browse files
harendra-kumarharendra-kumar
committed
Add a chmod module
1 parent 2123c85 commit 5319d65

3 files changed

Lines changed: 275 additions & 0 deletions

File tree

‎src/Streamly/Coreutils/Chmod.hs‎

Lines changed: 257 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,257 @@
1+
-- |
2+
-- Module : Streamly.Coreutils.Chmod
3+
-- Copyright : (c) 2026 Composewell Technologies
4+
-- License : Apache-2.0
5+
-- Maintainer : streamly@composewell.com
6+
-- Stability : experimental
7+
-- Portability : GHC
8+
--
9+
-- Change file mode bits. Mirrors GNU @chmod@. Recursive mode not supported
10+
-- yet.
11+
--
12+
-- == Shell equivalents
13+
--
14+
-- >>> _ = chmod id (ownerRead True . ownerWrite True) -- chmod u=rw FILE
15+
-- >>> _ = chmod id (ownerRead True . groupRead True . otherRead True) -- chmod a=r FILE
16+
-- >>> _ = chmod (additive True) (ownerExec True) -- chmod u+x FILE
17+
-- >>> _ = chmod (additive True) (groupWrite False) -- chmod g-w FILE
18+
-- >>> _ = chmod (modeFrom file) (groupWrite True) -- chmod --reference=ref FILE
19+
20+
module Streamly.Coreutils.Chmod
21+
( -- * Runner
22+
chmod
23+
24+
-- * Options
25+
, ChmodOptions
26+
, additive
27+
, modeFrom
28+
29+
-- * Mode
30+
, Mode
31+
32+
-- ** Owner bits
33+
, ownerRead
34+
, ownerWrite
35+
, ownerExec
36+
37+
-- ** Group bits
38+
, groupRead
39+
, groupWrite
40+
, groupExec
41+
42+
-- ** Other bits
43+
, otherRead
44+
, otherWrite
45+
, otherExec
46+
47+
-- ** Special bits
48+
, setUid
49+
, setGid
50+
, sticky
51+
)
52+
where
53+
54+
import Data.Bits (complement, (.&.), (.|.))
55+
import Streamly.FileSystem.Path (Path)
56+
import System.PosixCompat.Files (fileMode, getFileStatus, setFileMode)
57+
import System.PosixCompat.Types (FileMode)
58+
59+
import qualified Streamly.FileSystem.Path as Path
60+
61+
-- $setup
62+
-- >>> import Streamly.Coreutils.Chmod
63+
-- >>> import Streamly.FileSystem.Path (path)
64+
-- >>> file = [path|a.txt|]
65+
66+
-- = Design notes
67+
--
68+
-- TODO: add recursive mode.
69+
-- TODO: add @followSymlinks@ option.
70+
-- TODO: make windows behavior consistent with filetest.
71+
--
72+
-- Mode builders:
73+
-- -------------
74+
--
75+
-- Mode builders can be common to chmod and the file test utility and anything
76+
-- else in coreutils. We can have a common mode builder (FileMode) module
77+
-- exposing the mode builders to all consumers.
78+
--
79+
-- The simplest is one function for each bit e.g. "ownerRead True" and compose
80+
-- them all to create a mode. There can be canned ownerRWX, ownerRX, ownerRW,
81+
-- ownerWX, that will complete all possible combinations, but does not include
82+
-- the sticky bit. Another supplementary mechanism could be a quasiquote
83+
-- [mode|a=rwx|] this can include sticky bit as well without exploding.
84+
--
85+
-- We can also have a quasiquoter to build the chmod options directly e.g.
86+
-- @chmod [chmodOpt|a=rwx]@.
87+
--
88+
-- Quasiquoter format:
89+
-- The format of a symbolic mode is [roles][-+=][perms...], where roles is
90+
-- either zero or more letters from the set "ugoa". perms is either zero or
91+
-- more letters from the set "rwxXst". Multiple symbolic modes can be given,
92+
-- separated by commas.
93+
--
94+
-- Examples:
95+
--
96+
-- @
97+
-- -
98+
-- -rwx
99+
-- g-rx
100+
-- g-x+r
101+
-- go-x+rw
102+
-- go-x+rw,u+r
103+
-- @
104+
--
105+
106+
-------------------------------------------------------------------------------
107+
-- Mode
108+
-------------------------------------------------------------------------------
109+
110+
-- TODO: Should we directly use FileMode here, so that we do not have to export
111+
-- one more type which might conflict with others.? This is in "base" so should
112+
-- be fine.
113+
114+
-- | File mode.
115+
--
116+
-- This is an opaque type, construct values only by composing modifier
117+
-- functions and passing the result to 'chmod'.
118+
newtype Mode = Mode FileMode
119+
120+
toggle :: FileMode -> Bool -> Mode -> Mode
121+
toggle bit True (Mode m) = Mode (m .|. bit)
122+
toggle bit False (Mode m) = Mode (m .&. complement bit)
123+
124+
-- | Toggle the owner read bit (@0o400@).
125+
--
126+
ownerRead :: Bool -> Mode -> Mode
127+
ownerRead = toggle 0o400
128+
129+
-- | Toggle the owner write bit (@0o200@).
130+
--
131+
ownerWrite :: Bool -> Mode -> Mode
132+
ownerWrite = toggle 0o200
133+
134+
-- | Toggle the owner execute bit (@0o100@).
135+
--
136+
ownerExec :: Bool -> Mode -> Mode
137+
ownerExec = toggle 0o100
138+
139+
-- | Toggle the group read bit (@0o040@).
140+
--
141+
groupRead :: Bool -> Mode -> Mode
142+
groupRead = toggle 0o040
143+
144+
-- | Toggle the group write bit (@0o020@).
145+
--
146+
groupWrite :: Bool -> Mode -> Mode
147+
groupWrite = toggle 0o020
148+
149+
-- | Toggle the group execute bit (@0o010@).
150+
--
151+
groupExec :: Bool -> Mode -> Mode
152+
groupExec = toggle 0o010
153+
154+
-- | Toggle the other read bit (@0o004@).
155+
--
156+
otherRead :: Bool -> Mode -> Mode
157+
otherRead = toggle 0o004
158+
159+
-- | Toggle the other write bit (@0o002@).
160+
--
161+
otherWrite :: Bool -> Mode -> Mode
162+
otherWrite = toggle 0o002
163+
164+
-- | Toggle the other execute bit (@0o001@).
165+
--
166+
otherExec :: Bool -> Mode -> Mode
167+
otherExec = toggle 0o001
168+
169+
-- | Toggle the set-user-ID bit (@0o4000@).
170+
--
171+
setUid :: Bool -> Mode -> Mode
172+
setUid = toggle 0o4000
173+
174+
-- | Toggle the set-group-ID bit (@0o2000@).
175+
--
176+
setGid :: Bool -> Mode -> Mode
177+
setGid = toggle 0o2000
178+
179+
-- | Toggle the sticky bit (@0o1000@).
180+
--
181+
sticky :: Bool -> Mode -> Mode
182+
sticky = toggle 0o1000
183+
184+
-------------------------------------------------------------------------------
185+
-- Options
186+
-------------------------------------------------------------------------------
187+
188+
data SeedSource = SeedZero | SeedSelf | SeedRef Path
189+
190+
-- | 'chmod' configuration. Build options by composing modifiers with @(.)@ and
191+
-- pass the composition to 'chmod'; pass @id@ for defaults.
192+
newtype ChmodOptions = ChmodOptions { chmodSeed :: SeedSource }
193+
194+
defaultOptions :: ChmodOptions
195+
defaultOptions = ChmodOptions SeedZero
196+
197+
-- | When 'True', mode is added to the existing mode of the file instead of
198+
-- resetting it.
199+
--
200+
-- Default: 'False'.
201+
additive :: Bool -> ChmodOptions -> ChmodOptions
202+
additive True opts = opts { chmodSeed = SeedSelf }
203+
additive False opts = opts { chmodSeed = SeedZero }
204+
205+
-- NOTE: instead of having modeFrom option modifier, we could use a mode
206+
-- builder from file e.g. "modeFrom :: Path -> Mode -> IO Mode", but that is
207+
-- awkward to compose with pure "Mode -> Mode" builders. One way is to use a
208+
-- combinator like f :: Path -> Mode -> Mode -> IO (Mode -> Mode)". Or lift
209+
-- pure "Mode -> Mode" to "Mode -> IO Mode" and compose all with kliesli, but
210+
-- then we will need a chmod (or variant) taking "Mode -> IO Mode" as argument.
211+
-- It is much simpler to have "modeFrom" as option modifier compared to all
212+
-- these options.
213+
214+
-- | Use the current mode of the given reference path as the starting mode, the
215+
-- specified mode is added to the reference mode.
216+
--
217+
-- Default: no reference.
218+
modeFrom :: Path -> ChmodOptions -> ChmodOptions
219+
modeFrom ref opts = opts { chmodSeed = SeedRef ref }
220+
221+
-------------------------------------------------------------------------------
222+
-- Runner
223+
-------------------------------------------------------------------------------
224+
225+
-- XXX Do not use toString
226+
modeOf :: Path -> IO FileMode
227+
modeOf p = fileMode <$> getFileStatus (Path.toString p)
228+
229+
resolveSeed :: SeedSource -> Path -> IO FileMode
230+
resolveSeed seed target = case seed of
231+
SeedZero -> pure 0
232+
SeedSelf -> modeOf target
233+
SeedRef ref -> modeOf ref
234+
235+
-- | Change the mode bits of a file.
236+
--
237+
-- The desired mode is built by composing mode setter functions. By default the
238+
-- mode of the file is set to the supplied mode, the 'additive' modifier can be
239+
-- used to add to the existing mode.
240+
--
241+
-- Symlinks are followed by default.
242+
--
243+
-- Pass @id@ for default options and the @Mode -> Mode@ composition for the
244+
-- mode; each modifier documents its own default.
245+
--
246+
-- Note: @chmod id id@ would clear all modes.
247+
chmod
248+
:: (ChmodOptions -> ChmodOptions)
249+
-> (Mode -> Mode)
250+
-> Path
251+
-> IO ()
252+
chmod optF modeF path = do
253+
seed <- resolveSeed (chmodSeed (optF defaultOptions)) path
254+
let Mode bits = modeF (Mode seed)
255+
256+
-- XXX do not use toString.
257+
setFileMode (Path.toString path) bits

‎src/Streamly/Coreutils/FileTest/Common.hs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -303,6 +303,8 @@ mkFileState tag fp st = do
303303
-- the "or" operation. Also, the generic foldMap or mconcat provided by Monoids
304304
-- are of limited use in this case.
305305

306+
-- TODO: should we call this TestPredicate or just Predicate?
307+
306308
-- Predicates receive a 'FileState' rather than a raw 'FileStatus'. This
307309
-- gives them access to the file path and lets them share the lazily-cached
308310
-- 'FileStatus' without issuing redundant @stat@ calls.
@@ -588,6 +590,21 @@ isSocket = withStatus Files.isSocket
588590
-- Permissions
589591
---------------
590592

593+
-- TODO:
594+
--
595+
-- Unify with the mode building in chmod and any other places.
596+
--
597+
-- "hasMode mode" would check if mode is a subset of the file mode. "eqMode
598+
-- mode" would check equality. These are similar to the chmod "set" and "add"
599+
-- functionality. We can also reuse the same quasiquoters in both. For subset
600+
-- checking we can use "<" symbol in the quasiquoter.
601+
602+
-- TODO: on Windows there is unix-compat does not distinguish between owner,
603+
-- group and other, all permissions are identical. Should we instead use no
604+
-- permissions for group/other -- that is more intuitive? Also, if one has to
605+
-- use the same permissions across Posix/Windows then owner-only permissions
606+
-- make sense, e.g. using rwx for all does not make sense.
607+
591608
-- | True if the file has specified permission mode.
592609
--
593610
{-# INLINE hasMode #-}

‎streamly-coreutils.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -119,6 +119,7 @@ library
119119
hs-source-dirs: src
120120
exposed-modules:
121121
Streamly.Coreutils
122+
, Streamly.Coreutils.Chmod
122123
, Streamly.Coreutils.Common
123124
, Streamly.Coreutils.Cp
124125
, Streamly.Coreutils.Directory

0 commit comments

Comments
 (0)