From 9768434f5fa2f2ed0bbb0212763a76471186a3cd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 25 Mar 2016 14:24:09 -0400 Subject: finished porting Property.User --- src/Propellor/Base.hs | 8 ++++---- src/Propellor/PropAccum.hs | 14 +++++++------- src/Propellor/Property.hs | 10 +++++----- src/Propellor/Property/List.hs | 10 +++++++--- src/Propellor/Property/User.hs | 29 +++++++++++++++++------------ 5 files changed, 40 insertions(+), 31 deletions(-) diff --git a/src/Propellor/Base.hs b/src/Propellor/Base.hs index 4afad2ab..2a0f5cbc 100644 --- a/src/Propellor/Base.hs +++ b/src/Propellor/Base.hs @@ -7,12 +7,12 @@ module Propellor.Base ( module Propellor.Types , module Propellor.Property , module Propellor.Property.Cmd - --, module Propellor.Property.List + , module Propellor.Property.List , module Propellor.Types.PrivData , module Propellor.PropAccum , module Propellor.Info , module Propellor.PrivData - --, module Propellor.Engine + , module Propellor.Engine , module Propellor.Exception , module Propellor.Message , module Propellor.Debug @@ -34,8 +34,8 @@ module Propellor.Base ( import Propellor.Types import Propellor.Property ---import Propellor.Engine ---import Propellor.Property.List +import Propellor.Engine +import Propellor.Property.List import Propellor.Property.Cmd import Propellor.PrivData import Propellor.Types.PrivData diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs index 8177b97b..91d7b80d 100644 --- a/src/Propellor/PropAccum.hs +++ b/src/Propellor/PropAccum.hs @@ -30,17 +30,17 @@ import Propellor.PrivData -- > ! oldproperty -- > & otherproperty host :: HostName -> Props metatypes -> Host -host hn (Props i c) = Host hn c i +host hn (Props c) = Host hn c (mconcat (map getInfoRecursive c)) -- | Props is a combination of a list of properties, with their combined --- metatypes and info. -data Props metatypes = Props Info [ChildProperty] +-- metatypes. +data Props metatypes = Props [ChildProperty] -- | Start accumulating a list of properties. -- -- Properties can be added to it using `(&)` etc. props :: Props UnixLike -props = Props mempty [] +props = Props [] infixl 1 & infixl 1 &^ @@ -62,7 +62,7 @@ type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp p]) +Props c & p = Props (c ++ [toProp p]) -- | Adds a property before any other properties. (&^) @@ -74,7 +74,7 @@ Props i c & p = Props (i <> getInfoRecursive p) (c ++ [toProp p]) => Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y)) -Props i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c) +Props c &^ p = Props (toProp p : c) -- | Adds a property in reverted form. (!) @@ -82,7 +82,7 @@ Props i c &^ p = Props (i <> getInfoRecursive p) (toProp p : c) => Props (MetaTypes x) -> RevertableProperty (MetaTypes y) (MetaTypes z) -> Props (MetaTypes (Combine x z)) -Props i c ! p = Props (i <> getInfoRecursive p) (c ++ [toProp (revert p)]) +Props c ! p = Props (c ++ [toProp (revert p)]) {- diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 8999d8d8..ba30209e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -255,12 +255,12 @@ isNewerThan x y = do tightenTargets :: -- Note that this uses PolyKinds - ( (Targets old `NotSuperset` Targets new) ~ 'CanCombine - , (NonTargets new `NotSuperset` NonTargets old) ~ 'CanCombine - , SingI new + ( (Targets untightened `NotSuperset` Targets tightened) ~ 'CanCombine + , (NonTargets tightened `NotSuperset` NonTargets untightened) ~ 'CanCombine + , SingI tightened ) - => Property (MetaTypes old) - -> Property (MetaTypes new) + => Property (MetaTypes untightened) + -> Property (MetaTypes tightened) tightenTargets (Property _old d a i c) = Property sing d a i c {- diff --git a/src/Propellor/Property/List.hs b/src/Propellor/Property/List.hs index b4a72fa8..44916f23 100644 --- a/src/Propellor/Property/List.hs +++ b/src/Propellor/Property/List.hs @@ -7,18 +7,22 @@ module Propellor.Property.List ( props, Props, + toProps, propertyList, combineProperties, ) where import Propellor.Types import Propellor.Types.MetaTypes -import Propellor.Engine import Propellor.PropAccum +import Propellor.Engine import Propellor.Exception import Data.Monoid +toProps :: [Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes) +toProps ps = Props (map toProp ps) + -- | Combines a list of properties, resulting in a single property -- that when run will run each property in the list in turn, -- and print out the description of each as it's run. Does not stop @@ -30,7 +34,7 @@ import Data.Monoid -- > & bar -- > & baz propertyList :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) -propertyList desc (Props _i ps) = +propertyList desc (Props ps) = property desc (ensureChildProperties cs) `modifyChildren` (++ cs) where @@ -39,7 +43,7 @@ propertyList desc (Props _i ps) = -- | Combines a list of properties, resulting in one property that -- ensures each in turn. Stops if a property fails. combineProperties :: SingI metatypes => Desc -> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes) -combineProperties desc (Props _i ps) = +combineProperties desc (Props ps) = property desc (combineSatisfy cs NoChange) `modifyChildren` (++ cs) where diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index 8cbd11e4..76eae647 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -8,7 +8,7 @@ import qualified Propellor.Property.File as File data Eep = YesReallyDeleteHome accountFor :: User -> Property DebianLike -accountFor user@(User u) = check nohomedir go +accountFor user@(User u) = tightenTargets $ check nohomedir go `describe` ("account for " ++ u) where nohomedir = isNothing <$> catchMaybeIO (homedir user) @@ -22,7 +22,7 @@ systemAccountFor :: User -> Property DebianLike systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike -systemAccountFor' (User u) mhome mgroup = check nouser go +systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go `describe` ("system account for " ++ u) where nouser = isNothing <$> catchMaybeIO (getUserEntryForName u) @@ -44,7 +44,7 @@ systemAccountFor' (User u) mhome mgroup = check nouser go -- | Removes user home directory!! Use with caution. nuked :: User -> Eep -> Property DebianLike -nuked user@(User u) _ = check hashomedir go +nuked user@(User u) _ = tightenTargets $ check hashomedir go `describe` ("nuked user " ++ u) where hashomedir = isJust <$> catchMaybeIO (homedir user) @@ -75,8 +75,10 @@ hasPassword :: User -> Property (HasInfo + DebianLike) hasPassword user = hasPassword' user hostContext hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) -hasPassword' (User u) context = go `requires` shadowConfig True +hasPassword' (User u) context = go + `requires` shadowConfig True where + go :: Property (HasInfo + UnixLike) go = withSomePrivData srcs context $ property (u ++ " has password") . setPassword srcs = @@ -105,8 +107,9 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc hClose h lockedPassword :: User -> Property DebianLike -lockedPassword user@(User u) = check (not <$> isLockedPassword user) go - `describe` ("locked " ++ u ++ " password") +lockedPassword user@(User u) = tightenTargets $ + check (not <$> isLockedPassword user) go + `describe` ("locked " ++ u ++ " password") where go = cmdProperty "passwd" [ "--lock" @@ -131,7 +134,7 @@ homedir :: User -> IO FilePath homedir (User user) = homeDirectory <$> getUserEntryForName user hasGroup :: User -> Group -> Property DebianLike -hasGroup (User user) (Group group') = check test go +hasGroup (User user) (Group group') = tightenTargets $ check test go `describe` unwords ["user", user, "in group", group'] where test = not . elem group' . words <$> readProcess "groups" [user] @@ -150,7 +153,8 @@ hasDesktopGroups user@(User u) = property' desc $ \o -> do existinggroups <- map (fst . break (== ':')) . lines <$> liftIO (readFile "/etc/group") let toadd = filter (`elem` existinggroups) desktopgroups - ensureProperty o $ propertyList desc $ map (hasGroup user . Group) toadd + ensureProperty o $ propertyList desc $ toProps $ + map (hasGroup user . Group) toadd where desc = "user " ++ u ++ " is in standard desktop groups" -- This list comes from user-setup's debconf @@ -171,10 +175,10 @@ hasDesktopGroups user@(User u) = property' desc $ \o -> do -- | Controls whether shadow passwords are enabled or not. shadowConfig :: Bool -> Property DebianLike -shadowConfig True = check (not <$> shadowExists) +shadowConfig True = tightenTargets $ check (not <$> shadowExists) (cmdProperty "shadowconfig" ["on"]) `describe` "shadow passwords enabled" -shadowConfig False = check shadowExists +shadowConfig False = tightenTargets $ check shadowExists (cmdProperty "shadowconfig" ["off"]) `describe` "shadow passwords disabled" @@ -187,7 +191,7 @@ hasLoginShell :: User -> FilePath -> Property DebianLike hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell shellSetTo :: User -> FilePath -> Property DebianLike -shellSetTo (User u) loginshell = check needchangeshell +shellSetTo (User u) loginshell = tightenTargets $ check needchangeshell (cmdProperty "chsh" ["--shell", loginshell, u]) `describe` (u ++ " has login shell " ++ loginshell) where @@ -197,4 +201,5 @@ shellSetTo (User u) loginshell = check needchangeshell -- | Ensures that /etc/shells contains a shell. shellEnabled :: FilePath -> Property DebianLike -shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell +shellEnabled loginshell = tightenTargets $ + "/etc/shells" `File.containsLine` loginshell -- cgit v1.2.3