Skip to content

Commit f605fcf

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

3 files changed

Lines changed: 276 additions & 0 deletions

File tree

‎src/Streamly/Coreutils/Chmod.hs‎

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