From 39db3c24af496ac573629503fc767ca3f1372f3f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Sep 2015 13:36:56 -0400 Subject: force copy when destination exists --- src/Propellor/Bootstrap.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 089def51..0cb37092 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -111,7 +111,7 @@ build = catchBoolIO $ do -- or breaking the symlink. -- -- Need cp -a to make build timestamp checking work. - unlessM (boolSystem "cp" [Param "-a", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $ + unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $ error "cp of binary failed" rename (tmpfor safetycopy) safetycopy createSymbolicLink safetycopy (tmpfor dest) -- cgit v1.2.3 From 84561f6c429a59eaccfc6b957166baf66f7133a1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Sep 2015 15:33:14 -0400 Subject: change HostContext for containers 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. I don't entirely like the implementation; I had to put the code to change the context in PropAccum, and it's not generalized past PrivInfo. --- debian/changelog | 6 ++++++ src/Propellor/PrivData.hs | 8 ++++++++ src/Propellor/PropAccum.hs | 12 +++++++++--- src/Propellor/Property/Chroot.hs | 2 +- src/Propellor/Property/Docker.hs | 7 ++++--- src/Propellor/Types/Info.hs | 13 +++++++++++-- src/Propellor/Types/PrivData.hs | 2 +- 7 files changed, 40 insertions(+), 10 deletions(-) (limited to 'src') 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 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 -- cgit v1.2.3