propigate required privdata fields out from docker containers to the hosts they're docked in

This commit is contained in:
Joey Hess 2014-07-06 17:54:06 -04:00
parent eb39b45d61
commit cd37316dd5
2 changed files with 14 additions and 6 deletions

View File

@ -18,6 +18,7 @@ import qualified Data.Set as S
import Propellor.Types import Propellor.Types
import Propellor.Types.Info import Propellor.Types.Info
import Propellor.Message import Propellor.Message
import Propellor.Info
import Utility.Monad import Utility.Monad
import Utility.PartialPrelude import Utility.PartialPrelude
import Utility.Exception import Utility.Exception
@ -62,6 +63,10 @@ withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
return FailedChange 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, context) } }
addPrivDataField :: (PrivDataField, Context) -> Property
addPrivDataField v = pureInfoProperty (show v) $
mempty { _privDataFields = S.singleton v }
{- Gets the requested field's value, in the specified context if it's {- Gets the requested field's value, in the specified context if it's
- available, from the host's local privdata cache. -} - available, from the host's local privdata cache. -}
getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData) getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)

View File

@ -87,8 +87,8 @@ cn2hn cn = cn ++ ".docker"
-- The container has its own Properties which are handled by running -- The container has its own Properties which are handled by running
-- propellor inside the container. -- propellor inside the container.
-- --
-- Additionally, the container can have DNS info, such as a CNAME. -- When the container's Properties include DNS info, such as a CNAME,
-- These become info of the host(s) it's docked in. -- that is propigated to the Info of the host(s) it's docked in.
-- --
-- Reverting this property ensures that the container is stopped and -- Reverting this property ensures that the container is stopped and
-- removed. -- removed.
@ -97,7 +97,7 @@ docked
-> ContainerName -> ContainerName
-> RevertableProperty -> RevertableProperty
docked hosts cn = RevertableProperty docked hosts cn = RevertableProperty
((maybe id exposeDnsInfos mhost) (go "docked" setup)) ((maybe id propigateInfo mhost) (go "docked" setup))
(go "undocked" teardown) (go "undocked" teardown)
where where
go desc a = property (desc ++ " " ++ cn) $ do go desc a = property (desc ++ " " ++ cn) $ do
@ -124,9 +124,12 @@ docked hosts cn = RevertableProperty
] ]
] ]
exposeDnsInfos :: Host -> Property -> Property propigateInfo :: Host -> Property -> Property
exposeDnsInfos (Host _ _ containerinfo) p = combineProperties (propertyDesc p) $ propigateInfo (Host _ _ containerinfo) p =
p : map addDNS (S.toList $ _dns containerinfo) combineProperties (propertyDesc p) $ p : dnsprops ++ privprops
where
dnsprops = map addDNS (S.toList $ _dns containerinfo)
privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
findContainer findContainer
:: Maybe Host :: Maybe Host