HSHHelpers 0.16 → 0.17

raw patch · 4 files changed

+50/−46 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HSH/Helpers/FileManip.hs +9/−0
• HSH/Helpers/UnixUsers.hs +39/−45
• HSH/Helpers/Utils.hs +1/−0
• HSHHelpers.cabal +1/−1

@@ -21,6 +21,15 @@   deriving Show symlink slArgs = runIO $ render1 [("target",target slArgs),("link",link slArgs)] "ln -fs $target$ $link$"  +-- | wrapper over find \/path\/to\/top\/dir -type d+findDirectories :: FilePath -> IO [FilePath]+findDirectories d = runStrings $ render1 [("d",d)] "find $d$ -type d"++runS :: String -> IO String+runS = run+runStrings :: String -> IO [String]+runStrings = ( return . lines =<< ) . run + -- I took this out because I don't like the behavior of doesFileExist when it comes to symlinks -- If  symlink exists, but it's to a directlry, this test is false -- Or if it's to a nonexisting file, also false.

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-} module HSH.Helpers.UnixUsers where  -- I don't know how portable this is.@@ -15,21 +15,36 @@ 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 ()+-- similar formats, so we can share most of the logic+isSystemUser :: SysUser -> IO Bool+isSystemUser u = return . elem u =<< systemUsers -groupaddIfMissing g = do-  sysG <- isSystemGroup g-  if not sysG-    then groupadd g-    else return ()--}+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$"@@ -49,59 +64,38 @@                                            , ("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+-- basically just get the first column. regex gets everything up to the first :.+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 -> 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 = runIO $ render1 [("u",u),("g",g)] "usermod -G $g$ -a $u$"+  | otherwise = tryS $ 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+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 ()+chown :: (Maybe SysUser) -> (Maybe SysGroup) -> Recurse -> FilePath -> IO ( Either String () ) chown _ _ _ [] = fail "chown, empty path"-chown mbUser mbGroup (Recurse recurse) path = do+chown mbUser mbGroup (Recurse recurse) path = tryS $ do   let uname = maybe "" unsysuser mbUser       grp = maybe "" unsysgroup mbGroup       eOwner = getOwner uname grp@@ -121,8 +115,8 @@ -- 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+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 -> "-"

@@ -31,3 +31,4 @@     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,5 +1,5 @@ Name: HSHHelpers-Version: 0.16+Version: 0.17 License: GPL License-file: gpl.txt Description: