diff --git a/src/Streamly/Coreutils/Chmod/Posix.hs b/src/Streamly/Coreutils/Chmod/Posix.hs new file mode 100644 index 0000000..cc0d787 --- /dev/null +++ b/src/Streamly/Coreutils/Chmod/Posix.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE QuasiQuotes #-} +-- | +-- Module : Streamly.Coreutils.Chmod.Posix +-- Copyright : (c) 2022 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC +-- +-- change file mode bits. + +-- TODO: change this module to Chmod.Posix and later create a portable module. +-- +-- Design notes: +-- +-- On Posix systems: +-- +-- Roles: User (Owner), group (only one), others +-- Permissions: rwxX(ugo), s(go), t(o) +-- +-- 1. write: create or delete a file in a directory. Modify contents of a file. +-- 2. write: modify metadata of a directory or file. +-- 3. execute: to list a directory's contents +-- +-- On Windows: +-- +-- Could not find any good docs by microsoft on a google search. +-- Managing permissions: https://learn.microsoft.com/en-us/previous-versions/windows/it-pro/windows-server-2008-R2-and-2008/cc770962(v=ws.11) +-- https://learn.microsoft.com/en-us/windows/security/identity-protection/access-control/access-control +-- +-- Roles: User (Owner), group (many) +-- Permissions: read, read+execute, modify (metadata, create/delete files in +-- dirs), write (write to a file), list dir, full control +-- Inheritance: permissions can be inherited from parent directories +-- Advanced Permissions: ... +-- +-- 1. write: create or delete a file in a directory. Modify contents of a file. +-- 2. modify: modify metadata of a directory or file. +-- 3. list dir: to list a directory's contents +-- +-- Common abstraction for windows/posix: +-- +-- Roles: User/Owner +-- Permissions: +-- +-- 1. write on Posix: write+modify on windows +-- 2. execute on dir: "list dir" on windows +-- +-- Other's default permissions are controlled by umask on Posix. When setting +-- permissions we can ensure that other's permissions are less restrictive than +-- the owner? But we cannot do the same on windows. + +module Streamly.Coreutils.Chmod.Posix + ( + -- * Roles + Role (..) + + -- * Permissions + , Permissions + , setReadable + , setWritable + , setExecutable + , reset + + -- * Chmod + , chmodWith + , chmod + ) +where + +import Data.Bits ((.|.), Bits ((.&.), complement)) +import Streamly.Coreutils.StringQ +import qualified System.Posix as Posix +import GHC.IO.Unsafe (unsafePerformIO) + +modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode +modifyBit False b m = m .&. complement b +modifyBit True b m = m .|. b + +chmodWith :: Role -> Permissions -> FilePath -> IO () +chmodWith utype (Permissions r w e) path = do + case utype of + Owner -> setOwnerPermissions + Group -> setGroupPermissions + Others -> setOthersPermissions + + where + + setOwnerPermissions = do + stat <- Posix.getFileStatus path + Posix.setFileMode + path + ( modifyBit e Posix.ownerExecuteMode + . modifyBit w Posix.ownerWriteMode + . modifyBit r Posix.ownerReadMode + . Posix.fileMode $ stat + ) + + setGroupPermissions = do + stat <- Posix.getFileStatus path + Posix.setFileMode + path + ( modifyBit e Posix.groupExecuteMode + . modifyBit w Posix.groupWriteMode + . modifyBit r Posix.groupReadMode + . Posix.fileMode $ stat + ) + + setOthersPermissions = do + stat <- Posix.getFileStatus path + Posix.setFileMode + path + ( modifyBit e Posix.otherExecuteMode + . modifyBit w Posix.otherWriteMode + . modifyBit r Posix.otherReadMode + . Posix.fileMode $ stat + ) + + +setMode :: Role -> Permissions -> Posix.FileMode -> Posix.FileMode +setMode utype (Permissions r w e) mode = + case utype of + Owner -> setOwnerPermissions + Group -> setGroupPermissions + Others -> setOthersPermissions + + where + + setOwnerPermissions = + modifyBit e Posix.ownerExecuteMode + $ modifyBit w Posix.ownerWriteMode + $ modifyBit r Posix.ownerReadMode mode + + setGroupPermissions = + modifyBit e Posix.groupExecuteMode + $ modifyBit w Posix.groupWriteMode + $ modifyBit r Posix.groupReadMode mode + + setOthersPermissions = + modifyBit e Posix.otherExecuteMode + $ modifyBit w Posix.otherWriteMode + $ modifyBit r Posix.otherReadMode mode + +-- | Change the file permission modes for specified roles using the specified +-- permission modifier functions. +-- +-- You can use the @mode@ quasiquoter to build the mode conveniently, for +-- example: +-- +-- >> chmod [mode|a=rwx|] "a.txt" +-- +chmod :: [(Role, Permissions -> Permissions)] -> FilePath -> IO () +-- To implement this, get the file mode. Transform the FileMode using the roles +-- and permissions, and then use a single setFileMode call to set the mode in +-- the end. +chmod perms path = do + stat <- Posix.getFileStatus path + let fm = foldl tr (Posix.fileMode stat) perms + Posix.setFileMode path fm + return () + + where + + tr mode (role, f) = unsafePerformIO $ do + stat <- Posix.getFileStatus path + let perm = case role of + Owner -> uPerm stat + Group -> gPerm stat + Others -> oPerm stat + fperm = f perm + return $ setMode role fperm mode + + -- current permissions + uPerm stat = + Permissions + (Posix.fileMode stat .&. Posix.ownerReadMode + == Posix.ownerReadMode) + (Posix.fileMode stat .&. Posix.ownerWriteMode + == Posix.ownerWriteMode) + (Posix.fileMode stat .&. Posix.ownerExecuteMode + == Posix.ownerExecuteMode) + + gPerm stat = + Permissions + (Posix.fileMode stat .&. Posix.groupReadMode + == Posix.groupReadMode) + (Posix.fileMode stat .&. Posix.groupWriteMode + == Posix.groupWriteMode) + (Posix.fileMode stat .&. Posix.groupExecuteMode + == Posix.groupExecuteMode) + + oPerm stat = + Permissions + (Posix.fileMode stat .&. Posix.otherReadMode + == Posix.otherReadMode) + (Posix.fileMode stat .&. Posix.otherWriteMode + == Posix.otherWriteMode) + (Posix.fileMode stat .&. Posix.otherExecuteMode + == Posix.otherExecuteMode) diff --git a/src/Streamly/Coreutils/StringQ.hs b/src/Streamly/Coreutils/StringQ.hs new file mode 100644 index 0000000..e14298d --- /dev/null +++ b/src/Streamly/Coreutils/StringQ.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE TemplateHaskell #-} +-- | +-- Module : Streamly.Coreutils.StringQ +-- Copyright : (c) 2022 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC +-- +-- change file mode bits. + +-- XXX Rename to "Permissions" or "AccessControl" + +module Streamly.Coreutils.StringQ + ( + Role(..) + , Permissions(..) + , setReadable + , setWritable + , setExecutable + , reset + ) +where + +import Control.Applicative (Alternative(..)) +import Control.Monad.Catch (MonadCatch) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Data.Char (chr) +import Data.Data (Data) +import Data.Default.Class (Default(..)) +import Language.Haskell.TH (Exp, Q, Pat) +import Language.Haskell.TH.Quote (QuasiQuoter(..), dataToExpQ, dataToPatQ) +import Streamly.Internal.Data.Parser (Parser) + +import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Parser as Parser +import qualified Streamly.Internal.Data.Stream.IsStream as Stream +import qualified Streamly.Internal.Unicode.Parser as Parser + +------------------------------------------------------------------------------- +-- Permissions +------------------------------------------------------------------------------- + +-- | Permissions for access control +data Permissions = Permissions + { readable :: Bool + , writable :: Bool + , executable :: Bool + -- , searchable :: Bool -- for portability, keep it separate + } deriving (Eq, Ord, Read, Show, Data) + +{- +defaultPermissions = + Permissions + { readable = False + , writable = False + , executable = False + } +-} + +-- | Enable @read@ permission. +setReadable :: Bool -> Permissions -> Permissions +setReadable x perms = perms { readable = x } + +-- | Enable @write@ permission. +setWritable :: Bool -> Permissions -> Permissions +setWritable x perms = perms { writable = x } + +-- | Enable @execute@ permission. +setExecutable :: Bool -> Permissions -> Permissions +setExecutable x perms = perms { executable = x } + +-- | Disable all permissions. +reset :: Permissions -> Permissions +reset = setReadable False . setWritable False . setExecutable False + +------------------------------------------------------------------------------- +-- Roles +------------------------------------------------------------------------------- + +-- | Roles to whom access is granted. +data Role = + Owner + | Group + | Others + deriving (Eq, Ord, Read, Show, Data) + +------------------------------------------------------------------------------- +-- Mode parser +------------------------------------------------------------------------------- + +{- +strParser :: MonadCatch m => Parser Char m String +strParser = + let ut = Parser.char 'u' + <|> Parser.char 'g' + <|> Parser.char 'o' + <|> Parser.char 'a' + op = Parser.char '=' -- supports only override permissions bits + p1 = Parser.char (chr 0) + <|> Parser.char 'r' + <|> Parser.char 'w' + <|> Parser.char 'x' + r = ut *> op + r1 = ut *> op *> p1 + r2 = ut *> op *> p1 *> p1 + r3 = ut *> op *> p1 *> p1 *> p1 + s = r <|> r1 <|> r2 <|> r3 + in Parser.some s Fold.toList + +expandVars :: String -> IO () +expandVars ln = + case Stream.parse strParser (Stream.fromList ln) of + Left _ -> fail "Parsing of perm quoted string failed." + Right _ -> return () + +parseExpr :: MonadIO m => String -> m [(Role, Permissions)] +parseExpr s = do + liftIO $ expandVars s + let ut = head s + bits = tail $ tail s + return $ + case ut of + 'u' -> UserTypePerm Owner $ setPermission bits + 'g' -> UserTypePerm Group $ setPermission bits + 'o' -> UserTypePerm Others $ setPermission bits + 'a' -> UserTypePerm All $ setPermission bits + _ -> error "Invalid permissions" + + where + + setPermission bits = + case bits of + "rwx" -> Permissions True True True + "rw" -> Permissions True True False + "r" -> Permissions True False False + "w" -> Permissions False True False + "x" -> Permissions False False True + "rx" -> Permissions True False True + "wx" -> Permissions False True True + _ -> def + +quoteExprExp :: String -> Q Exp +quoteExprExp s = do + expr <- parseExpr s + dataToExpQ (const Nothing) expr + +quoteExprPat :: String -> Q Pat +quoteExprPat s = do + expr <- parseExpr s + dataToPatQ (const Nothing) expr + +-- TODO: perms can have a single letter from the set ugo, in that case the +-- existing permissions are copied from that role. + +-- When we get a "=" use 'reset', when we get a '+' use an operation with +-- argument True, else use False. + +-- | 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 +-- @ +-- +-- If the role is omitted it is assumed to be 'a'. +mode :: QuasiQuoter +mode = + QuasiQuoter + { quoteExp = quoteExprExp + , quotePat = quoteExprPat + , quoteType = error "mode: quoteType not supported." + , quoteDec = error "mode: quoteDec not supported." + } +-} diff --git a/streamly-coreutils.cabal b/streamly-coreutils.cabal index 8394de6..8832113 100644 --- a/streamly-coreutils.cabal +++ b/streamly-coreutils.cabal @@ -106,10 +106,15 @@ library , unix >= 2.7.0 && < 2.8 , directory >= 1.2.2 && < 1.4 , filepath >= 1.4 && < 1.5 + , data-default-class >= 0.1 && < 0.2 + , template-haskell >= 2.10.0 && < 2.19.0 + hs-source-dirs: src exposed-modules: Streamly.Coreutils + , Streamly.Coreutils.Chmod.Posix , Streamly.Coreutils.Common + , Streamly.Coreutils.StringQ , Streamly.Coreutils.Cp , Streamly.Coreutils.Directory , Streamly.Coreutils.Dirname