propellor spin

config-joey.hs

@@ -53,7 +53,6 @@ hosts =                 --                  (o)  `
 		& Postfix.satellite
 		& Docker.configured
 
-		& alias "shell.olduse.net"
 		& Docker.docked hosts "oldusenet-shellbox"
 
 		& alias "openid.kitenet.net"
@@ -198,6 +197,7 @@ hosts =                 --                  (o)  `
 	
 	, standardContainer "oldusenet-shellbox" Stable "amd64"
 		& Docker.publish "4200:4200"
+		& alias "shell.olduse.net"
 		& JoeySites.oldUseNetShellBox
 
 	-- git-annex autobuilder containers

debian/changelog

@@ -1,3 +1,12 @@
+propellor (0.6.0) UNRELEASED; urgency=medium
+
+  * Docker containers now propigate DNS attributes out to the host they're
+    docked in. So if a docker container sets a DNS alias, every container
+    it's docked in will automatically become part of a round-robin DNS,
+    if propellor is used to manage DNS for the domain.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 31 May 2014 16:41:56 -0400
+
 propellor (0.5.3) unstable; urgency=medium
 
   * Fix unattended-upgrades config for !stable.

doc/todo/docker_todo_list.mdwn

@@ -4,5 +4,3 @@
 * There is no way for a property of a docker container to require
   some property be met outside the container. For example, some servers
   need ntp installed for a good date source.
-* Docking a container in a host should add to the host any cnames that
-  are assigned to the container.

propellor.cabal

@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.5.3
+Version: 0.6.0
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <joey@kitenet.net>

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)
+ipv4 = addDNS . Address . IPv4
-	(addDNS $ Address $ IPv4 addr)
 
 -- | Indidate that a host has an AAAA record in the DNS.
 ipv6 :: String -> Property
-ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
+ipv6 = addDNS . Address . IPv6
-	(addDNS $ Address $ IPv6 addr)
 
 -- | Indicates another name for the host in the DNS.
 alias :: Domain -> Property
-alias domain = pureAttrProperty ("alias " ++ domain)
+alias = addDNS . CNAME . AbsDomain
-	(addDNS $ CNAME $ AbsDomain domain)
 
-addDNS :: Record -> SetAttr
+addDNS :: Record -> Property
-addDNS record d = d { _dns = S.insert record (_dns d) }
+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.
 --

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.
@@ -56,18 +57,25 @@ cn2hn cn = cn ++ ".docker"
 -- has its own Properties which are handled by running propellor
 -- 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.
 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