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

-- I don't know how portable this is.
-- It works for me, on ubuntu Hardy Heron
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

{-
-- does nothing if the user already exists
useraddIfMissing uaCmd = do
  sysU <- isSystemUser (useraddUsername uaCmd)
  if not sysU
    then useradd uaCmd
    else return ()

groupaddIfMissing g = do
  sysG <- isSystemGroup g
  if not sysG
    then groupadd g
    else return ()
-}

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

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

-- similar formats, so we can share most of the logic
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
  -- basically just get the first column. regex gets everything up to the first :.
  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 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 ()
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$"

-- need to test this more thoroughly. What happens if we attempt to remove user from primary group?
--rmUserFromSecondaryGroup :: SysUser -> SysGroup -> IO ()
rmUserFromGroup u g = 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 ()
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"

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

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