module HSH.Helpers.UnixUsers where
import HSH
import System.Directory (doesDirectoryExist)
import Text.Regex.PCRE
import Control.Monad.Error
import System.IO.Error
import qualified Data.String.Utils as SU
import Text.StringTemplate.Helpers
import HSH.Helpers.Utils
import Debug.Trace.Helpers
groupadd :: SysGroup -> IO (Either String ())
groupadd (SysGroup g) = tryS $ runIO $ render1 [("g",g)] "groupadd $g$"
groupdel :: SysGroup -> IO (Either String ())
groupdel (SysGroup g) = tryS $ runIO $ render1 [("g",g)] "groupdel $g$"
useradd :: SysUser -> (Maybe SysGroup) -> (Maybe SysShell) -> (Maybe SysHomedir) -> IO (Either String ())
useradd (SysUser uname) mbG mbSh mbHomedir = do
let grp = maybe "" ( ("-g " ++ ) . unsysgroup ) mbG
shell = maybe "" ( ("--shell " ++) . unsysshell ) mbSh
hdir = maybe "" ( ("--home-dir " ++) . unsyshomedir ) mbHomedir
tryS $ runIO $ render1 [ ("uname",uname)
, ("grp",grp)
, ("shell",shell)
, ("hdir",hdir) ]
"useradd $uname$ $grp$ $shell$ $hdir$"
isSystemUser :: SysUser -> IO Bool
isSystemUser (SysUser u) = isSystemUG' "/etc/passwd" u
isSystemGroup :: SysGroup -> IO Bool
isSystemGroup (SysGroup g) = isSystemUG' "/etc/group" g
isSystemUG' f u = return . elem u . map parseug . lines
=<< readFile f
where parseug ug = let ((_,match,_,_) :: (String,String,String,[String])) = ug =~ "^[^:]*"
in match
isSysGroupMember :: SysUser -> SysGroup -> IO Bool
isSysGroupMember u g = do
a <- getSysGroupsAll u
return $ elem g a
getSysGroupPrimary :: SysUser -> IO SysGroup
getSysGroupPrimary (SysUser u) = return . SysGroup =<< ( runSL $ render1 [("u",u)] "id -ng $u$" )
getSysGroupsSecondary :: SysUser -> IO [SysGroup]
getSysGroupsSecondary u = do
p <- getSysGroupPrimary u
all <- getSysGroupsAll u
return $ filter (p/=) all
getSysGroupsAll :: SysUser -> IO [SysGroup]
getSysGroupsAll (SysUser u) = return . map SysGroup . words =<< (runSL $ render1 [("u",u)] "id -nG $u$")
addUserToGroup :: SysUser -> SysGroup -> IO ()
addUserToGroup (SysUser u) (SysGroup g)
| null . SU.strip $ u = fail "addUserToGroup: blank user"
| null . SU.strip $ g = fail "addUserToGroup: blank group"
| otherwise = runIO $ render1 [("u",u),("g",g)] "usermod -G $g$ -a $u$"
rmUserFromGroup u g = do
(sd :: [SysGroup])<- getSysGroupsAll u
let sdMod = SU.join "," . map unsysgroup . filter (g/=) $ sd
runIO $ render1 [("u",unsysuser u),("sdMod",sdMod)] "usermod -G $sdMod$ $u$"
chown :: (Maybe SysUser) -> (Maybe SysGroup) -> Recurse -> FilePath -> IO ()
chown _ _ _ [] = fail "chown, empty path"
chown mbUser mbGroup (Recurse recurse) path = do
let uname = maybe "" unsysuser mbUser
grp = maybe "" unsysgroup mbGroup
eOwner = getOwner uname grp
rFlag = if recurse then "-R" else ""
case eOwner of
Left msg -> fail msg
Right owner -> runIO $ render1 [("owner",owner)
, ("rFlag",rFlag)
, ("path",path) ]
"chown $owner$ $rFlag$ $path$"
where getOwner u@(_:_) g@(_:_) = Right $ u++":"++g
getOwner u@(_:_) [] = Right u
getOwner [] g@(_:_) = Right $ ":"++g
getOwner [] [] = Left $ "chown error, no user and no group"
chmod :: ChmodAddDelEq -> ChmodRole -> ChmodPerm -> Recurse -> FilePath -> IO ()
chmod op' ugo' perm' (Recurse recurse') path = do
let op = case op' of
ChmodAdd ->"+"
ChmodDel -> "-"
ChmodEq -> "="
ugo = case ugo' of
ChmodU -> "u"
ChmodG -> "g"
ChmodO -> "o"
ChmodUG -> "ug"
ChmodUO -> "uo"
ChmodGO -> "go"
ChmodUGO -> "ugo"
perm = case perm' of
ChmodR -> "r"
ChmodW -> "w"
ChmodX -> "x"
ChmodRW -> "rw"
ChmodRX -> "rx"
ChmodWX -> "wx"
ChmodRWX -> "rwx"
recurse = if recurse' then "-R" else ""
runIO $ traceIt $ render1 [("op",op)
, ("ugo",ugo)
, ("recurse",recurse)
, ("perm",perm)
, ("path",path)] "chmod $ugo$$op$$perm$ $recurse$ $path$"
data ChmodAddDelEq = ChmodAdd | ChmodDel | ChmodEq
data ChmodRole = ChmodU | ChmodG | ChmodO | ChmodUG | ChmodUO | ChmodGO | ChmodUGO
data ChmodPerm = ChmodR | ChmodW | ChmodX | ChmodRW | ChmodRX | ChmodWX | ChmodRWX
newtype SysUser = SysUser { unsysuser :: String }
deriving (Read,Show,Eq)
newtype SysGroup = SysGroup { unsysgroup :: String }
deriving (Read,Show,Eq)
newtype SysShell = SysShell { unsysshell :: String }
deriving (Read,Show,Eq)
newtype SysHomedir = SysHomedir { unsyshomedir :: String }
deriving (Read,Show,Eq)
newtype Recurse = Recurse { unrecures :: Bool }
deriving (Read,Show,Eq)