{-# 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 qualified Data.String.Utils as SU
import Text.StringTemplate.Helpers

type SysUser = String
type SysGroup = String
type SysShell = String


data UseraddCmd = UseraddCmd {
  useraddUsername :: SysUser
  , useraddGrp :: Maybe SysGroup
  , useraddShell :: Maybe SysShell
  , useraddHomedir :: Maybe FilePath
  -- whether to create the user if there's already a homedir in their name,
  -- perhaps left over from another person with the same username
  --  who has been deleted but whose homedir remains.
  , useraddAllowExistingHomedir :: Bool 
  , useraddExe :: Maybe FilePath
  }

-- 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 g = runIO $ "groupadd " ++ g
groupadd' :: Maybe FilePath -> SysGroup -> IO ()
groupadd' mbExe g = 
  let gaCmd = maybe "groupadd" id mbExe
  in runIO $ render1 [("gaCmd",gaCmd),("g",g)] "$gaCmd$ $g$"

-- a wrapper over the useradd command 
useradd uaCmd = do
  let uname = useraddUsername uaCmd 
      grp = maybe "" ("-g " ++ ) (useraddGrp uaCmd)
      shell = maybe "" ("--shell " ++) (useraddShell uaCmd)
      hdir = maybe "" ("--home-dir " ++) (useraddHomedir uaCmd) 
      useraddexe = maybe "useradd" id (useraddExe uaCmd)
  homedirExists <- doesDirectoryExist hdir
  if (not . null $ hdir) && (not . useraddAllowExistingHomedir $ uaCmd) && homedirExists
    then fail $ "createUnixUser failed, homedir exists: " ++ hdir
    else runIO $ {- traceIt $ -} render1 [ ("useraddexe",useraddexe) 
                                           , ("uname",uname) 
                                           , ("grp",grp) 
                                           , ("shell",shell) 
                                           , ("hdir",hdir) ]  
                                 "$useraddexe$ $uname$ $grp$ $shell$ $hdir$"

-- similar formats, so we can share most of the logic
isSystemUser = isSystemUG' "/etc/passwd"
isSystemGroup = isSystemUG' "/etc/group"
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

sysGroupMember u g = do
  a <- getSysGroupsAll u
  return $ elem g a

getSysGroupPrimary u = runSL $ render1 [("u",u)] "id -ng $u$"
getSysGroupsSecondary u = do
  p <- getSysGroupPrimary u
  all <- getSysGroupsAll u
  return $ filter (p/=) all
getSysGroupsAll u = return . words =<< (runSL $ render1 [("u",u)] "id -nG $u$")

data AddUserToGroupArgs = AddUserToGroupArgs {addUserToGroupUser::String,addUserToGroupGroup::String}

-- 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.
tAddUserToGroup = addUserToGroup $ AddUserToGroupArgs {addUserToGroupUser="thartman",addUserToGroupGroup="thartman"}
addUserToGroup AddUserToGroupArgs {addUserToGroupUser=u,addUserToGroupGroup=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$"

rmUserFromSecondaryGroup :: SysUser -> SysGroup -> IO ()
rmUserFromSecondaryGroup u g = do
  sd <- getSysGroupsAll u
  -- users are joined by a comma, no intervening whitespace (man usermod)
  let sdMod = SU.join "," $ filter (g/=) sd
  runIO $ render1 [("u",u),("sdMod",sdMod)] "usermod -G $sdMod$ $u$"



data ChownOptions = ChownOptions { 
  chownUser :: Maybe String
  , chownGrp :: Maybe String
  , chownR :: Bool -- recurse into subdirectories
  -- chownCreateUserIfMissing -- might be useful
  }

chown = chown' "chown"
chown' chownexe chownOptions path = do
  let uname = maybe "" id (chownUser chownOptions)
      grp = maybe "" id (chownGrp chownOptions)
      getOwner u@(_:_) g@(_:_) = Right $ u++":"++g 
      getOwner u@(_:_) [] = Right u
      getOwner [] g@(_:_) = Right $ ":"++g
      getOwner [] [] = Left $ "chown error, no user and no group"
      eOwner = getOwner uname grp
      rFlag = if (chownR chownOptions) then "-R" else ""
  case eOwner of
    Left msg -> fail msg
    Right owner -> runIO $ {- traceIt $ -} render1 [ ("chownexe",chownexe) 
                                           , ("owner",owner) 
                                           , ("rFlag",rFlag)
                                           , ("path",path) ]  
                                 "$chownexe$ $owner$ $rFlag$ $path$"


-- chown u g d = runIO $ render1 [("u",u),("g",g),("d",d)] "chown $u$:$g$ $d$"
-- chownR u g d = runIO $ render1 [("u",u),("g",g),("d",d)] "chown -R $u$:$g$ $d$"