summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog1
-rw-r--r--src/Propellor.hs2
-rw-r--r--src/Propellor/PrivData.hs30
-rw-r--r--src/Propellor/Property/File.hs6
-rw-r--r--src/Propellor/Property/Ssh.hs6
-rw-r--r--src/Propellor/Property/Tor.hs2
-rw-r--r--src/Propellor/Property/User.hs28
-rw-r--r--src/Propellor/Types.hs2
-rw-r--r--src/Propellor/Types/PrivData.hs31
9 files changed, 73 insertions, 35 deletions
diff --git a/debian/changelog b/debian/changelog
index a2b357ae..9d1fc0ec 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
diff --git a/src/Propellor.hs b/src/Propellor.hs
index 6e31e27c..0e34e988 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -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
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index c5f489e5..06438515 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -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 "")
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index bc499e07..d2296354 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -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 ->
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 5d326b83..88a757bd 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -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
diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs
index 7a4e9158..9c63980c 100644
--- a/src/Propellor/Property/Tor.hs
+++ b/src/Propellor/Property/Tor.hs
@@ -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"
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 5c8e768c..69794d84 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -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"
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index f349a29a..e00a457d 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -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
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index 16d6cdb1..a18e7cec 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -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