summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2016-03-25 14:24:09 -0400
committerJoey Hess2016-03-25 14:24:09 -0400
commit9768434f5fa2f2ed0bbb0212763a76471186a3cd (patch)
treec5c13b99ef9cb38351a0a0c8ab25280ff3a155f9 /src/Propellor/Property
parent91d1833155a2e8be2c435d0a92a750cc9d2f30b5 (diff)
finished porting Property.User
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/List.hs10
-rw-r--r--src/Propellor/Property/User.hs29
2 files changed, 24 insertions, 15 deletions
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