From 58f79c12aad3511b70f2233226d3f0afc5214b10 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Jul 2014 15:56:56 -0400 Subject: propellor spin --- src/Propellor/Property/Docker.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/Docker.hs') diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 1521eb65..4d443986 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -55,10 +55,11 @@ installed = Apt.installed ["docker.io"] -- | Configures docker with an authentication file, so that images can be -- pushed to index.docker.io. Optional. configured :: Property -configured = property "docker configured" go `requires` installed +configured = prop `requires` installed where - go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ - "/root/.dockercfg" `File.hasContent` (lines cfg) + prop = withPrivData DockerAuthentication anyContext $ \getcfg -> + property "docker configured" $ getcfg $ \cfg -> ensureProperty $ + "/root/.dockercfg" `File.hasContent` (lines cfg) -- | A short descriptive name for a container. -- Should not contain whitespace or other unusual characters, -- cgit v1.3-2-g0d8e From cd37316dd5b512930bd9bce50617d4b16eee985a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Jul 2014 17:54:06 -0400 Subject: propigate required privdata fields out from docker containers to the hosts they're docked in --- src/Propellor/PrivData.hs | 5 +++++ src/Propellor/Property/Docker.hs | 15 +++++++++------ 2 files changed, 14 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property/Docker.hs') diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index e9e7e47f..d7d81a21 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -18,6 +18,7 @@ import qualified Data.Set as S import Propellor.Types import Propellor.Types.Info import Propellor.Message +import Propellor.Info import Utility.Monad import Utility.PartialPrelude import Utility.Exception @@ -62,6 +63,10 @@ withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a -> return FailedChange 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 - available, from the host's local privdata cache. -} getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData) diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 4d443986..4203d53d 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -87,8 +87,8 @@ cn2hn cn = cn ++ ".docker" -- The container has its own Properties which are handled by running -- propellor inside the container. -- --- Additionally, the container can have DNS info, such as a CNAME. --- These become info of the host(s) it's docked in. +-- When the container's Properties include DNS info, such as a CNAME, +-- that is propigated to the Info of the host(s) it's docked in. -- -- Reverting this property ensures that the container is stopped and -- removed. @@ -97,7 +97,7 @@ docked -> ContainerName -> RevertableProperty docked hosts cn = RevertableProperty - ((maybe id exposeDnsInfos mhost) (go "docked" setup)) + ((maybe id propigateInfo mhost) (go "docked" setup)) (go "undocked" teardown) where go desc a = property (desc ++ " " ++ cn) $ do @@ -124,9 +124,12 @@ docked hosts cn = RevertableProperty ] ] -exposeDnsInfos :: Host -> Property -> Property -exposeDnsInfos (Host _ _ containerinfo) p = combineProperties (propertyDesc p) $ - p : map addDNS (S.toList $ _dns containerinfo) +propigateInfo :: Host -> Property -> Property +propigateInfo (Host _ _ containerinfo) p = + combineProperties (propertyDesc p) $ p : dnsprops ++ privprops + where + dnsprops = map addDNS (S.toList $ _dns containerinfo) + privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo) findContainer :: Maybe Host -- cgit v1.3-2-g0d8e From 53bb64040afa6b3829b0c8e4bed46ad922ddfa9e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Jul 2014 17:58:27 -0400 Subject: wording --- src/Propellor/Property/Docker.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Docker.hs') diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 4203d53d..4307b850 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -394,7 +394,7 @@ chain s = case toContainerId s of -- being run. So, retry connections to the client for up to -- 1 minute. provisionContainer :: ContainerId -> Property -provisionContainer cid = containerDesc cid $ property "provision" $ liftIO $ do +provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do let shim = Shim.file (localdir "propellor") (localdir shimdir cid) r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) when (r /= FailedChange) $ -- cgit v1.3-2-g0d8e