summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog6
-rw-r--r--src/Propellor/PrivData.hs8
-rw-r--r--src/Propellor/PropAccum.hs12
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/Docker.hs7
-rw-r--r--src/Propellor/Types/Info.hs13
-rw-r--r--src/Propellor/Types/PrivData.hs2
7 files changed, 40 insertions, 10 deletions
diff --git a/debian/changelog b/debian/changelog
index d648d626..e77c5020 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,12 @@ propellor (2.8.1) UNRELEASED; urgency=medium
the executable atomically.
* Added Logcheck module, contributed by Jelmer Vernooij.
* Added Kerberos module, contributed by Jelmer Vernooij.
+ * Privdata that uses HostContext inside a container will now have the
+ name of the container as its context, rather than the name of
+ the host(s) where the container is used. This allows eg, having different
+ passwords for a user in different containers. Note that previously,
+ propellor would prompt using the container name as the context, but
+ not actually use privdata using that context; so this is a bug fix.
-- Joey Hess <id@joeyh.name> Fri, 25 Sep 2015 09:21:41 -0400
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 5df9fe0d..0019730d 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -17,6 +17,7 @@ module Propellor.PrivData (
decryptPrivData,
PrivMap,
PrivInfo,
+ forceHostContext,
) where
import Control.Applicative
@@ -236,3 +237,10 @@ newtype PrivInfo = PrivInfo
-- hosts need it.
instance IsInfo PrivInfo where
propigateInfo _ = True
+
+-- | Sets the context of any privdata that uses HostContext to the
+-- provided name.
+forceHostContext :: String -> PrivInfo -> PrivInfo
+forceHostContext name i = PrivInfo $ S.map go (fromPrivInfo i)
+ where
+ go (f, d, HostContext ctx) = (f, d, HostContext (const $ ctx name))
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index 4b2a5ddb..dec204a2 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -14,6 +14,7 @@ import Data.Monoid
import Propellor.Types
import Propellor.Property
import Propellor.Types.Info
+import Propellor.PrivData
-- | Starts accumulating the properties of a Host.
--
@@ -72,12 +73,16 @@ infixl 1 !
--
-- The Info of the propertyChildren is adjusted to only include
-- info that should be propigated out to the Property.
+--
+-- Any PrivInfo that uses HostContext is adjusted to use the name
+-- of the container as its context.
propigateContainer
:: (PropAccum container)
- => container
+ => String
+ -> container
-> Property HasInfo
-> Property HasInfo
-propigateContainer c prop = infoProperty
+propigateContainer containername c prop = infoProperty
(propertyDesc prop)
(propertySatisfy prop)
(propertyInfo prop)
@@ -85,6 +90,7 @@ propigateContainer c prop = infoProperty
where
hostprops = map go $ getProperties c
go p =
- let i = propigatableInfo (propertyInfo p)
+ let i = mapInfo (forceHostContext containername)
+ (propigatableInfo (propertyInfo p))
cs = map go (propertyChildren p)
in infoProperty (propertyDesc p) (propertySatisfy p) i cs
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 0cbc8642..b059e3eb 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -83,7 +83,7 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly =
teardown = toProp (revert built)
propigateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo
-propigateChrootInfo c p = propigateContainer c p'
+propigateChrootInfo c@(Chroot location _ _ _) p = propigateContainer location c p'
where
p' = infoProperty
(propertyDesc p)
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 9cfc24b6..e6365276 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -19,7 +19,7 @@ module Propellor.Property.Docker (
Image(..),
latestImage,
ContainerName,
- Container,
+ Container(..),
HasImage(..),
-- * Container configuration
dns,
@@ -171,7 +171,7 @@ imagePulled ctr = describe pulled msg
image = getImageName ctr
propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo
-propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'
+propigateContainerInfo ctr@(Container _ h) p = propigateContainer cn ctr p'
where
p' = infoProperty
(propertyDesc p)
@@ -179,7 +179,8 @@ propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'
(propertyInfo p <> dockerinfo)
(propertyChildren p)
dockerinfo = dockerInfo $
- mempty { _dockerContainers = M.singleton (hostName h) h }
+ mempty { _dockerContainers = M.singleton cn h }
+ cn = hostName h
mkContainerInfo :: ContainerId -> Container -> ContainerInfo
mkContainerInfo cid@(ContainerId hn _cn) (Container img h) =
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index a80bb681..347a03e7 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -5,6 +5,7 @@ module Propellor.Types.Info (
IsInfo(..),
addInfo,
getInfo,
+ mapInfo,
propigatableInfo,
InfoVal(..),
fromInfoVal,
@@ -16,8 +17,6 @@ import Data.Monoid
import Data.Maybe
-- | Information about a Host, which can be provided by its properties.
---
--- Any value in the `IsInfo` type class can be added to an Info.
data Info = Info [(Dynamic, Bool)]
instance Show Info where
@@ -37,12 +36,22 @@ class (Typeable v, Monoid v) => IsInfo v where
-- container to its Host?
propigateInfo :: v -> Bool
+-- | Any value in the `IsInfo` type class can be added to an Info.
addInfo :: IsInfo v => Info -> v -> Info
addInfo (Info l) v = Info ((toDyn v, propigateInfo v):l)
getInfo :: IsInfo v => Info -> v
getInfo (Info l) = mconcat (mapMaybe (fromDynamic . fst) (reverse l))
+-- | Maps a function over all values stored in the Info that are of the
+-- appropriate type.
+mapInfo :: IsInfo v => (v -> v) -> Info -> Info
+mapInfo f (Info l) = Info (map go l)
+ where
+ go (i, p) = case fromDynamic i of
+ Nothing -> (i, p)
+ Just v -> (toDyn (f v), p)
+
-- | Filters out parts of the Info that should not propigate out of a
-- container.
propigatableInfo :: Info -> Info
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index 98cdb7a1..1cf22aa9 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -61,7 +61,7 @@ instance IsPrivDataSource PrivDataSource where
newtype Context = Context String
deriving (Read, Show, Ord, Eq)
--- | A context that varies depending on the HostName where it's used.
+-- | A context that may vary depending on the HostName where it's used.
newtype HostContext = HostContext { mkHostContext :: HostName -> Context }
instance Show HostContext where