From 9ca332e48169ac19dad050a7f99e0db523d8d9c4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 7 Dec 2014 14:57:35 -0400
Subject: 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.
---
 src/Propellor/PrivData.hs | 30 +++++++++++++++++++-----------
 1 file changed, 19 insertions(+), 11 deletions(-)

(limited to 'src/Propellor/PrivData.hs')

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 "")
-- 
cgit v1.3-2-g0d8e