From 6383d8c38893c160382eb9bf69e0315c5e87269e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 31 May 2014 16:48:14 -0400 Subject: propellor spin --- src/Propellor/Attr.hs | 26 ++++++++++++++++++-------- src/Propellor/Property/Docker.hs | 24 +++++++++++++++++++----- 2 files changed, 37 insertions(+), 13 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Attr.hs b/src/Propellor/Attr.hs index 98cfc64d..e2b64bf0 100644 --- a/src/Propellor/Attr.hs +++ b/src/Propellor/Attr.hs @@ -33,21 +33,31 @@ getOS = asks _os -- TODO check at run time if the host really has this address. -- (Can't change the host's address, but as a sanity check.) ipv4 :: String -> Property -ipv4 addr = pureAttrProperty ("ipv4 " ++ addr) - (addDNS $ Address $ IPv4 addr) +ipv4 = addDNS . Address . IPv4 -- | Indidate that a host has an AAAA record in the DNS. ipv6 :: String -> Property -ipv6 addr = pureAttrProperty ("ipv6 " ++ addr) - (addDNS $ Address $ IPv6 addr) +ipv6 = addDNS . Address . IPv6 -- | Indicates another name for the host in the DNS. alias :: Domain -> Property -alias domain = pureAttrProperty ("alias " ++ domain) - (addDNS $ CNAME $ AbsDomain domain) +alias = addDNS . CNAME . AbsDomain -addDNS :: Record -> SetAttr -addDNS record d = d { _dns = S.insert record (_dns d) } +addDNS :: Record -> Property +addDNS r = pureAttrProperty (rdesc r) $ + \d -> d { _dns = S.insert r (_dns d) } + where + rdesc (CNAME d) = unwords ["alias", ddesc d] + rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr] + rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr] + rdesc (MX n d) = unwords ["MX", show n, ddesc d] + rdesc (NS d) = unwords ["NS", ddesc d] + rdesc (TXT s) = unwords ["TXT", s] + rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d] + + ddesc (AbsDomain domain) = domain + ddesc (RelDomain domain) = domain + ddesc RootDomain = "@" -- | Adds a DNS NamedConf stanza. -- diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 68fbced5..465fe0b4 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -21,6 +21,7 @@ import System.Posix.Directory import System.Posix.Process import Data.List import Data.List.Utils +import qualified Data.Set as S -- | Configures docker with an authentication file, so that images can be -- pushed to index.docker.io. @@ -54,7 +55,10 @@ cn2hn cn = cn ++ ".docker" -- | Ensures that a docker container is set up and running. The container -- has its own Properties which are handled by running propellor --- inside the container. +-- inside the container. +-- +-- Additionally, the container can have DNS attributes, such as a CNAME. +-- These become attributes of the host(s) it's docked in. -- -- Reverting this property ensures that the container is stopped and -- removed. @@ -62,12 +66,16 @@ docked :: [Host] -> ContainerName -> RevertableProperty -docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown) +docked hosts cn = RevertableProperty + (go "docked" setup) + (go "undocked" teardown) where go desc a = property (desc ++ " " ++ cn) $ do hn <- getHostName let cid = ContainerId hn cn - ensureProperties [findContainer hosts cid cn $ a cid] + ensureProperties [findContainer mhost cid cn $ a cid] + + mhost = findHost hosts (cn2hn cn) setup cid (Container image runparams) = provisionContainer cid @@ -86,13 +94,19 @@ docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown ] ] +exposeDnsAttrs :: Host -> Property -> Property +exposeDnsAttrs (Host _ containerattr) p = combineProperties (propertyDesc p) $ + p : map addDNS (S.toList containerdns) + where + containerdns = _dns $ containerattr $ newAttr undefined + findContainer - :: [Host] + :: Maybe Host -> ContainerId -> ContainerName -> (Container -> Property) -> Property -findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of +findContainer mhost cid cn mk = case mhost of Nothing -> cantfind Just h -> maybe cantfind mk (mkContainer cid h) where -- cgit v1.2.3