HSHHelpers 0.13 → 0.15

raw patch · 4 files changed

+162/−85 lines, 4 filesdep +DebugTraceHelpersdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: DebugTraceHelpers, mtl

API changes (from Hackage documentation)

Files

• HSH/Helpers.hs +7/−5
• HSH/Helpers/UnixUsers.hs +110/−75
• HSH/Helpers/Utils.hs +33/−0
• HSHHelpers.cabal +12/−5

@@ -1,15 +1,17 @@ {-# LANGUAGE FlexibleInstances #-} module HSH.Helpers (-  failIf-  , module HSH.Helpers.Instances+  module HSH.Helpers.Instances   , module HSH.Helpers.UnixUsers   , module HSH.Helpers.FileManip+  , module HSH.Helpers.Utils ) where  import HSH.Helpers.Instances import HSH.Helpers.UnixUsers import HSH.Helpers.FileManip+import HSH.Helpers.Utils -failIf ioP m = do-  p <- ioP-  if p then fail m else return () +import HSH+++

@@ -4,29 +4,18 @@ -- 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 -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-  }+import HSH.Helpers.Utils+import Debug.Trace.Helpers +{- -- does nothing if the user already exists useraddIfMissing uaCmd = do   sysU <- isSystemUser (useraddUsername uaCmd)@@ -39,101 +28,147 @@   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$"+groupadd :: SysGroup -> IO (Either String ())+groupadd (SysGroup g) = -- runErrorT $ do+  -- inPath "groupadd"+  tryS $ runIO $ render1 [("g",g)] "groupadd $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) +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) ]  -                                 "$useraddexe$ $uname$ $grp$ $shell$ $hdir$"+                                 "useradd $uname$ $grp$ $shell$ $hdir$"  -- similar formats, so we can share most of the logic-isSystemUser = isSystemUG' "/etc/passwd"-isSystemGroup = isSystemUG' "/etc/group"+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 -sysGroupMember u g = do+isSysGroupMember :: SysUser -> SysGroup -> IO Bool+isSysGroupMember u g = do   a <- getSysGroupsAll u   return $ elem g a -getSysGroupPrimary u = runSL $ render1 [("u",u)] "id -ng $u$"+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 u = return . words =<< (runSL $ render1 [("u",u)] "id -nG $u$") +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 = addUserToGroup' (Just "usermod")-addUserToGroup' :: (Maybe FilePath) -> SysUser -> SysGroup -> IO ()-addUserToGroup' mbUsermodCmd u g +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 =-      let usermodCmd = maybe "usermod" id mbUsermodCmd-      in runIO $ render1 [("usermodCmd",usermodCmd),("u",u),("g",g)]-                                      "$usermodCmd$ -G $g$ -a $u$"+  | otherwise = runIO $ render1 [("u",u),("g",g)] "usermod -G $g$ -a $u$" -rmUserFromSecondaryGroup :: SysUser -> SysGroup -> IO ()-rmUserFromSecondaryGroup u g = do-  sd <- getSysGroupsAll 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 "," $ filter (g/=) sd-  runIO $ render1 [("u",u),("sdMod",sdMod)] "usermod -G $sdMod$ $u$"-+  let sdMod = SU.join "," . map unsysgroup . filter (g/=) $ sd+  runIO $ render1 [("u",unsysuser 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"+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 (chownR chownOptions) then "-R" else ""+      rFlag = if recurse 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$"+    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$ $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$"+-- 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)

@@ -0,0 +1,33 @@+module HSH.Helpers.Utils where++import HSH+import Text.StringTemplate.Helpers+import Control.Monad.Error+import System.IO.Error++failIf ioP m = do+  p <- ioP+  if p then fail m else return () +++-- Executes an IO action with a modified environment, where the $PATH variable has the given paths prepended+-- Useful, for example, for getting commands to work from the cron command, +-- where $PATH may vary from the $PATH you have at user login, with unpredictable results+-- withPath :: [FilePath] -> IO a -> IO a+inPath :: FilePath -> ErrorT String IO ()+inPath p = do+  ErrorT $ do+    res <- tryS $ runIO $ render1 [("p",p)] $ "which $p$"+    case res of +         Left _ -> return . Left $+                     render1 [("p",p)] "$p$ is not in \\$PATH, maybe you need to modify your shell environment"+         Right _ -> return . Right $ ()++++tryS :: IO a -> IO (Either String a)+tryS ma = return . mapeither show id =<< try ma+  where+    mapeither :: (a -> a') -> (b -> b') -> Either a b -> Either a' b'+    mapeither f g (Left x) = Left $ f x+    mapeither f g (Right x) = Right $ g x

@@ -1,15 +1,22 @@ Name: HSHHelpers-Version: 0.13+Version: 0.15 License: GPL License-file: gpl.txt-Description: Convenience functions and instances for HSH. I will deprecate this package if its contents are integrated into HSH.-Synopsis: Convenience functions and instances for HSH+Description: ++  Functions I found I was using repeatedly when doing shell programming with HSH.++  Rather than duplicate code, released on hackage.++Synopsis: Convenience functions that use HSH, instances for HSH.  Maintainer: Thomas Hartman <thomashartman1 at gmail> Author: Thomas Hartman Stability: Beta Copyright: Copyright (c) 2008 Thomas Hartman-Exposed-Modules: HSH.Helpers, HSH.Helpers.Instances, HSH.Helpers.UnixUsers, HSH.Helpers.FileManip-Build-Depends: base, HSH, unix, HStringTemplateHelpers, MissingH, regex-pcre, directory, bytestring, filepath+Exposed-Modules: HSH.Helpers, HSH.Helpers.Instances, HSH.Helpers.UnixUsers, HSH.Helpers.FileManip, +                 HSH.Helpers.Utils+Build-Depends: base, HSH, unix, HStringTemplateHelpers, MissingH, regex-pcre, directory, bytestring, filepath, mtl,+               DebugTraceHelpers Category: System Build-type: Simple