Fixed privdata introspection for User.hasPassword and User.hasSomePassword
This is not a complete fix for the problem that Info doen't propigate from the called property when code does something like: do hostname <- asks hostName ensureProperty $ foo hostname Instead, I just eliminated the need to implement hasPassword that way, by making the PrivData Info use a HostContext which automatically gets the right hostname passed to it. All other uses of withPrivData don't have the problem. It's still possible for the user to run into the problem if they write something like the above, where foo is a property that uses privdata. However, all properties that take a Context now also accept a HostContext, so it's at least less likely the user needs to write that.
This commit is contained in:
parent
8c12047b6b
commit
9ca332e481
|
@ -30,6 +30,7 @@ propellor (1.1.0) UNRELEASED; urgency=medium
|
|||
* Run apt-cache policy with LANG=C so it works on other locales.
|
||||
* endAction can be used to register an action to run once propellor
|
||||
has successfully run on a host.
|
||||
* Fixed privdata introspection for User.hasPassword and User.hasSomePassword
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 22 Nov 2014 00:12:35 -0400
|
||||
|
||||
|
|
|
@ -36,6 +36,7 @@ module Propellor (
|
|||
, module Propellor.Host
|
||||
, module Propellor.Info
|
||||
, module Propellor.PrivData
|
||||
, module Propellor.Types.PrivData
|
||||
, module Propellor.Engine
|
||||
, module Propellor.Exception
|
||||
, module Propellor.Message
|
||||
|
@ -49,6 +50,7 @@ import Propellor.Property
|
|||
import Propellor.Engine
|
||||
import Propellor.Property.Cmd
|
||||
import Propellor.PrivData
|
||||
import Propellor.Types.PrivData
|
||||
import Propellor.Message
|
||||
import Propellor.Exception
|
||||
import Propellor.Info
|
||||
|
|
|
@ -15,6 +15,7 @@ import qualified Data.Map as M
|
|||
import qualified Data.Set as S
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Types.PrivData
|
||||
import Propellor.Message
|
||||
import Propellor.Info
|
||||
import Propellor.Gpg
|
||||
|
@ -30,7 +31,7 @@ import Utility.Env
|
|||
import Utility.Table
|
||||
|
||||
-- | Allows a Property to access the value of a specific PrivDataField,
|
||||
-- for use in a specific Context.
|
||||
-- for use in a specific Context or HostContext.
|
||||
--
|
||||
-- Example use:
|
||||
--
|
||||
|
@ -47,20 +48,26 @@ import Utility.Table
|
|||
-- being used, which is necessary to ensure that the privdata is sent to
|
||||
-- the remote host by propellor.
|
||||
withPrivData
|
||||
:: PrivDataField
|
||||
-> Context
|
||||
:: IsContext c
|
||||
=> PrivDataField
|
||||
-> c
|
||||
-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
|
||||
maybe missing a =<< liftIO (getLocalPrivData field context)
|
||||
withPrivData field c mkprop = addinfo $ mkprop $ \a ->
|
||||
maybe missing a =<< get
|
||||
where
|
||||
missing = liftIO $ do
|
||||
get = do
|
||||
context <- mkHostContext hc <$> asks hostName
|
||||
liftIO $ getLocalPrivData field context
|
||||
missing = do
|
||||
Context cname <- mkHostContext hc <$> asks hostName
|
||||
warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
|
||||
putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
|
||||
liftIO $ putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
|
||||
return FailedChange
|
||||
addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
|
||||
addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, hc) } }
|
||||
hc = asHostContext c
|
||||
|
||||
addPrivDataField :: (PrivDataField, Context) -> Property
|
||||
addPrivDataField :: (PrivDataField, HostContext) -> Property
|
||||
addPrivDataField v = pureInfoProperty (show v) $
|
||||
mempty { _privDataFields = S.singleton v }
|
||||
|
||||
|
@ -78,7 +85,8 @@ type PrivMap = M.Map (PrivDataField, Context) PrivData
|
|||
filterPrivData :: Host -> PrivMap -> PrivMap
|
||||
filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
|
||||
where
|
||||
used = _privDataFields $ hostInfo host
|
||||
used = S.map (\(f, c) -> (f, mkHostContext c (hostName host))) $
|
||||
_privDataFields $ hostInfo host
|
||||
|
||||
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
|
||||
getPrivData field context = M.lookup (field, context)
|
||||
|
@ -119,7 +127,7 @@ listPrivDataFields hosts = do
|
|||
, shellEscape context
|
||||
, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
|
||||
]
|
||||
mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $
|
||||
mkhostmap host = M.fromList $ map (\(f, c) -> ((f, mkHostContext c (hostName host)), [hostName host])) $
|
||||
S.toList $ _privDataFields $ hostInfo host
|
||||
usedby = M.unionsWith (++) $ map mkhostmap hosts
|
||||
wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
|
||||
|
|
|
@ -17,17 +17,17 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
|
|||
--
|
||||
-- The file's permissions are preserved if the file already existed.
|
||||
-- Otherwise, they're set to 600.
|
||||
hasPrivContent :: FilePath -> Context -> Property
|
||||
hasPrivContent :: IsContext c => FilePath -> c -> Property
|
||||
hasPrivContent = hasPrivContent' writeFileProtected
|
||||
|
||||
-- | Leaves the file at its default or current mode,
|
||||
-- allowing "private" data to be read.
|
||||
--
|
||||
-- Use with caution!
|
||||
hasPrivContentExposed :: FilePath -> Context -> Property
|
||||
hasPrivContentExposed :: IsContext c => FilePath -> c -> Property
|
||||
hasPrivContentExposed = hasPrivContent' writeFile
|
||||
|
||||
hasPrivContent' :: (String -> FilePath -> IO ()) -> FilePath -> Context -> Property
|
||||
hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property
|
||||
hasPrivContent' writer f context =
|
||||
withPrivData (PrivFile f) context $ \getcontent ->
|
||||
property desc $ getcontent $ \privcontent ->
|
||||
|
|
|
@ -88,7 +88,7 @@ hostKeys ctx = propertyList "known ssh host keys"
|
|||
]
|
||||
|
||||
-- | Sets a single ssh host key from the privdata.
|
||||
hostKey :: SshKeyType -> Context -> Property
|
||||
hostKey :: IsContext c => SshKeyType -> c -> Property
|
||||
hostKey keytype context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype "") (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype "") (install writeFileProtected "")
|
||||
|
@ -107,7 +107,7 @@ hostKey keytype context = combineProperties desc
|
|||
|
||||
-- | Sets up a user with a ssh private key and public key pair from the
|
||||
-- PrivData.
|
||||
keyImported :: SshKeyType -> UserName -> Context -> Property
|
||||
keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property
|
||||
keyImported keytype user context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype user) (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype user) (install writeFileProtected "")
|
||||
|
@ -158,7 +158,7 @@ knownHost hosts hn user = property desc $
|
|||
-- | Makes a user have authorized_keys from the PrivData
|
||||
--
|
||||
-- This removes any other lines from the file.
|
||||
authorizedKeys :: UserName -> Context -> Property
|
||||
authorizedKeys :: IsContext c => UserName -> c -> Property
|
||||
authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
|
||||
property (user ++ " has authorized_keys") $ get $ \v -> do
|
||||
f <- liftIO $ dotFile "authorized_keys" user
|
||||
|
|
|
@ -44,7 +44,7 @@ hiddenService hn port = mainConfig `File.containsLines`
|
|||
`describe` unwords ["hidden service available:", hn, show port]
|
||||
`onChange` restarted
|
||||
|
||||
hiddenServiceData :: HiddenServiceName -> Context -> Property
|
||||
hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property
|
||||
hiddenServiceData hn context = combineProperties desc
|
||||
[ installonion "hostname"
|
||||
, installonion "private_key"
|
||||
|
|
|
@ -25,34 +25,32 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use
|
|||
-- | Only ensures that the user has some password set. It may or may
|
||||
-- not be the password from the PrivData.
|
||||
hasSomePassword :: UserName -> Property
|
||||
hasSomePassword user = property (user ++ "has password") $ do
|
||||
hostname <- asks hostName
|
||||
ensureProperty $ hasSomePassword' user (Context hostname)
|
||||
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' :: UserName -> Context -> Property
|
||||
hasSomePassword' :: IsContext c => UserName -> c -> Property
|
||||
hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $
|
||||
hasPassword' user context
|
||||
|
||||
-- | Ensures that a user's password is set to the password from the PrivData.
|
||||
-- (Will change any existing password.)
|
||||
hasPassword :: UserName -> Property
|
||||
hasPassword user = property (user ++ "has password") $ do
|
||||
hostname <- asks hostName
|
||||
ensureProperty $ hasPassword' user (Context hostname)
|
||||
hasPassword user = hasPassword' user hostContext
|
||||
|
||||
hasPassword' :: UserName -> Context -> Property
|
||||
hasPassword' :: IsContext c => UserName -> c -> Property
|
||||
hasPassword' user context = go `requires` shadowConfig True
|
||||
where
|
||||
go = withPrivData (Password user) context $ \getpassword ->
|
||||
property (user ++ " has password") $
|
||||
getpassword $ \password -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "chpasswd" []) $ \h -> do
|
||||
hPutStrLn h $ user ++ ":" ++ password
|
||||
hClose h
|
||||
go = withPrivData (Password user) context $
|
||||
property (user ++ " has password") . setPassword user
|
||||
|
||||
setPassword :: UserName -> ((PrivData -> Propellor Result) -> Propellor Result) -> Propellor Result
|
||||
setPassword user getpassword = getpassword $ \password -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "chpasswd" []) $ \h -> do
|
||||
hPutStrLn h $ user ++ ":" ++ password
|
||||
hClose h
|
||||
|
||||
lockedPassword :: UserName -> Property
|
||||
lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
|
||||
|
|
|
@ -165,7 +165,7 @@ data CmdLine
|
|||
-- | Information about a host.
|
||||
data Info = Info
|
||||
{ _os :: Val System
|
||||
, _privDataFields :: S.Set (PrivDataField, Context)
|
||||
, _privDataFields :: S.Set (PrivDataField, HostContext)
|
||||
, _sshPubKey :: Val String
|
||||
, _aliases :: S.Set HostName
|
||||
, _dns :: S.Set Dns.Record
|
||||
|
|
|
@ -15,7 +15,7 @@ data PrivDataField
|
|||
| GpgKey
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Context in which a PrivDataField is used.
|
||||
-- | A context in which a PrivDataField is used.
|
||||
--
|
||||
-- Often this will be a domain name. For example,
|
||||
-- Context "www.example.com" could be used for the SSL cert
|
||||
|
@ -24,10 +24,39 @@ data PrivDataField
|
|||
newtype Context = Context String
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | A context that varies depending on the HostName where it's used.
|
||||
newtype HostContext = HostContext { mkHostContext :: HostName -> Context }
|
||||
|
||||
instance Show HostContext where
|
||||
show hc = show $ mkHostContext hc "<hostname>"
|
||||
|
||||
instance Ord HostContext where
|
||||
a <= b = show a <= show b
|
||||
|
||||
instance Eq HostContext where
|
||||
a == b = show a == show b
|
||||
|
||||
-- | Class of things that can be used as a Context.
|
||||
class IsContext c where
|
||||
asContext :: HostName -> c -> Context
|
||||
asHostContext :: c -> HostContext
|
||||
|
||||
instance IsContext HostContext where
|
||||
asContext = flip mkHostContext
|
||||
asHostContext = id
|
||||
|
||||
instance IsContext Context where
|
||||
asContext _ c = c
|
||||
asHostContext = HostContext . const
|
||||
|
||||
-- | Use when a PrivDataField is not dependent on any paricular context.
|
||||
anyContext :: Context
|
||||
anyContext = Context "any"
|
||||
|
||||
-- | Makes a HostContext that consists just of the hostname.
|
||||
hostContext :: HostContext
|
||||
hostContext = HostContext Context
|
||||
|
||||
type PrivData = String
|
||||
|
||||
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
|
||||
|
|
Loading…
Reference in New Issue