diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 877b15c9..232f285c 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -109,7 +109,7 @@ jobs: # If you have not committed packcheck.sh in your repo at PACKCHECK # then it is automatically pulled from this URL. PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck" - PACKCHECK_GITHUB_COMMIT: "fa6064227164de8d47dd65bdcb43b52844ba0e29" + PACKCHECK_GITHUB_COMMIT: "74a50fd9bcb06907b822e910938dae795d0f23cc" # ubuntu seems to have better support than debian on CI systems runs-on: ${{ matrix.runner }} diff --git a/src/Streamly/Coreutils/Chmod.hs b/src/Streamly/Coreutils/Chmod.hs new file mode 100644 index 00000000..50bc9624 --- /dev/null +++ b/src/Streamly/Coreutils/Chmod.hs @@ -0,0 +1,258 @@ +-- | +-- Module : Streamly.Coreutils.Chmod +-- Copyright : (c) 2026 Composewell Technologies +-- License : Apache-2.0 +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC +-- +-- Change file mode bits. Mirrors GNU @chmod@. Recursive mode not supported +-- yet. +-- +-- == Shell equivalents +-- +-- >>> _ = chmod id (ownerRead True . ownerWrite True) -- chmod u=rw FILE +-- >>> _ = chmod id (ownerRead True . groupRead True . otherRead True) -- chmod a=r FILE +-- >>> _ = chmod (additive True) (ownerExec True) -- chmod u+x FILE +-- >>> _ = chmod (additive True) (groupWrite False) -- chmod g-w FILE +-- >>> _ = chmod (modeFrom file) (groupWrite True) -- chmod --reference=ref FILE + +module Streamly.Coreutils.Chmod + ( -- * Runner + chmod + + -- * Options + , ChmodOptions + , additive + , modeFrom + + -- * Mode + , Mode + + -- ** Owner bits + , ownerRead + , ownerWrite + , ownerExec + + -- ** Group bits + , groupRead + , groupWrite + , groupExec + + -- ** Other bits + , otherRead + , otherWrite + , otherExec + + -- ** Special bits + , setUid + , setGid + , sticky + ) +where + +import Data.Bits (complement, (.&.), (.|.)) +import Streamly.FileSystem.Path (Path) +import System.PosixCompat.Files (fileMode, getFileStatus, setFileMode) +import System.PosixCompat.Types (FileMode) + +import qualified Streamly.FileSystem.Path as Path + +-- $setup +-- >>> :set -XQuasiQuotes +-- >>> import Streamly.Coreutils.Chmod +-- >>> import Streamly.FileSystem.Path (path) +-- >>> file = [path|a.txt|] + +-- = Design notes +-- +-- TODO: add recursive mode. +-- TODO: add @followSymlinks@ option. +-- TODO: make windows behavior consistent with filetest. +-- +-- Mode builders: +-- ------------- +-- +-- Mode builders can be common to chmod and the file test utility and anything +-- else in coreutils. We can have a common mode builder (FileMode) module +-- exposing the mode builders to all consumers. +-- +-- The simplest is one function for each bit e.g. "ownerRead True" and compose +-- them all to create a mode. There can be canned ownerRWX, ownerRX, ownerRW, +-- ownerWX, that will complete all possible combinations, but does not include +-- the sticky bit. Another supplementary mechanism could be a quasiquote +-- [mode|a=rwx|] this can include sticky bit as well without exploding. +-- +-- We can also have a quasiquoter to build the chmod options directly e.g. +-- @chmod [chmodOpt|a=rwx]@. +-- +-- Quasiquoter format: +-- The format of a symbolic mode is [roles][-+=][perms...], where roles is +-- either zero or more letters from the set "ugoa". perms is either zero or +-- more letters from the set "rwxXst". Multiple symbolic modes can be given, +-- separated by commas. +-- +-- Examples: +-- +-- @ +-- - +-- -rwx +-- g-rx +-- g-x+r +-- go-x+rw +-- go-x+rw,u+r +-- @ +-- + +------------------------------------------------------------------------------- +-- Mode +------------------------------------------------------------------------------- + +-- TODO: Should we directly use FileMode here, so that we do not have to export +-- one more type which might conflict with others.? This is in "base" so should +-- be fine. + +-- | File mode. +-- +-- This is an opaque type, construct values only by composing modifier +-- functions and passing the result to 'chmod'. +newtype Mode = Mode FileMode + +toggle :: FileMode -> Bool -> Mode -> Mode +toggle bit True (Mode m) = Mode (m .|. bit) +toggle bit False (Mode m) = Mode (m .&. complement bit) + +-- | Toggle the owner read bit (@0o400@). +-- +ownerRead :: Bool -> Mode -> Mode +ownerRead = toggle 0o400 + +-- | Toggle the owner write bit (@0o200@). +-- +ownerWrite :: Bool -> Mode -> Mode +ownerWrite = toggle 0o200 + +-- | Toggle the owner execute bit (@0o100@). +-- +ownerExec :: Bool -> Mode -> Mode +ownerExec = toggle 0o100 + +-- | Toggle the group read bit (@0o040@). +-- +groupRead :: Bool -> Mode -> Mode +groupRead = toggle 0o040 + +-- | Toggle the group write bit (@0o020@). +-- +groupWrite :: Bool -> Mode -> Mode +groupWrite = toggle 0o020 + +-- | Toggle the group execute bit (@0o010@). +-- +groupExec :: Bool -> Mode -> Mode +groupExec = toggle 0o010 + +-- | Toggle the other read bit (@0o004@). +-- +otherRead :: Bool -> Mode -> Mode +otherRead = toggle 0o004 + +-- | Toggle the other write bit (@0o002@). +-- +otherWrite :: Bool -> Mode -> Mode +otherWrite = toggle 0o002 + +-- | Toggle the other execute bit (@0o001@). +-- +otherExec :: Bool -> Mode -> Mode +otherExec = toggle 0o001 + +-- | Toggle the set-user-ID bit (@0o4000@). +-- +setUid :: Bool -> Mode -> Mode +setUid = toggle 0o4000 + +-- | Toggle the set-group-ID bit (@0o2000@). +-- +setGid :: Bool -> Mode -> Mode +setGid = toggle 0o2000 + +-- | Toggle the sticky bit (@0o1000@). +-- +sticky :: Bool -> Mode -> Mode +sticky = toggle 0o1000 + +------------------------------------------------------------------------------- +-- Options +------------------------------------------------------------------------------- + +data SeedSource = SeedZero | SeedSelf | SeedRef Path + +-- | 'chmod' configuration. Build options by composing modifiers with @(.)@ and +-- pass the composition to 'chmod'; pass @id@ for defaults. +newtype ChmodOptions = ChmodOptions { chmodSeed :: SeedSource } + +defaultOptions :: ChmodOptions +defaultOptions = ChmodOptions SeedZero + +-- | When 'True', mode is added to the existing mode of the file instead of +-- resetting it. +-- +-- Default: 'False'. +additive :: Bool -> ChmodOptions -> ChmodOptions +additive True opts = opts { chmodSeed = SeedSelf } +additive False opts = opts { chmodSeed = SeedZero } + +-- NOTE: instead of having modeFrom option modifier, we could use a mode +-- builder from file e.g. "modeFrom :: Path -> Mode -> IO Mode", but that is +-- awkward to compose with pure "Mode -> Mode" builders. One way is to use a +-- combinator like f :: Path -> Mode -> Mode -> IO (Mode -> Mode)". Or lift +-- pure "Mode -> Mode" to "Mode -> IO Mode" and compose all with kliesli, but +-- then we will need a chmod (or variant) taking "Mode -> IO Mode" as argument. +-- It is much simpler to have "modeFrom" as option modifier compared to all +-- these options. + +-- | Use the current mode of the given reference path as the starting mode, the +-- specified mode is added to the reference mode. +-- +-- Default: no reference. +modeFrom :: Path -> ChmodOptions -> ChmodOptions +modeFrom ref opts = opts { chmodSeed = SeedRef ref } + +------------------------------------------------------------------------------- +-- Runner +------------------------------------------------------------------------------- + +-- XXX Do not use toString +modeOf :: Path -> IO FileMode +modeOf p = fileMode <$> getFileStatus (Path.toString p) + +resolveSeed :: SeedSource -> Path -> IO FileMode +resolveSeed seed target = case seed of + SeedZero -> pure 0 + SeedSelf -> modeOf target + SeedRef ref -> modeOf ref + +-- | Change the mode bits of a file. +-- +-- The desired mode is built by composing mode setter functions. By default the +-- mode of the file is set to the supplied mode, the 'additive' modifier can be +-- used to add to the existing mode. +-- +-- Symlinks are followed by default. +-- +-- Pass @id@ for default options and the @Mode -> Mode@ composition for the +-- mode; each modifier documents its own default. +-- +-- Note: @chmod id id@ would clear all modes. +chmod + :: (ChmodOptions -> ChmodOptions) + -> (Mode -> Mode) + -> Path + -> IO () +chmod optF modeF path = do + seed <- resolveSeed (chmodSeed (optF defaultOptions)) path + let Mode bits = modeF (Mode seed) + + -- XXX do not use toString. + setFileMode (Path.toString path) bits diff --git a/src/Streamly/Coreutils/FileTest/Common.hs b/src/Streamly/Coreutils/FileTest/Common.hs index db108002..689efc63 100644 --- a/src/Streamly/Coreutils/FileTest/Common.hs +++ b/src/Streamly/Coreutils/FileTest/Common.hs @@ -303,6 +303,8 @@ mkFileState tag fp st = do -- the "or" operation. Also, the generic foldMap or mconcat provided by Monoids -- are of limited use in this case. +-- TODO: should we call this TestPredicate or just Predicate? + -- Predicates receive a 'FileState' rather than a raw 'FileStatus'. This -- gives them access to the file path and lets them share the lazily-cached -- 'FileStatus' without issuing redundant @stat@ calls. @@ -588,6 +590,21 @@ isSocket = withStatus Files.isSocket -- Permissions --------------- +-- TODO: +-- +-- Unify with the mode building in chmod and any other places. +-- +-- "hasMode mode" would check if mode is a subset of the file mode. "eqMode +-- mode" would check equality. These are similar to the chmod "set" and "add" +-- functionality. We can also reuse the same quasiquoters in both. For subset +-- checking we can use "<" symbol in the quasiquoter. + +-- TODO: on Windows there is unix-compat does not distinguish between owner, +-- group and other, all permissions are identical. Should we instead use no +-- permissions for group/other -- that is more intuitive? Also, if one has to +-- use the same permissions across Posix/Windows then owner-only permissions +-- make sense, e.g. using rwx for all does not make sense. + -- | True if the file has specified permission mode. -- {-# INLINE hasMode #-} diff --git a/streamly-coreutils.cabal b/streamly-coreutils.cabal index 05856e08..d728e9c7 100644 --- a/streamly-coreutils.cabal +++ b/streamly-coreutils.cabal @@ -119,6 +119,7 @@ library hs-source-dirs: src exposed-modules: Streamly.Coreutils + , Streamly.Coreutils.Chmod , Streamly.Coreutils.Common , Streamly.Coreutils.Cp , Streamly.Coreutils.Directory