{-# LANGUAGE ScopedTypeVariables #-}
module HSH.Helpers.UnixUsers where

-- I don't know how portable this is.
-- It works for me, on ubuntu Hardy Heron
{-
Recommend against using this module.
Instead use System.Posix.Users, which I overlooked when writing.
-}
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

-- similar formats, so we can share most of the logic
isSystemUser :: SysUser -> IO Bool
isSystemUser u = return . elem u =<< systemUsers

isSystemGroup :: SysGroup -> IO Bool
isSystemGroup g = return . elem g =<< systemGroups

isSysGroupMember :: SysUser -> SysGroup -> IO Bool
isSysGroupMember u g = do
  a <- getSysGroupsAll u
  return $ elem g a

systemUsers :: IO [SysUser]
systemUsers = return . map ( SysUser . parseug) . lines =<< readFile "/etc/passwd"

systemGroups :: IO [SysGroup]
systemGroups = return . map ( SysGroup . parseug ) . lines =<< readFile "/etc/group"

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$")

-- wrapper over groupadd
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$"

userdel :: SysUser -> IO (Either String ())
userdel (SysUser u) = tryS $ runIO $ render1 [("u",u)] "userdel $u$"

-- a wrapper over the useradd command 
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 $ {- traceIt $ -} render1 [ ("uname",uname) 
                                           , ("grp",grp) 
                                           , ("shell",shell) 
                                           , ("hdir",hdir) ]  
                                 "useradd $uname$ $grp$ $shell$ $hdir$"



-- basically just get the first column. regex gets everything up to the first :.
parseug ug = let ((_,match,_,_) :: (String,String,String,[String])) =  ug =~ "^[^:]*" in match







-- addUserToGroup fails if user/group doesn't exist
-- if user is already in group, there's no error, which is the same behavior of the unix command.

addUserToGroup :: SysUser -> SysGroup -> IO ( Either String () )
addUserToGroup (SysUser u) (SysGroup g) 
  | null . SU.strip $ u = fail "addUserToGroup: blank user"
  | null . SU.strip $ g = fail "addUserToGroup: blank group" 
  | otherwise = tryS $ do 
      isU <- isSystemUser . SysUser $ u
      when (not isU) $ fail $ "chown, not a system user: " ++ u
      isG <- isSystemGroup . SysGroup $ g
      when (not isG) $ fail $ "chown, not a system group: " ++ g
      let cmd = render1 [("u",u),("g",g)] "usermod -G $g$ -a $u$"
      putStrLn $ "addUserToGroup, running: " ++ cmd
      runIO $ cmd
      

-- need to test this more thoroughly. What happens if we attempt to remove user from primary group?
rmUserFromGroup :: SysUser -> SysGroup -> IO ( Either String () )
rmUserFromGroup u g = tryS $ do
  (sd :: [SysGroup])<- getSysGroupsAll u
  -- users are joined by a comma, no intervening whitespace (man usermod)
  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 (Either String ())
chown _ _ _ [] = fail "chown, empty path"
chown mbUser mbGroup (Recurse recurse) path = tryS $ do
  let uname = maybe "" unsysuser mbUser
      grp = maybe "" unsysgroup mbGroup
      eOwner = getOwner uname grp
      rFlag = if recurse then "-R" else ""
  when (not . null $ uname) $ do
    isU <- isSystemUser . SysUser $ uname
    when (not isU) $ fail $ "chown, not a system user: " ++ uname
  when (not . null $ grp) $ do
    isG <- isSystemGroup . SysGroup $ grp
    when (not isG) $ fail $ "chown, not a system group: " ++ grp
  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"

-- todo: chmod flags Xst are currently ignored, 
-- as I have never use them and I find the chmod man file docu about them confusing... 
-- is there some interaction between these flags and the others that I need to be careful of?
-- I suppose a full implementation with all flag options available would be better though.
chmod :: ChmodAddDelEq -> ChmodRole -> ChmodPerm -> Recurse -> FilePath -> IO ( Either String () )
chmod op' ugo' perm' (Recurse recurse') path = tryS $ 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 $           render1 [("op",op)
                             , ("ugo",ugo)
                             , ("recurse",recurse)
                             , ("perm",perm)
                             , ("path",path)] "chmod $ugo$$op$$perm$ $recurse$ $path$"

-- could work on getUsersWithoutGroups, getUsersWithoutHomeDir, rmUsersWithoutGroups, etc
-- should put haddock readable comment that this might be a dangerous thing to do, 
-- but I've found it useful.

-- chmodF 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)