module Chmod (
Chmod(..)
, ChmodWho(..)
, ChmodWhat(..)
, parseChmod
, applyChmod
) where
import Control.Monad (guard, msum)
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char (ord, isOctDigit)
import Data.List (foldl')
import Data.Maybe (mapMaybe)
import Data.Word (Word16)
import Data.Hadoop.Types (FileType(..))
------------------------------------------------------------------------
data ChmodWho = Chmod_u | Chmod_g | Chmod_o | Chmod_a
deriving (Show, Eq)
data ChmodWhat = Chmod_r | Chmod_w | Chmod_x | Chmod_X
| Chmod_s | Chmod_t
deriving (Show, Eq)
data Chmod = SetOctal Word16
| SetEqual ChmodWho [ChmodWhat]
| SetPlus ChmodWho [ChmodWhat]
| SetMinus ChmodWho [ChmodWhat]
| SetEqualWho ChmodWho ChmodWho
| SetPlusWho ChmodWho ChmodWho
| SetMinusWho ChmodWho ChmodWho
deriving (Show, Eq)
parseChmod :: Atto.Parser [Chmod]
parseChmod = do
cs <- Atto.sepBy chmod1 (Atto.char ',')
guard (cs /= [])
return cs
where
chmod1 = msum
[ SetOctal <$> octal
, SetEqual <$> ugoa <* Atto.char '=' <*> Atto.many1 rwx
, SetPlus <$> ugoa <* Atto.char '+' <*> Atto.many1 rwx
, SetMinus <$> ugoa <* Atto.char '-' <*> Atto.many1 rwx
, SetEqualWho <$> ugoa <* Atto.char '=' <*> ugo
, SetPlusWho <$> ugoa <* Atto.char '+' <*> ugo
, SetMinusWho <$> ugoa <* Atto.char '-' <*> ugo
]
ugo :: Atto.Parser ChmodWho
ugo = msum
[ pure Chmod_u <* Atto.char 'u'
, pure Chmod_g <* Atto.char 'g'
, pure Chmod_o <* Atto.char 'o'
]
ugoa :: Atto.Parser ChmodWho
ugoa = msum
[ ugo
, pure Chmod_a <* Atto.char 'a'
]
rwx :: Atto.Parser ChmodWhat
rwx = msum
[ pure Chmod_r <* Atto.char 'r'
, pure Chmod_w <* Atto.char 'w'
, pure Chmod_x <* Atto.char 'x'
, pure Chmod_X <* Atto.char 'X'
{-
, pure Chmod_s <* Atto.char 's'
, pure Chmod_t <* Atto.char 't'
-}
]
octal :: Atto.Parser Word16
octal = B.foldl' step 0 `fmap` Atto.takeWhile1 isOctDigit
where
step a w = a * 8 + fromIntegral (ord w - 48)
applyChmod :: FileType -> [Chmod] -> Word16 -> Word16
applyChmod filetype = flip (foldl' f)
where
f :: Word16 -> Chmod -> Word16
f _ (SetOctal new) = new
f old (SetEqual who ws) = set who old (foldRWX old ws)
f old (SetPlus who ws) = plus who old (foldRWX old ws)
f old (SetMinus who ws) = minus who old (foldRWX old ws)
f old (SetEqualWho who src) = set who old (extract src old)
f old (SetPlusWho who src) = plus who old (extract src old)
f old (SetMinusWho who src) = minus who old (extract src old)
set :: ChmodWho -> Word16 -> Word16 -> Word16
set who old new = (old .&. complement (mask who)) .|. setWho who new
plus :: ChmodWho -> Word16 -> Word16 -> Word16
plus who old new = old .|. setWho who new
minus :: ChmodWho -> Word16 -> Word16 -> Word16
minus who old new = old `xor` setWho who new
foldRWX old = foldl' (\old' what -> old' .|. b what) 0 . mapMaybe (hX old)
o3 u g o = u*64 + g*8 + o
mask :: ChmodWho -> Word16
mask Chmod_a = o3 7 7 7
mask who = 7 `shiftL` s who
setWho :: ChmodWho -> Word16 -> Word16
setWho Chmod_a new = foldl' (.|.) 0 $
map (`setWho` new) [Chmod_u, Chmod_g, Chmod_o]
setWho who new = new `shiftL` s who
extract :: ChmodWho -> Word16 -> Word16
extract who old = (mask who .&. old) `shiftR` s who
-- handle X
hX :: Word16 -> ChmodWhat -> Maybe ChmodWhat
hX old Chmod_X = if filetype == Dir || old .&. o3 1 1 1 /= 0
then Just Chmod_x
else Nothing
hX _ what = Just what
-- Bit to set for what
b :: ChmodWhat -> Word16
b Chmod_r = 4
b Chmod_w = 2
b Chmod_x = 1
-- Number of bits to shift for who
s :: ChmodWho -> Int
s Chmod_u = 6
s Chmod_g = 3
s Chmod_o = 0