From a1655d24bbb1db9caccdf93eae8110d746389ae2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 28 Mar 2016 05:53:38 -0400 Subject: type safe targets for properties * Property types have been improved to indicate what systems they target. This prevents using eg, Property FreeBSD on a Debian system. Transition guide for this sweeping API change: - Change "host name & foo & bar" to "host name $ props & foo & bar" - Similarly, `propertyList` and `combineProperties` need `props` to be used to combine together properties; they no longer accept lists of properties. (If you have such a list, use `toProps`.) - And similarly, Chroot, Docker, and Systemd container need `props` to be used to combine together the properies used inside them. - The `os` property is removed. Instead use `osDebian`, `osBuntish`, or `osFreeBSD`. These tell the type checker the target OS of a host. - Change "Property NoInfo" to "Property UnixLike" - Change "Property HasInfo" to "Property (HasInfo + UnixLike)" - Change "RevertableProperty NoInfo" to "RevertableProperty UnixLike UnixLike" - Change "RevertableProperty HasInfo" to "RevertableProperty (HasInfo + UnixLike) UnixLike" - GHC needs {-# LANGUAGE TypeOperators #-} to use these fancy types. This is enabled by default for all modules in propellor.cabal. But if you are using propellor as a library, you may need to enable it manually. - If you know a property only works on a particular OS, like Debian or FreeBSD, use that instead of "UnixLike". For example: "Property Debian" - It's also possible make a property support a set of OS's, for example: "Property (Debian + FreeBSD)" - Removed `infoProperty` and `simpleProperty` constructors, instead use `property` to construct a Property. - Due to the polymorphic type returned by `property`, additional type signatures tend to be needed when using it. For example, this will fail to type check, because the type checker cannot guess what type you intend the intermediate property "go" to have: foo :: Property UnixLike foo = go `requires` bar where go = property "foo" (return NoChange) To fix, specify the type of go: go :: Property UnixLike - `ensureProperty` now needs to be passed a witness to the type of the property it's used in. change this: foo = property desc $ ... ensureProperty bar to this: foo = property' desc $ \w -> ... ensureProperty w bar - General purpose properties like cmdProperty have type "Property UnixLike". When using that to run a command only available on Debian, you can tighten the type to only the OS that your more specific property works on. For example: upgraded :: Property Debian upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - Several utility functions have been renamed: getInfo to fromInfo propertyInfo to getInfo propertyDesc to getDesc propertyChildren to getChildren * The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses which to use based on the Host's OS. * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling these complex new types. * Added dependency on concurrent-output; removed embedded copy. --- src/Propellor/Property/User.hs | 63 +++++++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 29 deletions(-) (limited to 'src/Propellor/Property/User.hs') diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index c9c91a77..76eae647 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -7,8 +7,8 @@ import qualified Propellor.Property.File as File data Eep = YesReallyDeleteHome -accountFor :: User -> Property NoInfo -accountFor user@(User u) = check nohomedir go +accountFor :: User -> Property DebianLike +accountFor user@(User u) = tightenTargets $ check nohomedir go `describe` ("account for " ++ u) where nohomedir = isNothing <$> catchMaybeIO (homedir user) @@ -18,11 +18,11 @@ accountFor user@(User u) = check nohomedir go , u ] -systemAccountFor :: User -> Property NoInfo +systemAccountFor :: User -> Property DebianLike systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) -systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property NoInfo -systemAccountFor' (User u) mhome mgroup = check nouser go +systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike +systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go `describe` ("system account for " ++ u) where nouser = isNothing <$> catchMaybeIO (getUserEntryForName u) @@ -43,8 +43,8 @@ systemAccountFor' (User u) mhome mgroup = check nouser go ] -- | Removes user home directory!! Use with caution. -nuked :: User -> Eep -> Property NoInfo -nuked user@(User u) _ = check hashomedir go +nuked :: User -> Eep -> Property DebianLike +nuked user@(User u) _ = tightenTargets $ check hashomedir go `describe` ("nuked user " ++ u) where hashomedir = isJust <$> catchMaybeIO (homedir user) @@ -55,13 +55,13 @@ nuked user@(User u) _ = check hashomedir go -- | Only ensures that the user has some password set. It may or may -- not be a password from the PrivData. -hasSomePassword :: User -> Property HasInfo +hasSomePassword :: User -> Property (HasInfo + DebianLike) hasSomePassword user = hasSomePassword' user hostContext -- | While hasSomePassword uses the name of the host as context, -- this allows specifying a different context. This is useful when -- you want to use the same password on multiple hosts, for example. -hasSomePassword' :: IsContext c => User -> c -> Property HasInfo +hasSomePassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword' user context @@ -71,12 +71,14 @@ hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus us -- A user's password can be stored in the PrivData in either of two forms; -- the full cleartext or a hash. The latter -- is obviously more secure. -hasPassword :: User -> Property HasInfo +hasPassword :: User -> Property (HasInfo + DebianLike) hasPassword user = hasPassword' user hostContext -hasPassword' :: IsContext c => User -> c -> Property HasInfo -hasPassword' (User u) context = go `requires` shadowConfig True +hasPassword' :: IsContext c => User -> c -> Property (HasInfo + DebianLike) +hasPassword' (User u) context = go + `requires` shadowConfig True where + go :: Property (HasInfo + UnixLike) go = withSomePrivData srcs context $ property (u ++ " has password") . setPassword srcs = @@ -94,7 +96,7 @@ setPassword getpassword = getpassword $ go -- | Makes a user's password be the passed String. Highly insecure: -- The password is right there in your config file for anyone to see! -hasInsecurePassword :: User -> String -> Property NoInfo +hasInsecurePassword :: User -> String -> Property DebianLike hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $ chpasswd u p [] @@ -104,9 +106,10 @@ chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuc hPutStrLn h $ user ++ ":" ++ v hClose h -lockedPassword :: User -> Property NoInfo -lockedPassword user@(User u) = check (not <$> isLockedPassword user) go - `describe` ("locked " ++ u ++ " password") +lockedPassword :: User -> Property DebianLike +lockedPassword user@(User u) = tightenTargets $ + check (not <$> isLockedPassword user) go + `describe` ("locked " ++ u ++ " password") where go = cmdProperty "passwd" [ "--lock" @@ -130,8 +133,8 @@ isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user homedir :: User -> IO FilePath homedir (User user) = homeDirectory <$> getUserEntryForName user -hasGroup :: User -> Group -> Property NoInfo -hasGroup (User user) (Group group') = check test go +hasGroup :: User -> Group -> Property DebianLike +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] @@ -145,12 +148,13 @@ hasGroup (User user) (Group group') = check test go -- -- Note that some groups may only exit after installation of other -- software. When a group does not exist yet, the user won't be added to it. -hasDesktopGroups :: User -> Property NoInfo -hasDesktopGroups user@(User u) = property desc $ do +hasDesktopGroups :: User -> Property DebianLike +hasDesktopGroups user@(User u) = property' desc $ \o -> do existinggroups <- map (fst . break (== ':')) . lines <$> liftIO (readFile "/etc/group") let toadd = filter (`elem` existinggroups) desktopgroups - ensureProperty $ 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 @@ -170,11 +174,11 @@ hasDesktopGroups user@(User u) = property desc $ do ] -- | Controls whether shadow passwords are enabled or not. -shadowConfig :: Bool -> Property NoInfo -shadowConfig True = check (not <$> shadowExists) +shadowConfig :: Bool -> Property DebianLike +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" @@ -183,11 +187,11 @@ shadowExists = doesFileExist "/etc/shadow" -- | Ensures that a user has a specified login shell, and that the shell -- is enabled in /etc/shells. -hasLoginShell :: User -> FilePath -> Property NoInfo +hasLoginShell :: User -> FilePath -> Property DebianLike hasLoginShell user loginshell = shellSetTo user loginshell `requires` shellEnabled loginshell -shellSetTo :: User -> FilePath -> Property NoInfo -shellSetTo (User u) loginshell = check needchangeshell +shellSetTo :: User -> FilePath -> Property DebianLike +shellSetTo (User u) loginshell = tightenTargets $ check needchangeshell (cmdProperty "chsh" ["--shell", loginshell, u]) `describe` (u ++ " has login shell " ++ loginshell) where @@ -196,5 +200,6 @@ shellSetTo (User u) loginshell = check needchangeshell return (currshell /= loginshell) -- | Ensures that /etc/shells contains a shell. -shellEnabled :: FilePath -> Property NoInfo -shellEnabled loginshell = "/etc/shells" `File.containsLine` loginshell +shellEnabled :: FilePath -> Property DebianLike +shellEnabled loginshell = tightenTargets $ + "/etc/shells" `File.containsLine` loginshell -- cgit v1.3-2-g0d8e