From c11d29130eb128ddf73de3e148ef3c5a16304d9d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 17 Apr 2014 22:31:17 -0400
Subject: [PATCH 01/34] propellor spin


From fd0cfda04c7b0cbd0fdb868ef92e1923481a856c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 17 Apr 2014 22:32:16 -0400
Subject: [PATCH 02/34] propellor spin


From cc169f4ac0cf8ac6de38662671c14abd419b5f48 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 17 Apr 2014 23:32:42 -0400
Subject: [PATCH 03/34] propellor spin

---
 Propellor/Property/Cron.hs                   |  2 +-
 Propellor/Property/Obnam.hs                  | 15 +++--
 Propellor/Property/SiteSpecific/JoeySites.hs | 58 +++++++++++++++++++-
 config-joey.hs                               |  3 +
 4 files changed, 68 insertions(+), 10 deletions(-)

diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index 0649ee9..5b070ef 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -33,7 +33,7 @@ job desc times user cddir command = cronjobfile `File.hasContent`
 	`requires` Apt.installed ["util-linux", "moreutils"]
 	`describe` ("cronned " ++ desc)
   where
-	cmdline = "cd " ++ cddir ++ " && " ++ command
+	cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )"
 	cronjobfile = "/etc/cron.d/" ++ map sanitize desc
 	sanitize c
 		| isAlphaNum c = c
diff --git a/Propellor/Property/Obnam.hs b/Propellor/Property/Obnam.hs
index 4d0584b..6fda218 100644
--- a/Propellor/Property/Obnam.hs
+++ b/Propellor/Property/Obnam.hs
@@ -97,14 +97,17 @@ installed = Apt.installed ["obnam"]
 
 -- | Ensures that a recent version of obnam gets installed.
 --
--- Only useful on Stable.
+-- Only does anything for Debian Stable.
 latestVersion :: Property
-latestVersion = propertyList "obnam latest version"
-	[ toProp $ Apt.trustsKey key
-	, Apt.setSourcesListD sources "obnam"
-	]
+latestVersion = withOS "obnam latest version" $ \o -> case o of
+	(Just (System (Debian suite) _)) | isStable suite -> ensureProperty $
+		Apt.setSourcesListD (sources suite) "obnam"
+			`requires` toProp (Apt.trustsKey key)
+	_ -> noChange
   where
-	sources = ["deb http://code.liw.fi/debian wheezy main"]
+	sources suite = 
+		[ "deb http://code.liw.fi/debian " ++ Apt.showSuite suite ++ " main"
+		]
 	-- gpg key used by the code.liw.fi repository.
 	key = Apt.AptKey "obnam" $ unlines
 		[ "-----BEGIN PGP PUBLIC KEY BLOCK-----"
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 3d0ff24..9b4587b 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -16,9 +16,60 @@ import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Apache as Apache
 import Utility.SafeCommand
 
+import Data.List
+import System.Posix.Files
+
+oldUseNetServer :: [Host] -> Property
+oldUseNetServer hosts = propertyList ("olduse.net server")
+	[ oldUseNetInstalled "oldusenet-server"
+	, Obnam.latestVersion
+	, Obnam.backup datadir "33 4 * * *"
+		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
+		, "--client-name=spool"
+		] Obnam.OnlyClient
+		`requires` Ssh.keyImported SshRsa "root"
+		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
+	, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
+		Property "olduse.net spool in place" $ makeChange $ do
+			removeDirectoryRecursive newsspool
+			createSymbolicLink (datadir </> "news") newsspool
+	, Apt.installed ["leafnode"]
+	, "/etc/news/leafnode/config" `File.hasContent` 
+		[ "# olduse.net configuration (deployed by propellor)"
+		, "expire = 1000000" -- no expiry via texpire
+		, "server = " -- no upstream server
+		, "debugmode = 1"
+		, "allowSTRANGERS = 42" -- lets anyone connect
+		, "nopost = 1" -- no new posting (just gather them)
+		]
+	, Apt.serviceInstalledRunning "openbsd-inetd"
+	, File.notPresent "/etc/cron.daily/leafnode"
+	, File.notPresent "/etc/cron.d/leafnode"
+	, Cron.niceJob "oldusenet-expire" "11 1 * * *" "news" newsspool $ intercalate ";"
+		[ "find \\( -path ./out.going -or -path ./interesting.groups -or -path './*/.overview' \\) -prune -or -type f -ctime +60  -print | xargs --no-run-if-empty rm"
+		, "find -type d -empty | xargs --no-run-if-empty rmdir"
+		]
+	, Cron.niceJob "oldusenet-uucp" "*/5 * * * *" "news" "/" $
+		"/usr/bin/uucp " ++ datadir
+	, toProp $ Apache.siteEnabled "nntp.olduse.net" $ apachecfg "nntp.olduse.net" False
+		[ "  DocumentRoot " ++ datadir ++ "/"
+		, "  <Directory " ++ datadir ++ "/>"
+		, "    Options Indexes FollowSymlinks"
+		, "    AllowOverride None"
+		, "    Require all granted"
+		, "  </Directory>"
+		]
+	]
+  where
+	newsspool = "/var/spool/news"
+	datadir = "/var/spool/oldusenet"
+
 oldUseNetShellBox :: Property
-oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
-	propertyList ("olduse.net shellbox")
+oldUseNetShellBox = oldUseNetInstalled "oldusenet"
+
+oldUseNetInstalled :: Apt.Package -> Property
+oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
+	propertyList ("olduse.net " ++ pkg)
 		[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
 			`describe` "olduse.net build deps"
 		, scriptProperty
@@ -26,12 +77,13 @@ oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
 			, "git clone git://olduse.net/ /root/tmp/oldusenet/source"
 			, "cd /root/tmp/oldusenet/source/"
 			, "dpkg-buildpackage -us -uc"
-			, "dpkg -i ../oldusenet*.deb || true"
+			, "dpkg -i ../" ++ pkg ++ "_*.deb || true"
 			, "apt-get -fy install" -- dependencies
 			, "rm -rf /root/tmp/oldusenet"
 			] `describe` "olduse.net built"
 		]
 
+
 kgbServer :: Property
 kgbServer = withOS desc $ \o -> case o of
 	(Just (System (Debian Unstable) _)) ->
diff --git a/config-joey.hs b/config-joey.hs
index dec1f1b..ac70fc3 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -111,6 +111,9 @@ hosts =               --                  (o)  `
 			[]
 		& JoeySites.twitRss
 		
+		& cname "nntp.olduse.net"
+		& JoeySites.oldUseNetServer hosts
+		
 		& Apt.installed ["ntop"]
 
 

From 66921ff667705e427c1000b7ae071f03fc0eb567 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 17 Apr 2014 23:48:09 -0400
Subject: [PATCH 04/34] propellor spin


From 4e4fb9ab7ca13f5148c6d4b08f53f518429530a8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 03:59:06 -0400
Subject: [PATCH 05/34] get rid of AttrProperty

Now both Property and RevertableProperty can influence Attr on their own.
---
 Propellor/Attr.hs                             | 17 +++----
 Propellor/Engine.hs                           |  2 +-
 Propellor/Property.hs                         | 26 +++++-----
 Propellor/Property/Apt.hs                     |  6 +--
 Propellor/Property/Cmd.hs                     |  2 +-
 Propellor/Property/Docker.hs                  | 49 +++++++++----------
 Propellor/Property/File.hs                    | 12 ++---
 Propellor/Property/Git.hs                     |  2 +-
 Propellor/Property/Gpg.hs                     |  2 +-
 Propellor/Property/Hostname.hs                |  2 +-
 Propellor/Property/Obnam.hs                   |  2 +-
 Propellor/Property/Postfix.hs                 |  2 +-
 Propellor/Property/Scheduled.hs               |  4 +-
 Propellor/Property/Service.hs                 |  6 +--
 .../Property/SiteSpecific/GitAnnexBuilder.hs  |  2 +-
 Propellor/Property/SiteSpecific/GitHome.hs    |  6 +--
 Propellor/Property/SiteSpecific/JoeySites.hs  |  2 +-
 Propellor/Property/Ssh.hs                     | 16 +++---
 Propellor/Property/Sudo.hs                    |  2 +-
 Propellor/Property/User.hs                    |  2 +-
 Propellor/Types.hs                            | 37 +++++++-------
 debian/changelog                              |  3 +-
 propellor.cabal                               |  2 +-
 23 files changed, 102 insertions(+), 104 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 94376b0..d4fb25d 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -10,36 +10,35 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import Control.Applicative
 
-pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty 
-pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)
-	(return NoChange)
+pureAttrProperty :: Desc -> (Attr -> Attr) -> Property 
+pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
-hostname :: HostName -> AttrProperty
+hostname :: HostName -> Property
 hostname name = pureAttrProperty ("hostname " ++ name) $
 	\d -> d { _hostname = name }
 
 getHostName :: Propellor HostName
 getHostName = asks _hostname
 
-os :: System -> AttrProperty
+os :: System -> Property
 os system = pureAttrProperty ("Operating " ++ show system) $
 	\d -> d { _os = Just system }
 
 getOS :: Propellor (Maybe System)
 getOS = asks _os
 
-cname :: Domain -> AttrProperty
+cname :: Domain -> Property
 cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
 
-cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty
+cnameFor :: Domain -> (Domain -> Property) -> Property
 cnameFor domain mkp =
 	let p = mkp domain
-	in AttrProperty p (addCName domain)
+	in p { propertyAttr = propertyAttr p . addCName domain }
 
 addCName :: HostName -> Attr -> Attr
 addCName domain d = d { _cnames = S.insert domain (_cnames d) }
 
-sshPubKey :: String -> AttrProperty
+sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 	\d -> d { _sshPubKey = Just k }
 
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 81d979a..c697d85 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -18,7 +18,7 @@ runPropellor attr a = runReaderT (runWithAttr a) attr
 mainProperties :: Attr -> [Property] -> IO ()
 mainProperties attr ps = do
 	r <- runPropellor attr $
-		ensureProperties [Property "overall" $ ensureProperties ps]
+		ensureProperties [property "overall" $ ensureProperties ps]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index 5b1800e..aa41906 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -26,12 +26,12 @@ noChange = return NoChange
 -- and print out the description of each as it's run. Does not stop
 -- on failure; does propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = Property desc $ ensureProperties ps
+propertyList desc ps = property desc $ ensureProperties ps
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = Property desc $ go ps NoChange
+combineProperties desc ps = property desc $ go ps NoChange
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -44,7 +44,7 @@ combineProperties desc ps = Property desc $ go ps NoChange
 -- that ensures the first, and if the first succeeds, ensures the second.
 -- The property uses the description of the first property.
 before :: Property -> Property -> Property
-p1 `before` p2 = Property (propertyDesc p1) $ do
+p1 `before` p2 = property (propertyDesc p1) $ do
 	r <- ensureProperty p1
 	case r of
 		FailedChange -> return FailedChange
@@ -54,16 +54,16 @@ p1 `before` p2 = Property (propertyDesc p1) $ do
 -- file to indicate whether it has run before.
 -- Use with caution.
 flagFile :: Property -> FilePath -> Property
-flagFile property = flagFile' property . return
+flagFile p = flagFile' p . return
 
 flagFile' :: Property -> IO FilePath -> Property
-flagFile' property getflagfile = Property (propertyDesc property) $ do
+flagFile' p getflagfile = property (propertyDesc p) $ do
 	flagfile <- liftIO getflagfile
 	go flagfile =<< liftIO (doesFileExist flagfile)
   where
 	go _ True = return NoChange
 	go flagfile False = do
-		r <- ensureProperty property
+		r <- ensureProperty p
 		when (r == MadeChange) $ liftIO $ 
 			unlessM (doesFileExist flagfile) $ do
 				createDirectoryIfMissing True (takeDirectory flagfile)
@@ -73,8 +73,8 @@ flagFile' property getflagfile = Property (propertyDesc property) $ do
 --- | Whenever a change has to be made for a Property, causes a hook
 -- Property to also be run, but not otherwise.
 onChange :: Property -> Property -> Property
-property `onChange` hook = Property (propertyDesc property) $ do
-	r <- ensureProperty property
+p `onChange` hook = property (propertyDesc p) $ do
+	r <- ensureProperty p
 	case r of
 		MadeChange -> do
 			r' <- ensureProperty hook
@@ -87,8 +87,8 @@ infixl 1 ==>
 
 -- | Makes a Property only be performed when a test succeeds.
 check :: IO Bool -> Property -> Property
-check c property = Property (propertyDesc property) $ ifM (liftIO c)
-	( ensureProperty property
+check c p = property (propertyDesc p) $ ifM (liftIO c)
+	( ensureProperty p
 	, return NoChange
 	)
 
@@ -99,7 +99,7 @@ check c property = Property (propertyDesc property) $ ifM (liftIO c)
 -- to be made as it is to just idempotently assure the property is
 -- satisfied. For example, chmodding a file.
 trivial :: Property -> Property
-trivial p = Property (propertyDesc p) $ do
+trivial p = property (propertyDesc p) $ do
 	r <- ensureProperty p
 	if r == MadeChange
 		then return NoChange
@@ -110,10 +110,10 @@ trivial p = Property (propertyDesc p) $ do
 --
 -- Note that the operating system may not be declared for some hosts.
 withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
-withOS desc a = Property desc $ a =<< getOS
+withOS desc a = property desc $ a =<< getOS
 
 boolProperty :: Desc -> IO Bool -> Property
-boolProperty desc a = Property desc $ ifM (liftIO a)
+boolProperty desc a = property desc $ ifM (liftIO a)
 	( return MadeChange
 	, return FailedChange
 	)
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index d31e8b4..2115dc5 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -157,7 +157,7 @@ buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
 robustly :: Property -> Property
-robustly p = Property (propertyDesc p) $ do
+robustly p = property (propertyDesc p) $ do
 	r <- ensureProperty p
 	if r == FailedChange
 		then ensureProperty $ p `requires` update
@@ -210,7 +210,7 @@ reConfigure :: Package -> [(String, String, String)] -> Property
 reConfigure package vals = reconfigure `requires` setselections
 	`describe` ("reconfigure " ++ package)
   where
-	setselections = Property "preseed" $ makeChange $
+	setselections = property "preseed" $ makeChange $
 		withHandle StdinHandle createProcessSuccess
 			(proc "debconf-set-selections" []) $ \h -> do
 				forM_ vals $ \(tmpl, tmpltype, value) ->
@@ -236,7 +236,7 @@ trustsKey k = RevertableProperty trust untrust
 	desc = "apt trusts key " ++ keyname k
 	f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
 	untrust = File.notPresent f
-	trust = check (not <$> doesFileExist f) $ Property desc $ makeChange $ do
+	trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
 		withHandle StdinHandle createProcessSuccess
 			(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
 				hPutStr h (pubkey k)
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index 875c1f9..5b7494e 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -25,7 +25,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
 -- | A property that can be satisfied by running a command,
 -- with added environment.
 cmdProperty' :: String -> [String] -> [(String, String)] -> Property
-cmdProperty' cmd params env = Property desc $ liftIO $ do
+cmdProperty' cmd params env = property desc $ liftIO $ do
 	env' <- addEntries env <$> getEnvironment
 	ifM (boolSystemEnv cmd (map Param params) (Just env'))
 		( return MadeChange
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index d2555ea..e05a8dd 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -25,7 +25,7 @@ import Data.List.Utils
 -- | Configures docker with an authentication file, so that images can be
 -- pushed to index.docker.io.
 configured :: Property
-configured = Property "docker configured" go `requires` installed
+configured = property "docker configured" go `requires` installed
   where
 	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
 		"/root/.dockercfg" `File.hasContent` (lines cfg)
@@ -64,7 +64,7 @@ docked
 	-> RevertableProperty
 docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
   where
-	go desc a = Property (desc ++ " " ++ cn) $ do
+	go desc a = property (desc ++ " " ++ cn) $ do
 		hn <- getHostName
   		let cid = ContainerId hn cn
 		ensureProperties [findContainer hosts cid cn $ a cid]
@@ -79,7 +79,7 @@ docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown
 	teardown cid (Container image _runparams) =
 		combineProperties ("undocked " ++ fromContainerId cid)
 			[ stoppedContainer cid
-			, Property ("cleaned up " ++ fromContainerId cid) $
+			, property ("cleaned up " ++ fromContainerId cid) $
 				liftIO $ report <$> mapM id
 					[ removeContainer cid
 					, removeImage image
@@ -96,7 +96,7 @@ findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
 	Nothing -> cantfind
 	Just h -> maybe cantfind mk (mkContainer cid h)
   where
-	cantfind = containerDesc cid $ Property "" $ do
+	cantfind = containerDesc cid $ property "" $ do
 		liftIO $ warningMessage $
 			"missing definition for docker container \"" ++ cn2hn cn
 		return FailedChange
@@ -126,9 +126,9 @@ garbageCollected = propertyList "docker garbage collected"
 	, gcimages
 	]
   where
-	gccontainers = Property "docker containers garbage collected" $
+	gccontainers = property "docker containers garbage collected" $
 		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
-	gcimages = Property "docker images garbage collected" $ do
+	gcimages = property "docker images garbage collected" $ do
 		liftIO $ report <$> (mapM removeImage =<< listImages)
 
 data Container = Container Image [RunParam]
@@ -140,49 +140,49 @@ type RunParam = String
 type Image = String
 
 -- | Set custom dns server for container.
-dns :: String -> AttrProperty
+dns :: String -> Property
 dns = runProp "dns"
 
 -- | Set container host name.
-hostname :: String -> AttrProperty
+hostname :: String -> Property
 hostname = runProp "hostname"
 
 -- | Set name for container. (Normally done automatically.)
-name :: String -> AttrProperty
+name :: String -> Property
 name = runProp "name"
 
 -- | Publish a container's port to the host
 -- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> AttrProperty
+publish :: String -> Property
 publish = runProp "publish"
 
 -- | Username or UID for container.
-user :: String -> AttrProperty
+user :: String -> Property
 user = runProp "user"
 
 -- | Mount a volume
 -- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
 -- With just a directory, creates a volume in the container.
-volume :: String -> AttrProperty
+volume :: String -> Property
 volume = runProp "volume"
 
 -- | Mount a volume from the specified container into the current
 -- container.
-volumes_from :: ContainerName -> AttrProperty
+volumes_from :: ContainerName -> Property
 volumes_from cn = genProp "volumes-from" $ \hn ->
 	fromContainerId (ContainerId hn cn)
 
 -- | Work dir inside the container. 
-workdir :: String -> AttrProperty
+workdir :: String -> Property
 workdir = runProp "workdir"
 
 -- | Memory limit for container.
 --Format: <number><optional unit>, where unit = b, k, m or g
-memory :: String -> AttrProperty
+memory :: String -> Property
 memory = runProp "memory"
 
 -- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> AttrProperty
+link :: ContainerName -> ContainerAlias -> Property
 link linkwith alias = genProp "link" $ \hn ->
 	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
 
@@ -230,7 +230,7 @@ containerDesc cid p = p `describe` desc
 	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
 
 runningContainer :: ContainerId -> Image -> [RunParam] -> Property
-runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ Property "running" $ do
+runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
 	l <- liftIO $ listContainers RunningContainers
 	if cid `elem` l
 		then do
@@ -324,7 +324,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 "provision" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
 	when (r /= FailedChange) $
@@ -356,7 +356,7 @@ stopContainer :: ContainerId -> IO Bool
 stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
 
 stoppedContainer :: ContainerId -> Property
-stoppedContainer cid = containerDesc cid $ Property desc $ 
+stoppedContainer cid = containerDesc cid $ property desc $ 
 	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
 		( liftIO cleanup `after` ensureProperty 
 			(boolProperty desc $ stopContainer cid)
@@ -405,18 +405,15 @@ listContainers status =
 listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
-runProp :: String -> RunParam -> AttrProperty
-runProp field val = AttrProperty prop $ \attr ->
+runProp :: String -> RunParam -> Property
+runProp field val = pureAttrProperty (param) $ \attr ->
 	attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
   where
 	param = field++"="++val
-	prop = Property (param) (return NoChange)
 
-genProp :: String -> (HostName -> RunParam) -> AttrProperty
-genProp field mkval = AttrProperty prop $ \attr ->
+genProp :: String -> (HostName -> RunParam) -> Property
+genProp field mkval = pureAttrProperty field $ \attr ->
 	attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }
-  where
-	prop = Property field (return NoChange)
 
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 8f23dab..0b06017 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -18,7 +18,7 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
 -- The file's permissions are preserved if the file already existed.
 -- Otherwise, they're set to 600.
 hasPrivContent :: FilePath -> Property
-hasPrivContent f = Property desc $ withPrivData (PrivFile f) $ \privcontent -> 
+hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent -> 
 	ensureProperty $ fileProperty' writeFileProtected desc
 		(\_oldcontent -> lines privcontent) f
   where
@@ -48,13 +48,13 @@ f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
 
 -- | Removes a file. Does not remove symlinks or non-plain-files.
 notPresent :: FilePath -> Property
-notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ 
+notPresent f = check (doesFileExist f) $ property (f ++ " not present") $ 
 	makeChange $ nukeFile f
 
 fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
 fileProperty = fileProperty' writeFile
 fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)
+fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
   where
 	go True = do
 		ls <- liftIO $ lines <$> readFile f
@@ -74,12 +74,12 @@ fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)
 
 -- | Ensures a directory exists.
 dirExists :: FilePath -> Property
-dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
+dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
 	makeChange $ createDirectoryIfMissing True d
 
 -- | Ensures that a file/dir has the specified owner and group.
 ownerGroup :: FilePath -> UserName -> GroupName -> Property
-ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
+ownerGroup f owner group = property (f ++ " owner " ++ og) $ do
 	r <- ensureProperty $ cmdProperty "chown" [og, f]
 	if r == FailedChange
 		then return r
@@ -89,6 +89,6 @@ ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
 
 -- | Ensures that a file/dir has the specfied mode.
 mode :: FilePath -> FileMode -> Property
-mode f v = Property (f ++ " mode " ++ show v) $ do
+mode f v = property (f ++ " mode " ++ show v) $ do
 	liftIO $ modifyFileMode f (\_old -> v)
 	noChange
diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
index 1dae94b..ba370e5 100644
--- a/Propellor/Property/Git.hs
+++ b/Propellor/Property/Git.hs
@@ -62,7 +62,7 @@ type Branch = String
 --
 -- A branch can be specified, to check out.
 cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
-cloned owner url dir mbranch = check originurl (Property desc checkout)
+cloned owner url dir mbranch = check originurl (property desc checkout)
 	`requires` installed
   where
 	desc = "git cloned " ++ url ++ " to " ++ dir
diff --git a/Propellor/Property/Gpg.hs b/Propellor/Property/Gpg.hs
index e23111b..64ea9fe 100644
--- a/Propellor/Property/Gpg.hs
+++ b/Propellor/Property/Gpg.hs
@@ -21,7 +21,7 @@ installed = Apt.installed ["gnupg"]
 -- The GpgKeyId does not have to be a numeric id; it can just as easily
 -- be a description of the key.
 keyImported :: GpgKeyId -> UserName -> Property
-keyImported keyid user = flagFile' (Property desc go) genflag
+keyImported keyid user = flagFile' (property desc go) genflag
 	`requires` installed
   where
 	desc = user ++ " has gpg key " ++ show keyid
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 30e0992..031abb9 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.File as File
 -- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is
 -- standard at least on Debian to set the FDQN (127.0.0.1 is localhost).
 sane :: Property
-sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName)
 
 setTo :: HostName -> Property
 setTo hn = combineProperties desc go
diff --git a/Propellor/Property/Obnam.hs b/Propellor/Property/Obnam.hs
index 6fda218..32374b5 100644
--- a/Propellor/Property/Obnam.hs
+++ b/Propellor/Property/Obnam.hs
@@ -65,7 +65,7 @@ backup dir crontimes params numclients = cronjob `describe` desc
 -- The restore is performed atomically; restoring to a temp directory
 -- and then moving it to the directory.
 restored :: FilePath -> [ObnamParam] -> Property
-restored dir params = Property (dir ++ " restored by obnam") go
+restored dir params = property (dir ++ " restored by obnam") go
 	`requires` installed
   where
 	go = ifM (liftIO needsRestore)
diff --git a/Propellor/Property/Postfix.hs b/Propellor/Property/Postfix.hs
index f4be27c..9fa4a2c 100644
--- a/Propellor/Property/Postfix.hs
+++ b/Propellor/Property/Postfix.hs
@@ -15,7 +15,7 @@ installed = Apt.serviceInstalledRunning "postfix"
 satellite :: Property
 satellite = setup `requires` installed
   where
-	setup = trivial $ Property "postfix satellite system" $ do
+	setup = trivial $ property "postfix satellite system" $ do
 		hn <- getHostName
 		ensureProperty $ Apt.reConfigure "postfix"
 			[ ("postfix/main_mailer_type", "select", "Satellite system")
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
index 769a393..0e63912 100644
--- a/Propellor/Property/Scheduled.hs
+++ b/Propellor/Property/Scheduled.hs
@@ -19,7 +19,7 @@ import qualified Data.Map as M
 -- This uses the description of the Property to keep track of when it was
 -- last run.
 period :: Property -> Recurrance -> Property
-period prop recurrance = Property desc $ do
+period prop recurrance = property desc $ do
 	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
@@ -37,7 +37,7 @@ period prop recurrance = Property desc $ do
 periodParse :: Property -> String -> Property
 periodParse prop s = case toRecurrance s of
 	Just recurrance -> period prop recurrance
-	Nothing -> Property "periodParse" $ do
+	Nothing -> property "periodParse" $ do
 		liftIO $ warningMessage $ "failed periodParse: " ++ s
 		noChange
 
diff --git a/Propellor/Property/Service.hs b/Propellor/Property/Service.hs
index c6498e5..14e769d 100644
--- a/Propellor/Property/Service.hs
+++ b/Propellor/Property/Service.hs
@@ -13,19 +13,19 @@ type ServiceName = String
 -- we can do is try to start the service, and if it fails, assume
 -- this means it's already running.
 running :: ServiceName -> Property
-running svc = Property ("running " ++ svc) $ do
+running svc = property ("running " ++ svc) $ do
 	void $ ensureProperty $
 		scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
 	return NoChange
 
 restarted :: ServiceName -> Property
-restarted svc = Property ("restarted " ++ svc) $ do
+restarted svc = property ("restarted " ++ svc) $ do
 	void $ ensureProperty $
 		scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"]
 	return NoChange
 
 reloaded :: ServiceName -> Property
-reloaded svc = Property ("reloaded " ++ svc) $ do
+reloaded svc = property ("reloaded " ++ svc) $ do
 	void $ ensureProperty $
 		scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"]
 	return NoChange
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 204a9ca..677aa76 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -40,7 +40,7 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
 	-- The builduser account does not have a password set,
 	-- instead use the password privdata to hold the rsync server
 	-- password used to upload the built image.
-	, Property "rsync password" $ do
+	, property "rsync password" $ do
 		let f = homedir </> "rsyncpassword"
 		if rsyncupload 
 			then withPrivData (Password builduser) $ \p -> do
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index ee46a9e..6ed0214 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -8,16 +8,16 @@ import Utility.SafeCommand
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
 installedFor :: UserName -> Property
 installedFor user = check (not <$> hasGitDir user) $ 
-	Property ("githome " ++ user) (go =<< liftIO (homedir user))
+	property ("githome " ++ user) (go =<< liftIO (homedir user))
 		`requires` Apt.installed ["git"]
   where
 	go home = do
 		let tmpdir = home </> "githome"
 		ensureProperty $ combineProperties "githome setup"
 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
-			, Property "moveout" $ makeChange $ void $
+			, property "moveout" $ makeChange $ void $
 				moveout tmpdir home
-			, Property "rmdir" $ makeChange $ void $
+			, property "rmdir" $ makeChange $ void $
 				catchMaybeIO $ removeDirectory tmpdir
 			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
 			]
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 9b4587b..c939ddc 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -30,7 +30,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
 		`requires` Ssh.keyImported SshRsa "root"
 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
 	, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
-		Property "olduse.net spool in place" $ makeChange $ do
+		property "olduse.net spool in place" $ makeChange $ do
 			removeDirectoryRecursive newsspool
 			createSymbolicLink (datadir </> "news") newsspool
 	, Apt.installed ["leafnode"]
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index a39792c..a4f8767 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -67,7 +67,7 @@ randomHostKeys :: Property
 randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 	`onChange` restartSshd
   where
-	prop = Property "ssh random host keys" $ do
+	prop = property "ssh random host keys" $ do
 		void $ liftIO $ boolSystem "sh"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"
@@ -81,8 +81,8 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 -- (Uses a null username for host keys.)
 hostKey :: SshKeyType -> Property
 hostKey keytype = combineProperties desc
-	[ Property desc (install writeFile (SshPubKey keytype "") ".pub")
-	, Property desc (install writeFileProtected (SshPrivKey keytype "") "")
+	[ property desc (install writeFile (SshPubKey keytype "") ".pub")
+	, property desc (install writeFileProtected (SshPrivKey keytype "") "")
 	]
 	`onChange` restartSshd
   where
@@ -98,8 +98,8 @@ hostKey keytype = combineProperties desc
 -- from the site's PrivData.
 keyImported :: SshKeyType -> UserName -> Property
 keyImported keytype user = combineProperties desc
-	[ Property desc (install writeFile (SshPubKey keytype user) ".pub")
-	, Property desc (install writeFileProtected (SshPrivKey keytype user) "")
+	[ property desc (install writeFile (SshPubKey keytype user) ".pub")
+	, property desc (install writeFileProtected (SshPrivKey keytype user) "")
 	]
   where
 	desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
@@ -108,7 +108,7 @@ keyImported keytype user = combineProperties desc
 		ifM (liftIO $ doesFileExist f)
 			( noChange
 			, ensureProperty $ combineProperties desc
-				[ Property desc $ 
+				[ property desc $ 
 					withPrivData p $ \key -> makeChange $
 						writer f key
 				, File.ownerGroup f user user
@@ -126,7 +126,7 @@ fromKeyType SshEd25519 = "ed25519"
 
 -- | Puts some host's ssh public key into the known_hosts file for a user.
 knownHost :: [Host] -> HostName -> UserName -> Property
-knownHost hosts hn user = Property desc $
+knownHost hosts hn user = property desc $
 	go =<< fromHost hosts hn getSshPubKey
   where
 	desc = user ++ " knows ssh key for " ++ hn
@@ -143,7 +143,7 @@ knownHost hosts hn user = Property desc $
 
 -- | Makes a user have authorized_keys from the PrivData
 authorizedKeys :: UserName -> Property
-authorizedKeys user = Property (user ++ " has authorized_keys") $
+authorizedKeys user = property (user ++ " has authorized_keys") $
 	withPrivData (SshAuthorizedKeys user) $ \v -> do
 		f <- liftIO $ dotFile "authorized_keys" user
 		liftIO $ do
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
index 66ceb58..68b5660 100644
--- a/Propellor/Property/Sudo.hs
+++ b/Propellor/Property/Sudo.hs
@@ -10,7 +10,7 @@ import Propellor.Property.User
 -- | Allows a user to sudo. If the user has a password, sudo is configured
 -- to require it. If not, NOPASSWORD is enabled for the user.
 enabledFor :: UserName -> Property
-enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
+enabledFor user = property desc go `requires` Apt.installed ["sudo"]
   where
 	go = do
 		locked <- liftIO $ isLockedPassword user
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
index 8e7afd8..eef2a57 100644
--- a/Propellor/Property/User.hs
+++ b/Propellor/Property/User.hs
@@ -29,7 +29,7 @@ hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
 	hasPassword user
 
 hasPassword :: UserName -> Property
-hasPassword user = Property (user ++ " has password") $
+hasPassword user = property (user ++ " has password") $
 	withPrivData (Password user) $ \password -> makeChange $
 		withHandle StdinHandle createProcessSuccess
 			(proc "chpasswd" []) $ \h -> do
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index fc767cd..01be9a5 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -8,8 +8,8 @@ module Propellor.Types
 	, HostName
 	, Propellor(..)
 	, Property(..)
+	, property
 	, RevertableProperty(..)
-	, AttrProperty(..)
 	, IsProp
 	, describe
 	, toProp
@@ -53,16 +53,18 @@ newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
 -- property.
 data Property = Property
 	{ propertyDesc :: Desc
-	-- | must be idempotent; may run repeatedly
 	, propertySatisfy :: Propellor Result
+	-- ^ must be idempotent; may run repeatedly
+	, propertyAttr :: Attr -> Attr
+	-- ^ a property can affect the overall Attr
 	}
 
+property :: Desc -> Propellor Result -> Property
+property d s = Property d s id
+
 -- | A property that can be reverted.
 data RevertableProperty = RevertableProperty Property Property
 
--- | A property that affects the Attr.
-data AttrProperty = forall p. IsProp p => AttrProperty p (Attr -> Attr)
-
 class IsProp p where
 	-- | Sets description.
 	describe :: p -> Desc -> p
@@ -75,12 +77,16 @@ class IsProp p where
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
 	toProp p = p
-	x `requires` y = Property (propertyDesc x) $ do
-		r <- propertySatisfy y
-		case r of
-			FailedChange -> return FailedChange
-			_ -> propertySatisfy x
-	getAttr _ = id
+	getAttr = propertyAttr
+	x `requires` y = Property (propertyDesc x) satisfy attr
+	  where
+	  	attr = propertyAttr x . propertyAttr y
+		satisfy = do
+			r <- propertySatisfy y
+			case r of
+				FailedChange -> return FailedChange
+				_ -> propertySatisfy x
+			
 
 instance IsProp RevertableProperty where
 	-- | Sets the description of both sides.
@@ -89,13 +95,8 @@ instance IsProp RevertableProperty where
 	toProp (RevertableProperty p1 _) = p1
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
-	getAttr _ = id
-
-instance IsProp AttrProperty where
-	describe (AttrProperty p a) d = AttrProperty (describe p d) a
-	toProp (AttrProperty p _) = toProp p
-	(AttrProperty p a) `requires` y = AttrProperty (p `requires` y) a
-	getAttr (AttrProperty _ a) = a
+	-- | Gets the Attr of the currently active side.
+	getAttr (RevertableProperty p1 _p2) = getAttr p1
 
 type Desc = String
 
diff --git a/debian/changelog b/debian/changelog
index 3daeb39..3cef12d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,5 +1,6 @@
-propellor (0.3.2) UNRELEASED; urgency=medium
+propellor (0.4.0) UNRELEASED; urgency=medium
 
+  * Constructor of Property has changed (use property function instead).
   * Run all cron jobs under chronic from moreutils to avoid unnecessary mails.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400
diff --git a/propellor.cabal b/propellor.cabal
index ad171b5..677b9a8 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.3.1
+Version: 0.4.0
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>

From 5f6c3ad56490a8c3063f8daa1cd8b0a302b63ddd Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 04:48:49 -0400
Subject: [PATCH 06/34] All Property combinators now combine together their
 Attr settings.

So Attr settings can be made inside a propertyList, for example.
---
 Propellor/Attr.hs               |  4 +-
 Propellor/Engine.hs             |  2 +-
 Propellor/Property.hs           | 79 ++++++++++++++++++++-------------
 Propellor/Property/Apt.hs       |  4 +-
 Propellor/Property/Cmd.hs       |  1 +
 Propellor/Property/Scheduled.hs |  4 +-
 Propellor/Types.hs              | 18 +++-----
 Propellor/Types/Attr.hs         |  2 +
 TODO                            |  6 +--
 debian/changelog                |  5 ++-
 10 files changed, 70 insertions(+), 55 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index d4fb25d..03c882c 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -10,7 +10,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import Control.Applicative
 
-pureAttrProperty :: Desc -> (Attr -> Attr) -> Property 
+pureAttrProperty :: Desc -> SetAttr -> Property 
 pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)
 
 hostname :: HostName -> Property
@@ -35,7 +35,7 @@ cnameFor domain mkp =
 	let p = mkp domain
 	in p { propertyAttr = propertyAttr p . addCName domain }
 
-addCName :: HostName -> Attr -> Attr
+addCName :: HostName -> SetAttr
 addCName domain d = d { _cnames = S.insert domain (_cnames d) }
 
 sshPubKey :: String -> Property
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index c697d85..55ce7f7 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -18,7 +18,7 @@ runPropellor attr a = runReaderT (runWithAttr a) attr
 mainProperties :: Attr -> [Property] -> IO ()
 mainProperties attr ps = do
 	r <- runPropellor attr $
-		ensureProperties [property "overall" $ ensureProperties ps]
+		ensureProperties [Property "overall" (ensureProperties ps) id]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index aa41906..2449465 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -5,6 +5,7 @@ module Propellor.Property where
 import System.Directory
 import Control.Monad
 import Data.Monoid
+import Data.List
 import Control.Monad.IfElse
 import "mtl" Control.Monad.Reader
 
@@ -15,23 +16,21 @@ import Propellor.Engine
 import Utility.Monad
 import System.FilePath
 
-makeChange :: IO () -> Propellor Result
-makeChange a = liftIO a >> return MadeChange
-
-noChange :: Propellor Result
-noChange = return NoChange
+-- Constructs a Property.
+property :: Desc -> Propellor Result -> Property
+property d s = Property d s id
 
 -- | Combines a list of properties, resulting in a single property
 -- that when run will run each property in the list in turn,
 -- and print out the description of each as it's run. Does not stop
 -- on failure; does propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = property desc $ ensureProperties ps
+propertyList desc ps = Property desc (ensureProperties ps) (combineSetAttrs ps)
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
 combineProperties :: Desc -> [Property] -> Property
-combineProperties desc ps = property desc $ go ps NoChange
+combineProperties desc ps = Property desc (go ps NoChange) (combineSetAttrs ps)
   where
   	go [] rs = return rs
 	go (l:ls) rs = do
@@ -44,11 +43,8 @@ combineProperties desc ps = property desc $ go ps NoChange
 -- that ensures the first, and if the first succeeds, ensures the second.
 -- The property uses the description of the first property.
 before :: Property -> Property -> Property
-p1 `before` p2 = property (propertyDesc p1) $ do
-	r <- ensureProperty p1
-	case r of
-		FailedChange -> return FailedChange
-		_ -> ensureProperty p2
+p1 `before` p2 = p2 `requires` p1
+	`describe` (propertyDesc p1)
 
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
@@ -57,13 +53,13 @@ flagFile :: Property -> FilePath -> Property
 flagFile p = flagFile' p . return
 
 flagFile' :: Property -> IO FilePath -> Property
-flagFile' p getflagfile = property (propertyDesc p) $ do
+flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
 	flagfile <- liftIO getflagfile
-	go flagfile =<< liftIO (doesFileExist flagfile)
+	go satisfy flagfile =<< liftIO (doesFileExist flagfile)
   where
-	go _ True = return NoChange
-	go flagfile False = do
-		r <- ensureProperty p
+	go _ _ True = return NoChange
+	go satisfy flagfile False = do
+		r <- satisfy
 		when (r == MadeChange) $ liftIO $ 
 			unlessM (doesFileExist flagfile) $ do
 				createDirectoryIfMissing True (takeDirectory flagfile)
@@ -73,22 +69,24 @@ flagFile' p getflagfile = property (propertyDesc p) $ do
 --- | Whenever a change has to be made for a Property, causes a hook
 -- Property to also be run, but not otherwise.
 onChange :: Property -> Property -> Property
-p `onChange` hook = property (propertyDesc p) $ do
-	r <- ensureProperty p
-	case r of
-		MadeChange -> do
-			r' <- ensureProperty hook
-			return $ r <> r'
-		_ -> return r
+p `onChange` hook = Property (propertyDesc p) satisfy (combineSetAttr p hook)
+  where
+	satisfy = do
+		r <- ensureProperty p
+		case r of
+			MadeChange -> do
+				r' <- ensureProperty hook
+				return $ r <> r'
+			_ -> return r
 
 (==>) :: Desc -> Property -> Property
 (==>) = flip describe
 infixl 1 ==>
 
--- | Makes a Property only be performed when a test succeeds.
+-- | Makes a Property only need to do anything when a test succeeds.
 check :: IO Bool -> Property -> Property
-check c p = property (propertyDesc p) $ ifM (liftIO c)
-	( ensureProperty p
+check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
+	( satisfy
 	, return NoChange
 	)
 
@@ -99,8 +97,8 @@ check c p = property (propertyDesc p) $ ifM (liftIO c)
 -- to be made as it is to just idempotently assure the property is
 -- satisfied. For example, chmodding a file.
 trivial :: Property -> Property
-trivial p = property (propertyDesc p) $ do
-	r <- ensureProperty p
+trivial p = adjustProperty p $ \satisfy -> do
+	r <- satisfy
 	if r == MadeChange
 		then return NoChange
 		else return r
@@ -133,16 +131,33 @@ host hn = Host [] (\_ -> newAttr hn)
 
 -- | Adds a property to a Host
 --
--- Can add Properties, RevertableProperties, and AttrProperties
+-- Can add Properties and RevertableProperties
 (&) :: IsProp p => Host -> p -> Host
-(Host ps as) & p = Host (ps ++ [toProp p]) (getAttr p . as)
+(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)
 
 infixl 1 &
 
 -- | Adds a property to the Host in reverted form.
 (!) :: Host -> RevertableProperty -> Host
-(Host ps as) ! p = Host (ps ++ [toProp q]) (getAttr q . as)
+(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)
   where
 	q = revert p
 
 infixl 1 !
+
+-- Changes the action that is performed to satisfy a property. 
+adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
+adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
+
+-- Combines the Attr settings of two properties.
+combineSetAttr :: (IsProp p, IsProp q) => p -> q -> SetAttr
+combineSetAttr p q = setAttr p . setAttr q
+
+combineSetAttrs :: IsProp p => [p] -> SetAttr
+combineSetAttrs = foldl' (.) id . map setAttr
+
+makeChange :: IO () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
+
+noChange :: Propellor Result
+noChange = return NoChange
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index 2115dc5..9234cbb 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -157,8 +157,8 @@ buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
 -- | Package installation may fail becuse the archive has changed.
 -- Run an update in that case and retry.
 robustly :: Property -> Property
-robustly p = property (propertyDesc p) $ do
-	r <- ensureProperty p
+robustly p = adjustProperty p $ \satisfy -> do
+	r <- satisfy
 	if r == FailedChange
 		then ensureProperty $ p `requires` update
 		else return r
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index 5b7494e..bcd0824 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -12,6 +12,7 @@ import Data.List
 import "mtl" Control.Monad.Reader
 
 import Propellor.Types
+import Propellor.Property
 import Utility.Monad
 import Utility.SafeCommand
 import Utility.Env
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
index 0e63912..f2911e5 100644
--- a/Propellor/Property/Scheduled.hs
+++ b/Propellor/Property/Scheduled.hs
@@ -19,13 +19,13 @@ import qualified Data.Map as M
 -- This uses the description of the Property to keep track of when it was
 -- last run.
 period :: Property -> Recurrance -> Property
-period prop recurrance = property desc $ do
+period prop recurrance = flip describe desc $ adjustProperty prop $ \satisfy -> do
 	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
 	t <- liftIO localNow
 	if Just t >= nexttime
 		then do
-			r <- ensureProperty prop
+			r <- satisfy
 			liftIO $ setLastChecked t (propertyDesc prop)
 			return r
 		else noChange
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index 01be9a5..42401d1 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -8,12 +8,11 @@ module Propellor.Types
 	, HostName
 	, Propellor(..)
 	, Property(..)
-	, property
 	, RevertableProperty(..)
 	, IsProp
 	, describe
 	, toProp
-	, getAttr
+	, setAttr
 	, requires
 	, Desc
 	, Result(..)
@@ -34,7 +33,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
 import Propellor.Types.Attr
 import Propellor.Types.OS
 
-data Host = Host [Property] (Attr -> Attr)
+data Host = Host [Property] SetAttr
 
 -- | Propellor's monad provides read-only access to attributes of the
 -- system.
@@ -55,13 +54,10 @@ data Property = Property
 	{ propertyDesc :: Desc
 	, propertySatisfy :: Propellor Result
 	-- ^ must be idempotent; may run repeatedly
-	, propertyAttr :: Attr -> Attr
+	, propertyAttr :: SetAttr
 	-- ^ a property can affect the overall Attr
 	}
 
-property :: Desc -> Propellor Result -> Property
-property d s = Property d s id
-
 -- | A property that can be reverted.
 data RevertableProperty = RevertableProperty Property Property
 
@@ -72,12 +68,12 @@ class IsProp p where
 	-- | Indicates that the first property can only be satisfied
 	-- once the second one is.
 	requires :: p -> Property -> p
-	getAttr :: p -> (Attr -> Attr)
+	setAttr :: p -> SetAttr
 
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
 	toProp p = p
-	getAttr = propertyAttr
+	setAttr = propertyAttr
 	x `requires` y = Property (propertyDesc x) satisfy attr
 	  where
 	  	attr = propertyAttr x . propertyAttr y
@@ -95,8 +91,8 @@ instance IsProp RevertableProperty where
 	toProp (RevertableProperty p1 _) = p1
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
-	-- | Gets the Attr of the currently active side.
-	getAttr (RevertableProperty p1 _p2) = getAttr p1
+	-- | Return the SetAttr of the currently active side.
+	setAttr (RevertableProperty p1 _p2) = setAttr p1
 
 type Desc = String
 
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index 1ff5814..0061177 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -42,3 +42,5 @@ newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
 
 type HostName = String
 type Domain = String
+
+type SetAttr = Attr -> Attr
diff --git a/TODO b/TODO
index 93dcf0d..96324ad 100644
--- a/TODO
+++ b/TODO
@@ -15,7 +15,5 @@
 * 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.
-* Attributes can only be set in the top level property list for a Host.
-  If an attribute is set inside a propertyList, it won't propigate out.
-  Fix this. Probably the fix involves combining AttrProperty into Property.
-  Then propertyList can gather the attributes from its list.
+* Docking a container in a host should add to the host any cnames that
+  are assigned to the container.
diff --git a/debian/changelog b/debian/changelog
index 3cef12d..ee7df1e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,10 @@
 propellor (0.4.0) UNRELEASED; urgency=medium
 
   * Constructor of Property has changed (use property function instead).
-  * Run all cron jobs under chronic from moreutils to avoid unnecessary mails.
+  * All Property combinators now combine together their Attr settings.
+    So Attr settings can be made inside a propertyList, for example.
+  * Run all cron jobs under chronic from moreutils to avoid unnecessary
+    mails.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400
 

From e69a0a60652cbddf6f8b3c4562398a8e61a51917 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 09:37:26 -0400
Subject: [PATCH 07/34] update

---
 TODO | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/TODO b/TODO
index 96324ad..7a1e1df 100644
--- a/TODO
+++ b/TODO
@@ -17,3 +17,10 @@
   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.
+* Either `Ssh.hostKey` should set the sshPubKey attr
+  (which seems hard, as attrs need to be able to be calculated without
+  running any IO code, and here IO is needed along with decrypting the
+  PrivData..), or the public key should not be stored in
+  the PrivData, and instead configured using the attr.
+  Getting the ssh host key into the attr will allow automatically
+  exporting it via DNS.

From f26bdd1e24594ad4552a1e66bf0347afa6dde3e2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 09:37:28 -0400
Subject: [PATCH 08/34] allow connections from outside world

---
 Propellor/Property/SiteSpecific/JoeySites.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index c939ddc..2a60199 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -42,6 +42,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
 		, "allowSTRANGERS = 42" -- lets anyone connect
 		, "nopost = 1" -- no new posting (just gather them)
 		]
+	, "/etc/hosts.deny" `File.lacksLine` "leafnode: ALL"
 	, Apt.serviceInstalledRunning "openbsd-inetd"
 	, File.notPresent "/etc/cron.daily/leafnode"
 	, File.notPresent "/etc/cron.d/leafnode"

From 6f0b6b88164327025e50fd1ea954e551fd546ed0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 10:14:30 -0400
Subject: [PATCH 09/34] propellor spin

---
 Propellor/Property/SiteSpecific/JoeySites.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 2a60199..b43d83f 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -57,7 +57,9 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
 		, "  <Directory " ++ datadir ++ "/>"
 		, "    Options Indexes FollowSymlinks"
 		, "    AllowOverride None"
-		, "    Require all granted"
+		-- I had this in the file before.
+		-- This may be needed by a newer version of apache?
+		--, "    Require all granted"
 		, "  </Directory>"
 		]
 	]

From b2d6393bf40f73d25871c678309649e75c159f24 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 14:29:25 -0400
Subject: [PATCH 10/34] added bind 9 zone file creation code

---
 Propellor/Property/Dns.hs | 167 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 161 insertions(+), 6 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 34e790d..5b4b262 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -4,11 +4,14 @@ import Propellor
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
+import Utility.Applicative
+
+import Data.List
 
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
 
-data Zone = Zone
+data NamedConf = NamedConf
 	{ zdomain :: Domain
 	, ztype :: Type
 	, zfile :: FilePath
@@ -16,7 +19,7 @@ data Zone = Zone
 	, zconfiglines :: [String]
 	}
 
-zoneDesc :: Zone -> String
+zoneDesc :: NamedConf -> String
 zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
 
 type IPAddr = String
@@ -26,8 +29,8 @@ type Domain = String
 data Type = Master | Secondary
 	deriving (Show, Eq)
 
-secondary :: Domain -> [IPAddr] -> Zone
-secondary domain masters = Zone
+secondary :: Domain -> [IPAddr] -> NamedConf
+secondary domain masters = NamedConf
 	{ zdomain = domain
 	, ztype = Secondary
 	, zfile = "db." ++ domain
@@ -35,7 +38,7 @@ secondary domain masters = Zone
 	, zconfiglines = ["allow-transfer { }"]
 	}
 
-zoneStanza :: Zone -> [Line]
+zoneStanza :: NamedConf -> [Line]
 zoneStanza z =
 	[ "// automatically generated by propellor"
 	, "zone \"" ++ zdomain z ++ "\" {"
@@ -56,8 +59,160 @@ zoneStanza z =
 
 -- | Rewrites the whole named.conf.local file to serve the specificed
 -- zones.
-zones :: [Zone] -> Property
+zones :: [NamedConf] -> Property
 zones zs = hasContent namedconf (concatMap zoneStanza zs)
 	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
 	`requires` Apt.serviceInstalledRunning "bind9"
 	`onChange` Service.reloaded "bind9"
+
+-- | Represents a bind 9 zone file.
+data Zone = Zone SOA [(HostName, Record)]
+
+-- | Every domain has a SOA record, which is big and complicated.
+data SOA = SOA
+	{ sRoot :: BindDomain
+	, sSerial :: SerialNumber
+	 -- ^ The most important parameter is the serial number,
+	 -- which must increase after each change.
+	 , sRefresh :: Integer
+	 , sRetry :: Integer
+	 , sExpire :: Integer
+	 , sTTL :: Integer
+	 , sRecord :: [Record]
+	 -- ^ Records for the root of the domain. Typically NS, A, TXT
+	 }
+
+-- | Types of DNS records.
+--
+-- This is not a complete list, more can be added.
+data Record
+	= A Ipv4
+	| AAAA Ipv6
+	| CNAME BindDomain
+	| MX Int BindDomain
+	| NS BindDomain
+	| TXT String
+
+type Ipv4 = String
+type Ipv6 = String
+
+type SerialNumber = Integer
+
+-- | Domains in the zone file must end with a period if they are absolute.
+--
+-- Let's use a type to keep absolute domains straight from relative
+-- domains.
+--
+-- The SOADomain refers to the root SOA record.
+data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
+
+dValue :: BindDomain -> String
+dValue (RelDomain d) = d
+dValue (AbsDomain d) = d ++ "."
+dValue (SOADomain) = "@"
+
+rField :: Record -> String
+rField (A _) = "A"
+rField (AAAA _) = "AAAA"
+rField (CNAME _) = "CNAME"
+rField (MX _ _) = "MX"
+rField (NS _) = "NS"
+rField (TXT _) = "TXT"
+
+rValue :: Record -> String
+rValue (A addr) = addr
+rValue (AAAA addr) = addr
+rValue (CNAME d) = dValue d
+rValue (MX pri d) = show pri ++ " " ++ dValue d
+rValue (NS d) = dValue d
+rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
+  where
+	q = '\"'
+
+-- | Adjusts the serial number of the zone to 
+--
+-- * Always be larger than the passed SerialNumber
+-- * Always be larger than the serial number in the Zone record.
+nextSerial :: Zone -> SerialNumber -> Zone
+nextSerial (Zone soa l) oldserial = Zone soa' l
+  where
+	soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
+
+-- | Write a Zone out to a to a file.
+--
+-- The serial number that is written to the file comes from larger of the
+-- Zone's SOA serial number, and the last serial number used in the file.
+-- This ensures that serial number always increases, while also letting
+-- a Zone contain an existing serial number, which may be quite large.
+--
+-- TODO: This increases the serial number when propellor is running on the
+-- same host and generating its zone there, but what if the DNS host is
+-- changed? We'd then want to remember the actual serial number and
+-- propigate it to the new DNS host.
+writeZoneFile :: Zone -> FilePath -> IO ()
+writeZoneFile z f = do
+	oldserial <- nextZoneFileSerialNumber f
+	let z'@(Zone soa' _) = nextSerial z oldserial
+	writeFile f (genZoneFile z')
+	writeFile (zoneSerialFile f) (show $ sSerial soa')
+
+-- | Next to the zone file, is a ".serial" file, which contains
+-- the SOA Serial number of that zone. This saves the bother of parsing
+-- this horrible format.
+zoneSerialFile :: FilePath -> FilePath
+zoneSerialFile f = f ++ ".serial"
+
+nextZoneFileSerialNumber :: FilePath -> IO SerialNumber
+nextZoneFileSerialNumber = maybe 1 (+1) <$$> readZoneSerialFile
+
+readZoneSerialFile :: FilePath -> IO (Maybe SerialNumber)
+readZoneSerialFile f = catchDefaultIO Nothing $
+	readish <$> readFile (zoneSerialFile f)
+
+-- | Generating a zone file.
+genZoneFile :: Zone -> String
+genZoneFile (Zone soa rs) = unlines $
+	header : genSOA soa : map genr rs
+  where
+	header = com "BIND zone file. Generated by propellor, do not edit."
+
+	genr (d, r) = genRecord (Just d, r)
+
+genRecord :: (Maybe Domain, Record) -> String
+genRecord (mdomain, record) = intercalate "\t"
+	[ dname
+	, "IN"
+	, rField record
+	, rValue record
+	]
+  where
+	dname = fromMaybe "" mdomain
+
+genSOA :: SOA -> String
+genSOA soa = unlines $
+	header : map genRecord (zip (repeat Nothing) (sRecord soa))
+  where
+	header = unlines
+		-- @ IN SOA root. root (
+		[ intercalate "\t"
+			[ dValue SOADomain 
+			, "IN"
+			, "SOA"
+			, dValue (sRoot soa)
+			, "root"
+			, "("
+			]
+		, headerline sSerial "Serial"
+		, headerline sRefresh "Refresh"
+		, headerline sRetry "Retry"
+		, headerline sExpire "Expire"
+		, headerline sTTL "Default TTL"
+		, inheader ")"
+		]
+	headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment
+	inheader l = "\t\t\t" ++ l
+
+-- | Comment line in a zone file.
+com :: String -> String
+com s = "; " ++ s
+

From 498fe2cd2551f3a4fdbcbd2b99fdfdbefa0879d0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 14:44:46 -0400
Subject: [PATCH 11/34] propellor spin

---
 Propellor/Property/Dns.hs | 6 +++---
 config-joey.hs            | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 5b4b262..260f3aa 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -133,8 +133,8 @@ rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
 --
 -- * Always be larger than the passed SerialNumber
 -- * Always be larger than the serial number in the Zone record.
-nextSerial :: Zone -> SerialNumber -> Zone
-nextSerial (Zone soa l) oldserial = Zone soa' l
+nextSerialNumber :: Zone -> SerialNumber -> Zone
+nextSerialNumber (Zone soa l) oldserial = Zone soa' l
   where
 	soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
 
@@ -152,7 +152,7 @@ nextSerial (Zone soa l) oldserial = Zone soa' l
 writeZoneFile :: Zone -> FilePath -> IO ()
 writeZoneFile z f = do
 	oldserial <- nextZoneFileSerialNumber f
-	let z'@(Zone soa' _) = nextSerial z oldserial
+	let z'@(Zone soa' _) = nextSerialNumber z oldserial
 	writeFile f (genZoneFile z')
 	writeFile (zoneSerialFile f) (show $ sSerial soa')
 
diff --git a/config-joey.hs b/config-joey.hs
index ac70fc3..b6d1664 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -225,7 +225,7 @@ cleanCloudAtCost = propertyList "cloudatcost cleanup"
 		]
 	]
 
-myDnsSecondary :: [Dns.Zone]
+myDnsSecondary :: [Dns.NamedConf]
 myDnsSecondary =
 	[ Dns.secondary "kitenet.net" master
 	, Dns.secondary "joeyh.name" master

From 8d8f68f5abdfc6980697c160307751aa3b18f9b8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 16:33:06 -0400
Subject: [PATCH 12/34] date based serial numbers

complicated by OGMG-it's-2014-and-we're-still-using-unsigned-32-bit-ints
---
 Propellor/Property/Dns.hs | 72 ++++++++++++++++++++++++++++-----------
 1 file changed, 53 insertions(+), 19 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 260f3aa..4c59aac 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -7,6 +7,9 @@ import qualified Propellor.Property.Service as Service
 import Utility.Applicative
 
 import Data.List
+import Data.Time.Clock.POSIX
+import Data.Time.Format
+import Foreign.C.Types
 
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
@@ -66,7 +69,11 @@ zones zs = hasContent namedconf (concatMap zoneStanza zs)
 	`onChange` Service.reloaded "bind9"
 
 -- | Represents a bind 9 zone file.
-data Zone = Zone SOA [(HostName, Record)]
+data Zone = Zone
+	{ zSOA :: SOA
+	, zHosts :: [(HostName, Record)]
+	}
+	deriving (Read, Show, Eq)
 
 -- | Every domain has a SOA record, which is big and complicated.
 data SOA = SOA
@@ -81,6 +88,7 @@ data SOA = SOA
 	 , sRecord :: [Record]
 	 -- ^ Records for the root of the domain. Typically NS, A, TXT
 	 }
+	 deriving (Read, Show, Eq)
 
 -- | Types of DNS records.
 --
@@ -92,11 +100,13 @@ data Record
 	| MX Int BindDomain
 	| NS BindDomain
 	| TXT String
+	deriving (Read, Show, Eq)
 
 type Ipv4 = String
 type Ipv6 = String
 
-type SerialNumber = Integer
+-- | Bind serial numbers are unsigned, 32 bit integers.
+type SerialNumber = CInt
 
 -- | Domains in the zone file must end with a period if they are absolute.
 --
@@ -105,6 +115,7 @@ type SerialNumber = Integer
 --
 -- The SOADomain refers to the root SOA record.
 data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
+	deriving (Read, Show, Eq)
 
 dValue :: BindDomain -> String
 dValue (RelDomain d) = d
@@ -127,7 +138,7 @@ rValue (MX pri d) = show pri ++ " " ++ dValue d
 rValue (NS d) = dValue d
 rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
   where
-	q = '\"'
+	q = '"'
 
 -- | Adjusts the serial number of the zone to 
 --
@@ -138,36 +149,59 @@ nextSerialNumber (Zone soa l) oldserial = Zone soa' l
   where
 	soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
 
+incrSerialNumber :: Zone -> Zone
+incrSerialNumber (Zone soa l) = Zone soa' l
+  where
+	soa' = soa { sSerial = succ (sSerial soa) }
+
+-- | Propellor uses a serial number derived from the current date and time.
+--
+-- This ensures that, even if zone files are being generated on
+-- multiple hosts, the serial numbers will not get out of sync between
+-- them.
+--
+-- Since serial numbers are limited to 32 bits, the number of seconds
+-- since the epoch is divided by 5. This will work until the year 2650,
+-- at which point this stupid limit had better have been increased to
+-- 128 bits. If we didn't divide by 5, it would only work up to 2106!
+--
+-- Dividing by 5 means that this number only changes once every 5 seconds.
+-- If propellor is running more often than once every 5 seconds, you're
+-- doing something wrong.
+currentSerialNumber :: IO SerialNumber
+currentSerialNumber = calc <$> getPOSIXTime
+  where
+	calc t = floor (t / 5)
+
 -- | Write a Zone out to a to a file.
 --
 -- The serial number that is written to the file comes from larger of the
 -- Zone's SOA serial number, and the last serial number used in the file.
 -- This ensures that serial number always increases, while also letting
 -- a Zone contain an existing serial number, which may be quite large.
---
--- TODO: This increases the serial number when propellor is running on the
--- same host and generating its zone there, but what if the DNS host is
--- changed? We'd then want to remember the actual serial number and
--- propigate it to the new DNS host.
 writeZoneFile :: Zone -> FilePath -> IO ()
 writeZoneFile z f = do
 	oldserial <- nextZoneFileSerialNumber f
-	let z'@(Zone soa' _) = nextSerialNumber z oldserial
+	let z' = nextSerialNumber z oldserial
 	writeFile f (genZoneFile z')
-	writeFile (zoneSerialFile f) (show $ sSerial soa')
+	writeZonePropellorFile f z'
 
--- | Next to the zone file, is a ".serial" file, which contains
--- the SOA Serial number of that zone. This saves the bother of parsing
--- this horrible format.
-zoneSerialFile :: FilePath -> FilePath
-zoneSerialFile f = f ++ ".serial"
+-- | Next to the zone file, is a ".propellor" file, which contains
+-- the serialized Zone. This saves the bother of parsing
+-- the horrible bind zone file format.
+zonePropellorFile :: FilePath -> FilePath
+zonePropellorFile f = f ++ ".serial"
 
 nextZoneFileSerialNumber :: FilePath -> IO SerialNumber
-nextZoneFileSerialNumber = maybe 1 (+1) <$$> readZoneSerialFile
+nextZoneFileSerialNumber = maybe 1 (sSerial . zSOA . incrSerialNumber)
+	<$$> readZonePropellorFile
 
-readZoneSerialFile :: FilePath -> IO (Maybe SerialNumber)
-readZoneSerialFile f = catchDefaultIO Nothing $
-	readish <$> readFile (zoneSerialFile f)
+writeZonePropellorFile :: FilePath -> Zone -> IO ()
+writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
+
+readZonePropellorFile :: FilePath -> IO (Maybe Zone)
+readZonePropellorFile f = catchDefaultIO Nothing $
+	readish <$> readFile (zonePropellorFile f)
 
 -- | Generating a zone file.
 genZoneFile :: Zone -> String

From 2b9ee5b29b03a4a18fb43dafab38d6d185c653e0 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 16:49:36 -0400
Subject: [PATCH 13/34] add mkSOA

---
 Propellor/Property/Dns.hs | 39 +++++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 12 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 4c59aac..1d4a8e4 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -77,18 +77,33 @@ data Zone = Zone
 
 -- | Every domain has a SOA record, which is big and complicated.
 data SOA = SOA
-	{ sRoot :: BindDomain
+	{ sDomain :: BindDomain
+	-- ^ Typically ns1.your.domain
 	, sSerial :: SerialNumber
-	 -- ^ The most important parameter is the serial number,
-	 -- which must increase after each change.
-	 , sRefresh :: Integer
-	 , sRetry :: Integer
-	 , sExpire :: Integer
-	 , sTTL :: Integer
-	 , sRecord :: [Record]
-	 -- ^ Records for the root of the domain. Typically NS, A, TXT
-	 }
-	 deriving (Read, Show, Eq)
+	-- ^ The most important parameter is the serial number,
+	-- which must increase after each change.
+	, sRefresh :: Integer
+	, sRetry :: Integer
+	, sExpire :: Integer
+	, sTTL :: Integer
+	, sRecord :: [Record]
+	-- ^ Records for the root of the domain. Typically NS, A, TXT
+	}
+	deriving (Read, Show, Eq)
+
+-- |  Generates a SOA with some fairly sane numbers in it.
+mkSOA :: Domain -> [Record] -> SOA
+mkSOA d rs = SOA
+	{ sDomain = AbsDomain d
+	, sSerial = 1
+	, sRefresh = hours 4
+	, sRetry = hours 1
+	, sExpire = 2419200 -- 4 weeks
+	, sTTL = hours 8
+	, sRecord = rs
+	}
+  where
+	hours n = n * 60 * 60
 
 -- | Types of DNS records.
 --
@@ -232,7 +247,7 @@ genSOA soa = unlines $
 			[ dValue SOADomain 
 			, "IN"
 			, "SOA"
-			, dValue (sRoot soa)
+			, dValue (sDomain soa)
 			, "root"
 			, "("
 			]

From 39d697ca789c04da07bb14cc7476899e717d9413 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 17:19:28 -0400
Subject: [PATCH 14/34] add dns records to Attr

---
 Propellor/Attr.hs         |  10 ++--
 Propellor/Property/Dns.hs | 121 +++++++++++---------------------------
 Propellor/Types.hs        |   1 -
 Propellor/Types/Attr.hs   |  12 ++--
 Propellor/Types/Dns.hs    |  73 +++++++++++++++++++++++
 Propellor/Types/OS.hs     |   1 +
 config-joey.hs            |   6 +-
 propellor.cabal           |   1 +
 8 files changed, 122 insertions(+), 103 deletions(-)
 create mode 100644 Propellor/Types/Dns.hs

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 03c882c..2173658 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -4,6 +4,7 @@ module Propellor.Attr where
 
 import Propellor.Types
 import Propellor.Types.Attr
+import Propellor.Types.Dns
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
@@ -28,15 +29,16 @@ getOS :: Propellor (Maybe System)
 getOS = asks _os
 
 cname :: Domain -> Property
-cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
+cname domain = pureAttrProperty ("cname " ++ domain)
+	(addDNS $ CNAME $ AbsDomain domain)
 
 cnameFor :: Domain -> (Domain -> Property) -> Property
 cnameFor domain mkp =
 	let p = mkp domain
-	in p { propertyAttr = propertyAttr p . addCName domain }
+	in p { propertyAttr = propertyAttr p . addDNS (CNAME $ AbsDomain domain) }
 
-addCName :: HostName -> SetAttr
-addCName domain d = d { _cnames = S.insert domain (_cnames d) }
+addDNS :: Record -> SetAttr
+addDNS record d = d { _dns = S.insert record (_dns d) }
 
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 1d4a8e4..99a6014 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -1,6 +1,18 @@
-module Propellor.Property.Dns where
+module Propellor.Property.Dns (
+	module Propellor.Types.Dns,
+	secondary,
+	servingZones,
+	mkSOA,
+	nextSerialNumber,
+	incrSerialNumber,
+	currentSerialNumber,
+	writeZoneFile,
+	genZoneFile,
+	genSOA,
+) where
 
 import Propellor
+import Propellor.Types.Dns
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
@@ -8,48 +20,31 @@ import Utility.Applicative
 
 import Data.List
 import Data.Time.Clock.POSIX
-import Data.Time.Format
-import Foreign.C.Types
 
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
 
-data NamedConf = NamedConf
-	{ zdomain :: Domain
-	, ztype :: Type
-	, zfile :: FilePath
-	, zmasters :: [IPAddr]
-	, zconfiglines :: [String]
-	}
-
 zoneDesc :: NamedConf -> String
-zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
-
-type IPAddr = String
-
-type Domain = String
-
-data Type = Master | Secondary
-	deriving (Show, Eq)
+zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")"
 
 secondary :: Domain -> [IPAddr] -> NamedConf
 secondary domain masters = NamedConf
-	{ zdomain = domain
-	, ztype = Secondary
-	, zfile = "db." ++ domain
-	, zmasters = masters
-	, zconfiglines = ["allow-transfer { }"]
+	{ confDomain = domain
+	, confType = Secondary
+	, confFile = "db." ++ domain
+	, confMasters = masters
+	, confLines = ["allow-transfer { }"]
 	}
 
-zoneStanza :: NamedConf -> [Line]
-zoneStanza z =
+confStanza :: NamedConf -> [Line]
+confStanza c =
 	[ "// automatically generated by propellor"
-	, "zone \"" ++ zdomain z ++ "\" {"
-	, cfgline "type" (if ztype z == Master then "master" else "slave")
-	, cfgline "file" ("\"" ++ zfile z ++ "\"")
+	, "zone \"" ++ confDomain c ++ "\" {"
+	, cfgline "type" (if confType c == Master then "master" else "slave")
+	, cfgline "file" ("\"" ++ confFile c ++ "\"")
 	] ++
-	(if null (zmasters z) then [] else mastersblock) ++
-	(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
+	(if null (confMasters c) then [] else mastersblock) ++
+	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
 	[ "};"
 	, ""
 	]
@@ -57,40 +52,17 @@ zoneStanza z =
 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
 	mastersblock =
 		[ "\tmasters {" ] ++
-		(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
+		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
 		[ "\t};" ]
 
 -- | Rewrites the whole named.conf.local file to serve the specificed
 -- zones.
-zones :: [NamedConf] -> Property
-zones zs = hasContent namedconf (concatMap zoneStanza zs)
+servingZones :: [NamedConf] -> Property
+servingZones zs = hasContent namedconf (concatMap confStanza zs)
 	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
 	`requires` Apt.serviceInstalledRunning "bind9"
 	`onChange` Service.reloaded "bind9"
 
--- | Represents a bind 9 zone file.
-data Zone = Zone
-	{ zSOA :: SOA
-	, zHosts :: [(HostName, Record)]
-	}
-	deriving (Read, Show, Eq)
-
--- | Every domain has a SOA record, which is big and complicated.
-data SOA = SOA
-	{ sDomain :: BindDomain
-	-- ^ Typically ns1.your.domain
-	, sSerial :: SerialNumber
-	-- ^ The most important parameter is the serial number,
-	-- which must increase after each change.
-	, sRefresh :: Integer
-	, sRetry :: Integer
-	, sExpire :: Integer
-	, sTTL :: Integer
-	, sRecord :: [Record]
-	-- ^ Records for the root of the domain. Typically NS, A, TXT
-	}
-	deriving (Read, Show, Eq)
-
 -- |  Generates a SOA with some fairly sane numbers in it.
 mkSOA :: Domain -> [Record] -> SOA
 mkSOA d rs = SOA
@@ -105,49 +77,22 @@ mkSOA d rs = SOA
   where
 	hours n = n * 60 * 60
 
--- | Types of DNS records.
---
--- This is not a complete list, more can be added.
-data Record
-	= A Ipv4
-	| AAAA Ipv6
-	| CNAME BindDomain
-	| MX Int BindDomain
-	| NS BindDomain
-	| TXT String
-	deriving (Read, Show, Eq)
-
-type Ipv4 = String
-type Ipv6 = String
-
--- | Bind serial numbers are unsigned, 32 bit integers.
-type SerialNumber = CInt
-
--- | Domains in the zone file must end with a period if they are absolute.
---
--- Let's use a type to keep absolute domains straight from relative
--- domains.
---
--- The SOADomain refers to the root SOA record.
-data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
-	deriving (Read, Show, Eq)
-
 dValue :: BindDomain -> String
 dValue (RelDomain d) = d
 dValue (AbsDomain d) = d ++ "."
 dValue (SOADomain) = "@"
 
 rField :: Record -> String
-rField (A _) = "A"
-rField (AAAA _) = "AAAA"
+rField (Address (IPv4 _)) = "A"
+rField (Address (IPv6 _)) = "AAAA"
 rField (CNAME _) = "CNAME"
 rField (MX _ _) = "MX"
 rField (NS _) = "NS"
 rField (TXT _) = "TXT"
 
 rValue :: Record -> String
-rValue (A addr) = addr
-rValue (AAAA addr) = addr
+rValue (Address (IPv4 addr)) = addr
+rValue (Address (IPv6 addr)) = addr
 rValue (CNAME d) = dValue d
 rValue (MX pri d) = show pri ++ " " ++ dValue d
 rValue (NS d) = dValue d
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index 42401d1..ad822a8 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -5,7 +5,6 @@
 module Propellor.Types
 	( Host(..)
 	, Attr
-	, HostName
 	, Propellor(..)
 	, Property(..)
 	, RevertableProperty(..)
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index 0061177..cf8bdf1 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -1,14 +1,15 @@
 module Propellor.Types.Attr where
 
 import Propellor.Types.OS
+import qualified Propellor.Types.Dns as Dns
 
 import qualified Data.Set as S
 
 -- | The attributes of a host. For example, its hostname.
 data Attr = Attr
 	{ _hostname :: HostName
-	, _cnames :: S.Set Domain
 	, _os :: Maybe System
+	, _dns :: S.Set Dns.Record
 	, _sshPubKey :: Maybe String
 
 	, _dockerImage :: Maybe String
@@ -18,8 +19,8 @@ data Attr = Attr
 instance Eq Attr where
 	x == y = and
 		[ _hostname x == _hostname y
-		, _cnames x == _cnames y
 		, _os x == _os y
+		, _dns x == _dns y
 		, _sshPubKey x == _sshPubKey y
 
 		, _dockerImage x == _dockerImage y
@@ -30,17 +31,14 @@ instance Eq Attr where
 instance Show Attr where
 	show a = unlines
 		[ "hostname " ++ _hostname a
-		, "cnames " ++ show (_cnames a)
 		, "OS " ++ show (_os a)
+		, "dns " ++ show (_dns a)
 		, "sshPubKey " ++ show (_sshPubKey a)
 		, "docker image " ++ show (_dockerImage a)
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
 
 newAttr :: HostName -> Attr
-newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
-
-type HostName = String
-type Domain = String
+newAttr hn = Attr hn Nothing S.empty Nothing Nothing []
 
 type SetAttr = Attr -> Attr
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
new file mode 100644
index 0000000..4b5925c
--- /dev/null
+++ b/Propellor/Types/Dns.hs
@@ -0,0 +1,73 @@
+module Propellor.Types.Dns where
+
+import Propellor.Types.OS (HostName)
+
+import Foreign.C.Types
+
+type Domain = String
+
+data IPAddr = IPv4 String | IPv6 String
+	deriving (Read, Show, Eq, Ord)
+
+fromIPAddr :: IPAddr -> String
+fromIPAddr (IPv4 addr) = addr
+fromIPAddr (IPv6 addr) = addr
+
+-- | Represents a bind 9 named.conf file.
+data NamedConf = NamedConf
+	{ confDomain :: Domain
+	, confType :: Type
+	, confFile :: FilePath
+	, confMasters :: [IPAddr]
+	, confLines :: [String]
+	}
+	deriving (Show, Eq)
+
+data Type = Master | Secondary
+	deriving (Show, Eq)
+
+-- | Represents a bind 9 zone file.
+data Zone = Zone
+	{ zSOA :: SOA
+	, zHosts :: [(HostName, Record)]
+	}
+	deriving (Read, Show, Eq)
+
+-- | Every domain has a SOA record, which is big and complicated.
+data SOA = SOA
+	{ sDomain :: BindDomain
+	-- ^ Typically ns1.your.domain
+	, sSerial :: SerialNumber
+	-- ^ The most important parameter is the serial number,
+	-- which must increase after each change.
+	, sRefresh :: Integer
+	, sRetry :: Integer
+	, sExpire :: Integer
+	, sTTL :: Integer
+	, sRecord :: [Record]
+	-- ^ Records for the root of the domain. Typically NS, A, TXT
+	}
+	deriving (Read, Show, Eq)
+
+-- | Types of DNS records.
+--
+-- This is not a complete list, more can be added.
+data Record
+	= Address IPAddr
+	| CNAME BindDomain
+	| MX Int BindDomain
+	| NS BindDomain
+	| TXT String
+	deriving (Read, Show, Eq, Ord)
+
+-- | Bind serial numbers are unsigned, 32 bit integers.
+type SerialNumber = CInt
+
+-- | Domains in the zone file must end with a period if they are absolute.
+--
+-- Let's use a type to keep absolute domains straight from relative
+-- domains.
+--
+-- The SOADomain refers to the root SOA record.
+data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
+	deriving (Read, Show, Eq, Ord)
diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs
index 0635b27..23cc8a2 100644
--- a/Propellor/Types/OS.hs
+++ b/Propellor/Types/OS.hs
@@ -1,5 +1,6 @@
 module Propellor.Types.OS where
 
+type HostName = String
 type UserName = String
 type GroupName = String
 
diff --git a/config-joey.hs b/config-joey.hs
index b6d1664..48b4326 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -82,7 +82,7 @@ hosts =               --                  (o)  `
 		& Ssh.hostKey SshEcdsa
 		& Apt.unattendedUpgrades
 		& Apt.serviceInstalledRunning "ntp"
-		& Dns.zones myDnsSecondary
+		& Dns.servingZones myDnsSecondary
 		& Postfix.satellite
 	
 		& Apt.serviceInstalledRunning "apache2"
@@ -234,8 +234,8 @@ myDnsSecondary =
 	, Dns.secondary "branchable.com" branchablemaster
 	]
   where
-	master = ["80.68.85.49", "2001:41c8:125:49::10"] -- wren
-	branchablemaster = ["66.228.46.55", "2600:3c03::f03c:91ff:fedf:c0e5"]
+	master = [Dns.IPv4 "80.68.85.49", Dns.IPv6 "2001:41c8:125:49::10"] -- wren
+	branchablemaster = [Dns.IPv4 "66.228.46.55", Dns.IPv6 "2600:3c03::f03c:91ff:fedf:c0e5"]
 
 main :: IO ()
 main = defaultMain hosts
diff --git a/propellor.cabal b/propellor.cabal
index 677b9a8..68d7fb7 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -99,6 +99,7 @@ Library
     Propellor.Exception
     Propellor.Types
     Propellor.Types.OS
+    Propellor.Types.Dns
   Other-Modules:
     Propellor.Types.Attr
     Propellor.CmdLine

From 80caa6c09d8c15f0ed5d3ce147869b67c0c9f2a8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 17:38:21 -0400
Subject: [PATCH 15/34] my secondary dns server now uses Ip Attrs

---
 Propellor/Attr.hs      | 20 ++++++++++++++++++++
 Propellor/Types/Dns.hs |  4 ++++
 config-joey.hs         | 26 +++++++++++++++++++++-----
 3 files changed, 45 insertions(+), 5 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 2173658..f3e2e2e 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -9,6 +9,7 @@ import Propellor.Types.Dns
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
 import qualified Data.Map as M
+import Data.Maybe
 import Control.Applicative
 
 pureAttrProperty :: Desc -> SetAttr -> Property 
@@ -28,6 +29,20 @@ os system = pureAttrProperty ("Operating " ++ show system) $
 getOS :: Propellor (Maybe System)
 getOS = asks _os
 
+-- | Indidate that a host has an A record in the DNS.
+--
+-- 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)
+
+-- | Indidate that a host has an AAAA record in the DNS.
+ipv6 :: String -> Property
+ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
+	(addDNS $ Address $ IPv6 addr)
+
+-- | Indicate that a host has a CNAME pointing at it in the DNS.
 cname :: Domain -> Property
 cname domain = pureAttrProperty ("cname " ++ domain)
 	(addDNS $ CNAME $ AbsDomain domain)
@@ -62,6 +77,11 @@ hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
 
+getAddresses :: HostName -> [Host] -> [IPAddr]
+getAddresses hn hosts = case hostAttr <$> findHost hosts hn of
+	Nothing -> []
+	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
+
 -- | Lifts an action into a different host.
 --
 -- For example, `fromHost hosts "otherhost" getSshPubKey`
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 4b5925c..026920f 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -60,6 +60,10 @@ data Record
 	| TXT String
 	deriving (Read, Show, Eq, Ord)
 
+getIPAddr :: Record -> Maybe IPAddr
+getIPAddr (Address addr) = Just addr
+getIPAddr _ = Nothing
+
 -- | Bind serial numbers are unsigned, 32 bit integers.
 type SerialNumber = CInt
 
diff --git a/config-joey.hs b/config-joey.hs
index 48b4326..8c61c32 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -37,6 +37,9 @@ hosts =               --                  (o)  `
 
 	-- Nothing super-important lives here.
 	, standardSystem "clam.kitenet.net" Unstable "amd64"
+		& ipv4 "162.248.143.249"
+		& ipv6 "2002:5044:5531::1"
+
 		& cleanCloudAtCost
 		& Apt.unattendedUpgrades
 		& Network.ipv6to4
@@ -63,6 +66,8 @@ hosts =               --                  (o)  `
 	
 	-- Orca is the main git-annex build box.
 	, standardSystem "orca.kitenet.net" Unstable "amd64"
+		& ipv4 "138.38.108.179"
+
 		& Hostname.sane
 		& Apt.unattendedUpgrades
 		& Postfix.satellite
@@ -76,6 +81,8 @@ hosts =               --                  (o)  `
 	
 	-- Important stuff that needs not too much memory or CPU.
   	, standardSystem "diatom.kitenet.net" Stable "amd64"
+		& ipv4 "107.170.31.195"
+
 		& Hostname.sane
 		& Ssh.hostKey SshDsa
 		& Ssh.hostKey SshRsa
@@ -234,8 +241,8 @@ myDnsSecondary =
 	, Dns.secondary "branchable.com" branchablemaster
 	]
   where
-	master = [Dns.IPv4 "80.68.85.49", Dns.IPv6 "2001:41c8:125:49::10"] -- wren
-	branchablemaster = [Dns.IPv4 "66.228.46.55", Dns.IPv6 "2600:3c03::f03c:91ff:fedf:c0e5"]
+	master = getAddresses "wren.kitenet.net" hosts
+	branchablemaster = getAddresses "pell.branchable.com" hosts
 
 main :: IO ()
 main = defaultMain hosts
@@ -254,11 +261,20 @@ main = defaultMain hosts
 
 
 monsters :: [Host]    -- Systems I don't manage with propellor,
-monsters =	      -- but do want to track their public keys.
+monsters =	      -- but do want to track their public keys etc.
 	[ host "usw-s002.rsync.net"
 		& sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="
-	, host "turtle.kitenet.net"
-		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
 	, host "github.com" 
 		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
+	, host "turtle.kitenet.net"
+		& ipv4 "67.223.19.96"
+		& ipv6 "2001:4978:f:2d9::2"
+		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
+	, host "wren.kitenet.net"
+		& ipv4 "80.68.85.49"
+		& ipv6 "2001:41c8:125:49::10"
+		& cname "kite.kitenet.net"
+	, host "pell.branchable.com"
+		& ipv4 "66.228.46.55"
+		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
 	]

From 8e22065deff41c3e476763ebd939a63856e6d54b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 19:06:55 -0400
Subject: [PATCH 16/34] better serial number offsets

---
 Propellor/Property/Dns.hs | 82 +++++++++++++++++++--------------------
 Propellor/Types/Dns.hs    |  4 +-
 2 files changed, 41 insertions(+), 45 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 99a6014..cefbd71 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -3,12 +3,10 @@ module Propellor.Property.Dns (
 	secondary,
 	servingZones,
 	mkSOA,
-	nextSerialNumber,
-	incrSerialNumber,
-	currentSerialNumber,
 	writeZoneFile,
-	genZoneFile,
-	genSOA,
+	nextSerialNumber,
+	adjustSerialNumber,
+	serialNumberOffset,
 ) where
 
 import Propellor
@@ -19,7 +17,6 @@ import qualified Propellor.Property.Service as Service
 import Utility.Applicative
 
 import Data.List
-import Data.Time.Clock.POSIX
 
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
@@ -64,10 +61,18 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 	`onChange` Service.reloaded "bind9"
 
 -- |  Generates a SOA with some fairly sane numbers in it.
-mkSOA :: Domain -> [Record] -> SOA
-mkSOA d rs = SOA
+--
+-- The SerialNumber can be whatever serial number was used by the domain
+-- before propellor started managing it. Or 0 if the domain has only ever
+-- been managed by propellor.
+--
+-- You do not need to increment the SerialNumber when making changes!
+-- Propellor will automatically add the number of commits in the git
+-- repository to the SerialNumber.
+mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
+mkSOA d sn rs = SOA
 	{ sDomain = AbsDomain d
-	, sSerial = 1
+	, sSerial = sn
 	, sRefresh = hours 4
 	, sRetry = hours 1
 	, sExpire = 2419200 -- 4 weeks
@@ -102,47 +107,33 @@ rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
 
 -- | Adjusts the serial number of the zone to 
 --
--- * Always be larger than the passed SerialNumber
 -- * Always be larger than the serial number in the Zone record.
+-- * Always be larger than the passed SerialNumber
 nextSerialNumber :: Zone -> SerialNumber -> Zone
-nextSerialNumber (Zone soa l) oldserial = Zone soa' l
-  where
-	soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
+nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
 
-incrSerialNumber :: Zone -> Zone
-incrSerialNumber (Zone soa l) = Zone soa' l
+adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
+adjustSerialNumber (Zone soa l) f = Zone soa' l
   where
-	soa' = soa { sSerial = succ (sSerial soa) }
+	soa' = soa { sSerial = f (sSerial soa) }
 
--- | Propellor uses a serial number derived from the current date and time.
---
--- This ensures that, even if zone files are being generated on
--- multiple hosts, the serial numbers will not get out of sync between
--- them.
---
--- Since serial numbers are limited to 32 bits, the number of seconds
--- since the epoch is divided by 5. This will work until the year 2650,
--- at which point this stupid limit had better have been increased to
--- 128 bits. If we didn't divide by 5, it would only work up to 2106!
---
--- Dividing by 5 means that this number only changes once every 5 seconds.
--- If propellor is running more often than once every 5 seconds, you're
--- doing something wrong.
-currentSerialNumber :: IO SerialNumber
-currentSerialNumber = calc <$> getPOSIXTime
-  where
-	calc t = floor (t / 5)
+-- | Count the number of git commits made to the current branch.
+serialNumberOffset :: IO SerialNumber
+serialNumberOffset = fromIntegral . length . lines
+	<$> readProcess "git" ["log", "--pretty=%H"]
 
 -- | Write a Zone out to a to a file.
 --
--- The serial number that is written to the file comes from larger of the
--- Zone's SOA serial number, and the last serial number used in the file.
--- This ensures that serial number always increases, while also letting
--- a Zone contain an existing serial number, which may be quite large.
+-- The serial number in the Zone automatically has the serialNumberOffset
+-- added to it. Also, just in case, the old serial number used in the zone
+-- file is checked, and if it is somehow larger, its succ is used.
 writeZoneFile :: Zone -> FilePath -> IO ()
 writeZoneFile z f = do
-	oldserial <- nextZoneFileSerialNumber f
-	let z' = nextSerialNumber z oldserial
+	oldserial <- oldZoneFileSerialNumber f
+	offset <- serialNumberOffset
+	let z' = nextSerialNumber
+		(adjustSerialNumber z (+ offset))
+		(succ oldserial)
 	writeFile f (genZoneFile z')
 	writeZonePropellorFile f z'
 
@@ -152,9 +143,8 @@ writeZoneFile z f = do
 zonePropellorFile :: FilePath -> FilePath
 zonePropellorFile f = f ++ ".serial"
 
-nextZoneFileSerialNumber :: FilePath -> IO SerialNumber
-nextZoneFileSerialNumber = maybe 1 (sSerial . zSOA . incrSerialNumber)
-	<$$> readZonePropellorFile
+oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
+oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
 
 writeZonePropellorFile :: FilePath -> Zone -> IO ()
 writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
@@ -210,3 +200,9 @@ genSOA soa = unlines $
 com :: String -> String
 com s = "; " ++ s
 
+-- | Generates a Zone for a particular Domain from the DNS properies of all
+-- hosts that propellor knows about that are in that Domain.
+genZone :: [Host] -> Domain -> SOA -> Zone
+genZone hosts domain soa = Zone soa zhosts
+  where
+	zhosts = undefined -- TODO
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 026920f..b5cfcff 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -2,7 +2,7 @@ module Propellor.Types.Dns where
 
 import Propellor.Types.OS (HostName)
 
-import Foreign.C.Types
+import Data.Word
 
 type Domain = String
 
@@ -65,7 +65,7 @@ getIPAddr (Address addr) = Just addr
 getIPAddr _ = Nothing
 
 -- | Bind serial numbers are unsigned, 32 bit integers.
-type SerialNumber = CInt
+type SerialNumber = Word32
 
 -- | Domains in the zone file must end with a period if they are absolute.
 --

From c8a3653775892bd361091885c63113b6ca36ed5a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 21:10:44 -0400
Subject: [PATCH 17/34] genZone is working! complete DNS zone file generation
 from propellor config

---
 Propellor/Attr.hs         |  12 ++++-
 Propellor/Property/Dns.hs | 108 +++++++++++++++++++++++++++++++-------
 Propellor/Types/Dns.hs    |  11 ++--
 config-joey.hs            |   4 +-
 4 files changed, 108 insertions(+), 27 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index f3e2e2e..37ed1ba 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -74,11 +74,19 @@ hostProperties (Host ps _) = ps
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l 
 
+hostAttrMap :: [Host] -> M.Map HostName Attr
+hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
+  where
+	attrs = map hostAttr l
+
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
 
-getAddresses :: HostName -> [Host] -> [IPAddr]
-getAddresses hn hosts = case hostAttr <$> findHost hosts hn of
+getAddresses :: Attr -> [IPAddr]
+getAddresses = mapMaybe getIPAddr . S.toList . _dns
+
+hostAddresses :: HostName -> [Host] -> [IPAddr]
+hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
 	Nothing -> []
 	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
 
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index cefbd71..131079e 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -7,15 +7,19 @@ module Propellor.Property.Dns (
 	nextSerialNumber,
 	adjustSerialNumber,
 	serialNumberOffset,
+	genZone,
 ) where
 
 import Propellor
 import Propellor.Types.Dns
 import Propellor.Property.File
+import Propellor.Types.Attr
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
 import Utility.Applicative
 
+import qualified Data.Map as M
+import qualified Data.Set as S
 import Data.List
 
 namedconf :: FilePath
@@ -60,7 +64,7 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 	`requires` Apt.serviceInstalledRunning "bind9"
 	`onChange` Service.reloaded "bind9"
 
--- |  Generates a SOA with some fairly sane numbers in it.
+-- | Generates a SOA with some fairly sane numbers in it.
 --
 -- The SerialNumber can be whatever serial number was used by the domain
 -- before propellor started managing it. Or 0 if the domain has only ever
@@ -113,7 +117,7 @@ nextSerialNumber :: Zone -> SerialNumber -> Zone
 nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
 
 adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
-adjustSerialNumber (Zone soa l) f = Zone soa' l
+adjustSerialNumber (Zone d soa l) f = Zone d soa' l
   where
 	soa' = soa { sSerial = f (sSerial soa) }
 
@@ -141,7 +145,7 @@ writeZoneFile z f = do
 -- the serialized Zone. This saves the bother of parsing
 -- the horrible bind zone file format.
 zonePropellorFile :: FilePath -> FilePath
-zonePropellorFile f = f ++ ".serial"
+zonePropellorFile f = f ++ ".propellor"
 
 oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
 oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
@@ -155,29 +159,29 @@ readZonePropellorFile f = catchDefaultIO Nothing $
 
 -- | Generating a zone file.
 genZoneFile :: Zone -> String
-genZoneFile (Zone soa rs) = unlines $
-	header : genSOA soa : map genr rs
+genZoneFile (Zone zdomain soa rs) = unlines $
+	header : genSOA zdomain soa ++ map genr rs
   where
-	header = com "BIND zone file. Generated by propellor, do not edit."
+	header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
 
-	genr (d, r) = genRecord (Just d, r)
+	genr (d, r) = genRecord zdomain (Just d, r)
 
-genRecord :: (Maybe Domain, Record) -> String
-genRecord (mdomain, record) = intercalate "\t"
-	[ dname
+genRecord :: Domain -> (Maybe BindDomain, Record) -> String
+genRecord zdomain (mdomain, record) = intercalate "\t"
+	[ hn
 	, "IN"
 	, rField record
 	, rValue record
 	]
   where
-	dname = fromMaybe "" mdomain
+	hn = maybe "" (domainHost zdomain) mdomain
 
-genSOA :: SOA -> String
-genSOA soa = unlines $
-	header : map genRecord (zip (repeat Nothing) (sRecord soa))
+genSOA :: Domain -> SOA -> [String]
+genSOA zdomain soa =
+	header ++ map (genRecord zdomain) (zip (repeat Nothing) (sRecord soa))
   where
-	header = unlines
-		-- @ IN SOA root. root (
+	header =
+		-- "@ IN SOA ns1.example.com. root ("
 		[ intercalate "\t"
 			[ dValue SOADomain 
 			, "IN"
@@ -200,9 +204,75 @@ genSOA soa = unlines $
 com :: String -> String
 com s = "; " ++ s
 
+type WarningMessage = String
+
 -- | Generates a Zone for a particular Domain from the DNS properies of all
 -- hosts that propellor knows about that are in that Domain.
-genZone :: [Host] -> Domain -> SOA -> Zone
-genZone hosts domain soa = Zone soa zhosts
+genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
+genZone hosts zdomain soa =
+	let (warnings, zhosts) = partitionEithers $ concat $ map concat
+		[ map hostips inzdomain
+		, map hostrecords inzdomain
+		, map addcnames (M.elems m)
+		]
+	in (Zone zdomain soa (nub zhosts), warnings)
   where
-	zhosts = undefined -- TODO
+	m = hostAttrMap hosts
+	-- Known hosts with hostname located in the zone's domain.
+	inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
+	
+	-- Each host with a hostname located in the zdomain
+	-- should have 1 or more IPAddrs in its Attr.
+	--
+	-- If a host lacks any IPAddr, it's probably a misconfiguration,
+	-- so warn.
+	hostips :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	hostips attr
+		| null l = [Left $ "no IP address defined for host " ++ _hostname attr]
+		| otherwise = map Right l
+	  where
+		l = zip (repeat $ AbsDomain $ _hostname attr)
+			(map Address $ getAddresses attr)
+
+	-- Any host, whether its hostname is in the zdomain or not,
+	-- may have cnames which are in the zdomain.
+	--
+	-- Add Records for those.. But not actually, usually, cnames!
+	-- Why not? Well, using cnames doesn't allow doing some things,
+	-- including MX and round robin DNS. 
+	--
+	-- We typically know the host's IPAddrs anyway.
+	-- So we can just use the IPAddrs.
+	addcnames :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	addcnames attr = concatMap gen $ filter (inDomain zdomain) $
+		mapMaybe getCNAME $ S.toList (_dns attr)
+	  where
+		gen c = case getAddresses attr of
+			[] -> [ret (CNAME c)]
+			l -> map (ret . Address) l
+		  where
+		  	ret record = Right (c, record)
+	
+	-- Adds any other DNS records for a host located in the zdomain.
+	hostrecords :: Attr -> [Either WarningMessage (BindDomain, Record)]
+	hostrecords attr = map Right l
+	  where
+		l = zip (repeat $ AbsDomain $ _hostname attr)
+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
+
+inDomain :: Domain -> BindDomain -> Bool
+inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d
+inDomain _ _ = False -- can't tell, so assume not
+
+-- | Gets the hostname of the second domain, relative to the first domain,
+-- suitable for using in a zone file.
+domainHost :: Domain -> BindDomain -> String
+domainHost _ (RelDomain d) = d
+domainHost _ SOADomain = "@"
+domainHost base (AbsDomain d)
+	| dotbase `isSuffixOf` d = take (length d - length dotbase) d
+	| base == d = "@"
+	| otherwise = d
+  where
+	dotbase = '.':base
+
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index b5cfcff..0474ea9 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -1,7 +1,5 @@
 module Propellor.Types.Dns where
 
-import Propellor.Types.OS (HostName)
-
 import Data.Word
 
 type Domain = String
@@ -28,8 +26,9 @@ data Type = Master | Secondary
 
 -- | Represents a bind 9 zone file.
 data Zone = Zone
-	{ zSOA :: SOA
-	, zHosts :: [(HostName, Record)]
+	{ zDomain :: Domain
+	, zSOA :: SOA
+	, zHosts :: [(BindDomain, Record)]
 	}
 	deriving (Read, Show, Eq)
 
@@ -64,6 +63,10 @@ getIPAddr :: Record -> Maybe IPAddr
 getIPAddr (Address addr) = Just addr
 getIPAddr _ = Nothing
 
+getCNAME :: Record -> Maybe BindDomain
+getCNAME (CNAME d) = Just d
+getCNAME _ = Nothing
+
 -- | Bind serial numbers are unsigned, 32 bit integers.
 type SerialNumber = Word32
 
diff --git a/config-joey.hs b/config-joey.hs
index 8c61c32..289d324 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -241,8 +241,8 @@ myDnsSecondary =
 	, Dns.secondary "branchable.com" branchablemaster
 	]
   where
-	master = getAddresses "wren.kitenet.net" hosts
-	branchablemaster = getAddresses "pell.branchable.com" hosts
+	master = hostAddresses "wren.kitenet.net" hosts
+	branchablemaster = hostAddresses "pell.branchable.com" hosts
 
 main :: IO ()
 main = defaultMain hosts

From 395d3f206af48dcac5980fc70f7189a77e43fcc8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 21:58:23 -0400
Subject: [PATCH 18/34] Dns.primary wrote, not quite ready

---
 Propellor/Attr.hs         |  1 -
 Propellor/Property/Dns.hs | 37 ++++++++++++++++++++++++++++++++-----
 Propellor/Types.hs        |  2 ++
 config-joey.hs            | 18 ++++++++++++++++--
 4 files changed, 50 insertions(+), 8 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 37ed1ba..a4d7a95 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -4,7 +4,6 @@ module Propellor.Attr where
 
 import Propellor.Types
 import Propellor.Types.Attr
-import Propellor.Types.Dns
 
 import "mtl" Control.Monad.Reader
 import qualified Data.Set as S
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 131079e..a9a8619 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -1,8 +1,10 @@
 module Propellor.Property.Dns (
 	module Propellor.Types.Dns,
+	primary,
 	secondary,
 	servingZones,
 	mkSOA,
+	rootAddressesFrom,
 	writeZoneFile,
 	nextSerialNumber,
 	adjustSerialNumber,
@@ -22,6 +24,23 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.List
 
+-- | Primary dns server for a domain.
+--
+-- TODO: Does not yet add it to named.conf.local.
+primary :: [Host] -> Domain -> SOA -> Property
+primary hosts domain soa = withwarnings (check needupdate baseprop)
+	`requires` Apt.serviceInstalledRunning "bind9"
+	`onChange` Service.reloaded "bind9"
+  where
+	(zone, warnings) = genZone hosts domain soa
+	zonefile = "/etc/bind/propellor/db." ++ domain
+	needupdate = (/= Just zone) <$> readZonePropellorFile zonefile
+	baseprop = property ("dns primary for " ++ domain) $ makeChange $ do
+		writeZoneFile zone zonefile
+	withwarnings p = adjustProperty p $ \satisfy -> do
+		mapM_ warningMessage warnings
+		satisfy
+
 namedconf :: FilePath
 namedconf = "/etc/bind/named.conf.local"
 
@@ -56,7 +75,7 @@ confStanza c =
 		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
 		[ "\t};" ]
 
--- | Rewrites the whole named.conf.local file to serve the specificed
+-- | Rewrites the whole named.conf.local file to serve the specified
 -- zones.
 servingZones :: [NamedConf] -> Property
 servingZones zs = hasContent namedconf (concatMap confStanza zs)
@@ -66,6 +85,10 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 
 -- | Generates a SOA with some fairly sane numbers in it.
 --
+-- The Domain is the domain to use in the SOA record. Typically
+-- something like ns1.example.com. Not the domain that this is the SOA
+-- record for.
+--
 -- The SerialNumber can be whatever serial number was used by the domain
 -- before propellor started managing it. Or 0 if the domain has only ever
 -- been managed by propellor.
@@ -73,19 +96,22 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 -- You do not need to increment the SerialNumber when making changes!
 -- Propellor will automatically add the number of commits in the git
 -- repository to the SerialNumber.
-mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
-mkSOA d sn rs = SOA
+mkSOA :: Domain -> SerialNumber -> [Record] -> [Record] -> SOA
+mkSOA d sn rs1 rs2 = SOA
 	{ sDomain = AbsDomain d
 	, sSerial = sn
 	, sRefresh = hours 4
 	, sRetry = hours 1
 	, sExpire = 2419200 -- 4 weeks
 	, sTTL = hours 8
-	, sRecord = rs
+	, sRecord = rs1 ++ rs2
 	}
   where
 	hours n = n * 60 * 60
 
+rootAddressesFrom :: [Host] -> HostName -> [Record]
+rootAddressesFrom hosts hn = map Address (hostAddresses hn hosts)
+
 dValue :: BindDomain -> String
 dValue (RelDomain d) = d
 dValue (AbsDomain d) = d ++ "."
@@ -137,7 +163,8 @@ writeZoneFile z f = do
 	offset <- serialNumberOffset
 	let z' = nextSerialNumber
 		(adjustSerialNumber z (+ offset))
-		(succ oldserial)
+		oldserial
+	createDirectoryIfMissing True (takeDirectory f)
 	writeFile f (genZoneFile z')
 	writeZonePropellorFile f z'
 
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index ad822a8..0e412e8 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -21,6 +21,7 @@ module Propellor.Types
 	, GpgKeyId
 	, SshKeyType(..)
 	, module Propellor.Types.OS
+	, module Propellor.Types.Dns
 	) where
 
 import Data.Monoid
@@ -31,6 +32,7 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
 
 import Propellor.Types.Attr
 import Propellor.Types.OS
+import Propellor.Types.Dns
 
 data Host = Host [Property] SetAttr
 
diff --git a/config-joey.hs b/config-joey.hs
index 289d324..e4eed9f 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -39,6 +39,16 @@ hosts =               --                  (o)  `
 	, standardSystem "clam.kitenet.net" Unstable "amd64"
 		& ipv4 "162.248.143.249"
 		& ipv6 "2002:5044:5531::1"
+		
+		& Dns.primary hosts "olduse.net" $
+			Dns.mkSOA "ns1.kitenet.net" 100
+				(Dns.rootAddressesFrom hosts "branchable.com")
+				[ NS "ns1.kitenet.net"
+				, NS "ns6.gandi.net"
+				, NS "ns2.kitenet.net"
+				, MX 0 "kitenet.net"
+				, TXT "v=spf1 a -all"
+				] 
 
 		& cleanCloudAtCost
 		& Apt.unattendedUpgrades
@@ -242,7 +252,7 @@ myDnsSecondary =
 	]
   where
 	master = hostAddresses "wren.kitenet.net" hosts
-	branchablemaster = hostAddresses "pell.branchable.com" hosts
+	branchablemaster = hostAddresses "branchable.com" hosts
 
 main :: IO ()
 main = defaultMain hosts
@@ -274,7 +284,11 @@ monsters =	      -- but do want to track their public keys etc.
 		& ipv4 "80.68.85.49"
 		& ipv6 "2001:41c8:125:49::10"
 		& cname "kite.kitenet.net"
-	, host "pell.branchable.com"
+	, host "branchable.com"
 		& ipv4 "66.228.46.55"
 		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
+		& cname "www.olduse.net"
+		& cname "git.olduse.net"
+	, host "virgil.koldfront.dk"
+		& cname "article.olduse.net"
 	]

From 293aa8aad5e31330ba71dfdf1e256d7356db6745 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 22:00:45 -0400
Subject: [PATCH 19/34] fix

---
 config-joey.hs | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/config-joey.hs b/config-joey.hs
index e4eed9f..232e87c 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -40,15 +40,16 @@ hosts =               --                  (o)  `
 		& ipv4 "162.248.143.249"
 		& ipv6 "2002:5044:5531::1"
 		
-		& Dns.primary hosts "olduse.net" $
-			Dns.mkSOA "ns1.kitenet.net" 100
-				(Dns.rootAddressesFrom hosts "branchable.com")
-				[ NS "ns1.kitenet.net"
-				, NS "ns6.gandi.net"
-				, NS "ns2.kitenet.net"
-				, MX 0 "kitenet.net"
+		& Dns.primary hosts "olduse.net"
+			( Dns.mkSOA "ns1.kitenet.net" 100
+				( Dns.rootAddressesFrom hosts "branchable.com" )
+				[ NS (AbsDomain "ns1.kitenet.net")
+				, NS (AbsDomain "ns6.gandi.net")
+				, NS (AbsDomain "ns2.kitenet.net")
+				, MX 0 (AbsDomain "kitenet.net")
 				, TXT "v=spf1 a -all"
-				] 
+				]
+			)
 
 		& cleanCloudAtCost
 		& Apt.unattendedUpgrades

From b338c0a3bba52849ff163803a8c748bfbc9e7c00 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 22:57:51 -0400
Subject: [PATCH 20/34] rename TTL field, per RFC 2308

---
 Propellor/Property/Dns.hs | 22 ++++++++++++++--------
 Propellor/Types/Dns.hs    |  2 +-
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index a9a8619..4b51eeb 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -86,7 +86,7 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 -- | Generates a SOA with some fairly sane numbers in it.
 --
 -- The Domain is the domain to use in the SOA record. Typically
--- something like ns1.example.com. Not the domain that this is the SOA
+-- something like ns1.example.com. So, not the domain that this is the SOA
 -- record for.
 --
 -- The SerialNumber can be whatever serial number was used by the domain
@@ -96,15 +96,18 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 -- You do not need to increment the SerialNumber when making changes!
 -- Propellor will automatically add the number of commits in the git
 -- repository to the SerialNumber.
-mkSOA :: Domain -> SerialNumber -> [Record] -> [Record] -> SOA
-mkSOA d sn rs1 rs2 = SOA
+--
+-- Handy trick: You don't need to list IPAddrs in the [Record],
+-- just make some Host sets its cname to the root of domain.
+mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
+mkSOA d sn rs = SOA
 	{ sDomain = AbsDomain d
 	, sSerial = sn
 	, sRefresh = hours 4
 	, sRetry = hours 1
 	, sExpire = 2419200 -- 4 weeks
-	, sTTL = hours 8
-	, sRecord = rs1 ++ rs2
+	, sNegativeCacheTTL = hours 8
+	, sRecord = rs
 	}
   where
 	hours n = n * 60 * 60
@@ -221,7 +224,7 @@ genSOA zdomain soa =
 		, headerline sRefresh "Refresh"
 		, headerline sRetry "Retry"
 		, headerline sExpire "Expire"
-		, headerline sTTL "Default TTL"
+		, headerline sNegativeCacheTTL "Negative Cache TTL"
 		, inheader ")"
 		]
 	headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment
@@ -262,11 +265,14 @@ genZone hosts zdomain soa =
 			(map Address $ getAddresses attr)
 
 	-- Any host, whether its hostname is in the zdomain or not,
-	-- may have cnames which are in the zdomain.
+	-- may have cnames which are in the zdomain. The cname may even be
+	-- the same as the root of the zdomain, which is a nice way to
+	-- specify IP addresses for a SOA record.
 	--
 	-- Add Records for those.. But not actually, usually, cnames!
 	-- Why not? Well, using cnames doesn't allow doing some things,
-	-- including MX and round robin DNS. 
+	-- including MX and round robin DNS, and certianly CNAMES
+	-- shouldn't be used in SOA records.
 	--
 	-- We typically know the host's IPAddrs anyway.
 	-- So we can just use the IPAddrs.
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 0474ea9..3bdd6c3 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -42,7 +42,7 @@ data SOA = SOA
 	, sRefresh :: Integer
 	, sRetry :: Integer
 	, sExpire :: Integer
-	, sTTL :: Integer
+	, sNegativeCacheTTL :: Integer
 	, sRecord :: [Record]
 	-- ^ Records for the root of the domain. Typically NS, A, TXT
 	}

From 8dcd8fb0bda98eb2bdf34ad8d9c6590c2e8a76e5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 23:20:07 -0400
Subject: [PATCH 21/34] provide a way to specify real cnames

---
 Propellor/Property/Dns.hs | 20 +++++++++++++++++---
 config-joey.hs            | 26 +++++++++++++-------------
 2 files changed, 30 insertions(+), 16 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 4b51eeb..e4dfb19 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -27,12 +27,26 @@ import Data.List
 -- | Primary dns server for a domain.
 --
 -- TODO: Does not yet add it to named.conf.local.
-primary :: [Host] -> Domain -> SOA -> Property
-primary hosts domain soa = withwarnings (check needupdate baseprop)
+--
+-- Most of the content of the zone file is configured by setting properties
+-- of hosts. For example,
+--
+-- > host "foo.example.com"
+-- >   & ipv4 "192.168.1.1"
+-- >   & cname "mail.exmaple.com"
+--
+-- Will cause that host and its cnames to appear in the zone file.
+--
+-- The [(Domain, Record)] list can be used for additional records
+-- that cannot be configured elsewhere. For example, it might contain
+-- CNAMEs pointing at hosts that propellor does not control.
+primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
+primary hosts domain soa rs = withwarnings (check needupdate baseprop)
 	`requires` Apt.serviceInstalledRunning "bind9"
 	`onChange` Service.reloaded "bind9"
   where
-	(zone, warnings) = genZone hosts domain soa
+	(partialzone, warnings) = genZone hosts domain soa
+	zone = partialzone { zHosts = zHosts partialzone ++ rs }
 	zonefile = "/etc/bind/propellor/db." ++ domain
 	needupdate = (/= Just zone) <$> readZonePropellorFile zonefile
 	baseprop = property ("dns primary for " ++ domain) $ makeChange $ do
diff --git a/config-joey.hs b/config-joey.hs
index 232e87c..4063aa3 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -32,6 +32,7 @@ hosts :: [Host]        --   *             \ | |              '--------'
 hosts =               --                  (o)  `
 	-- My laptop
 	[ host "darkstar.kitenet.net"
+		& ipv6 "2001:4830:1600:187::2" -- sixxs tunnel
 		& Docker.configured
 		& Apt.buildDep ["git-annex"] `period` Daily
 
@@ -39,17 +40,6 @@ hosts =               --                  (o)  `
 	, standardSystem "clam.kitenet.net" Unstable "amd64"
 		& ipv4 "162.248.143.249"
 		& ipv6 "2002:5044:5531::1"
-		
-		& Dns.primary hosts "olduse.net"
-			( Dns.mkSOA "ns1.kitenet.net" 100
-				( Dns.rootAddressesFrom hosts "branchable.com" )
-				[ NS (AbsDomain "ns1.kitenet.net")
-				, NS (AbsDomain "ns6.gandi.net")
-				, NS (AbsDomain "ns2.kitenet.net")
-				, MX 0 (AbsDomain "kitenet.net")
-				, TXT "v=spf1 a -all"
-				]
-			)
 
 		& cleanCloudAtCost
 		& Apt.unattendedUpgrades
@@ -74,6 +64,17 @@ hosts =               --                  (o)  `
 
 		& Docker.garbageCollected `period` Daily
 		& Apt.installed ["git-annex", "mtr", "screen"]
+		
+		& Dns.primary hosts "olduse.net"
+			( Dns.mkSOA "ns1.kitenet.net" 100
+				[ NS (AbsDomain "ns1.kitenet.net")
+				, NS (AbsDomain "ns6.gandi.net")
+				, NS (AbsDomain "ns2.kitenet.net")
+				, MX 0 (AbsDomain "kitenet.net")
+				, TXT "v=spf1 a -all"
+				]
+			)
+			[ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ]
 	
 	-- Orca is the main git-annex build box.
 	, standardSystem "orca.kitenet.net" Unstable "amd64"
@@ -288,8 +289,7 @@ monsters =	      -- but do want to track their public keys etc.
 	, host "branchable.com"
 		& ipv4 "66.228.46.55"
 		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
+		& cname "olduse.net"
 		& cname "www.olduse.net"
 		& cname "git.olduse.net"
-	, host "virgil.koldfront.dk"
-		& cname "article.olduse.net"
 	]

From 21bb63ab58fe4fde0bc9ff15e1e98dcacc2f845b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 23:29:01 -0400
Subject: [PATCH 22/34] add SOA

---
 Propellor/Property/Dns.hs | 7 +++++++
 Propellor/Types/Dns.hs    | 1 +
 2 files changed, 8 insertions(+)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index e4dfb19..7abeb55 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -141,6 +141,7 @@ rField (CNAME _) = "CNAME"
 rField (MX _ _) = "MX"
 rField (NS _) = "NS"
 rField (TXT _) = "TXT"
+rField (SRV _ _ _ _) = "SRV"
 
 rValue :: Record -> String
 rValue (Address (IPv4 addr)) = addr
@@ -148,6 +149,12 @@ rValue (Address (IPv6 addr)) = addr
 rValue (CNAME d) = dValue d
 rValue (MX pri d) = show pri ++ " " ++ dValue d
 rValue (NS d) = dValue d
+rValue (SRV priority weight port target) = unwords
+	[ show priority
+	, show weight
+	, show port
+	, dValue target
+	]
 rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
   where
 	q = '"'
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 3bdd6c3..9d801ef 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -57,6 +57,7 @@ data Record
 	| MX Int BindDomain
 	| NS BindDomain
 	| TXT String
+	| SRV Word16 Word16 Word16 BindDomain
 	deriving (Read, Show, Eq, Ord)
 
 getIPAddr :: Record -> Maybe IPAddr

From 7e9853520b5b7233ce9a9c8153f6c366cab0ee39 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 18 Apr 2014 23:41:26 -0400
Subject: [PATCH 23/34] The `cname` property was renamed to `aka` as it does
 not always generate CNAME in the DNS.

---
 Propellor/Attr.hs         | 11 +++--------
 Propellor/Property/Dns.hs |  4 ++--
 TODO                      |  2 +-
 config-joey.hs            | 26 +++++++++++++-------------
 debian/changelog          |  2 ++
 5 files changed, 21 insertions(+), 24 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index a4d7a95..8c4a2ad 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -41,16 +41,11 @@ ipv6 :: String -> Property
 ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
 	(addDNS $ Address $ IPv6 addr)
 
--- | Indicate that a host has a CNAME pointing at it in the DNS.
-cname :: Domain -> Property
-cname domain = pureAttrProperty ("cname " ++ domain)
+-- | Indicates another name for the host in the DNS.
+aka :: Domain -> Property
+aka domain = pureAttrProperty ("aka " ++ domain)
 	(addDNS $ CNAME $ AbsDomain domain)
 
-cnameFor :: Domain -> (Domain -> Property) -> Property
-cnameFor domain mkp =
-	let p = mkp domain
-	in p { propertyAttr = propertyAttr p . addDNS (CNAME $ AbsDomain domain) }
-
 addDNS :: Record -> SetAttr
 addDNS record d = d { _dns = S.insert record (_dns d) }
 
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 7abeb55..7c26f1d 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -33,7 +33,7 @@ import Data.List
 --
 -- > host "foo.example.com"
 -- >   & ipv4 "192.168.1.1"
--- >   & cname "mail.exmaple.com"
+-- >   & aka "mail.exmaple.com"
 --
 -- Will cause that host and its cnames to appear in the zone file.
 --
@@ -112,7 +112,7 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
 -- repository to the SerialNumber.
 --
 -- Handy trick: You don't need to list IPAddrs in the [Record],
--- just make some Host sets its cname to the root of domain.
+-- just make some Host sets its `aka` to the root of domain.
 mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
 mkSOA d sn rs = SOA
 	{ sDomain = AbsDomain d
diff --git a/TODO b/TODO
index 7a1e1df..85875a9 100644
--- a/TODO
+++ b/TODO
@@ -23,4 +23,4 @@
   PrivData..), or the public key should not be stored in
   the PrivData, and instead configured using the attr.
   Getting the ssh host key into the attr will allow automatically
-  exporting it via DNS.
+  exporting it via DNS (SSHFP record)
diff --git a/config-joey.hs b/config-joey.hs
index 4063aa3..eae3a15 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -48,18 +48,18 @@ hosts =               --                  (o)  `
 		& Postfix.satellite
 		& Docker.configured
 
-		& cname "shell.olduse.net"
+		& aka "shell.olduse.net"
 		& JoeySites.oldUseNetShellBox
 
-		& cname "openid.kitenet.net"
+		& aka "openid.kitenet.net"
 		& Docker.docked hosts "openid-provider"
 		 	`requires` Apt.installed ["ntp"]
 
-		& cname "ancient.kitenet.net"
+		& aka "ancient.kitenet.net"
 		& Docker.docked hosts "ancient-kitenet"
 
 		-- I'd rather this were on diatom, but it needs unstable.
-		& cname "kgb.kitenet.net"
+		& aka "kgb.kitenet.net"
 		& JoeySites.kgbServer
 
 		& Docker.garbageCollected `period` Daily
@@ -112,25 +112,25 @@ hosts =               --                  (o)  `
 		& Apache.multiSSL
 		& File.ownerGroup "/srv/web" "joey" "joey"
 
-		& cname "git.kitenet.net"
-		& cname "git.joeyh.name"
+		& aka "git.kitenet.net"
+		& aka "git.joeyh.name"
 		& JoeySites.gitServer hosts
 	
-		& cname "downloads.kitenet.net"
+		& aka "downloads.kitenet.net"
 		& JoeySites.annexWebSite hosts "/srv/git/downloads.git"
 			"downloads.kitenet.net"
 			"840760dc-08f0-11e2-8c61-576b7e66acfd"
 			[("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")]
 		& JoeySites.annexRsyncServer
 
-		& cname "tmp.kitenet.net"
+		& aka "tmp.kitenet.net"
 		& JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git"
 			"tmp.kitenet.net"
 			"26fd6e38-1226-11e2-a75f-ff007033bdba"
 			[]
 		& JoeySites.twitRss
 		
-		& cname "nntp.olduse.net"
+		& aka "nntp.olduse.net"
 		& JoeySites.oldUseNetServer hosts
 		
 		& Apt.installed ["ntop"]
@@ -285,11 +285,11 @@ monsters =	      -- but do want to track their public keys etc.
 	, host "wren.kitenet.net"
 		& ipv4 "80.68.85.49"
 		& ipv6 "2001:41c8:125:49::10"
-		& cname "kite.kitenet.net"
+		& aka "kite.kitenet.net"
 	, host "branchable.com"
 		& ipv4 "66.228.46.55"
 		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
-		& cname "olduse.net"
-		& cname "www.olduse.net"
-		& cname "git.olduse.net"
+		& aka "olduse.net"
+		& aka "www.olduse.net"
+		& aka "git.olduse.net"
 	]
diff --git a/debian/changelog b/debian/changelog
index ee7df1e..2442dd1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,6 +5,8 @@ propellor (0.4.0) UNRELEASED; urgency=medium
     So Attr settings can be made inside a propertyList, for example.
   * Run all cron jobs under chronic from moreutils to avoid unnecessary
     mails.
+  * The `cname` property was renamed to `aka` as it does not always generate
+    CNAME in the DNS.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400
 

From d1db64b3bc4ef1c802344f666eb160d9a8c97cca Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 01:26:38 -0400
Subject: [PATCH 24/34] Propellor can configure primary DNS servers, including
 generating zone files, which is done by looking at the properties of hosts in
 a domain.

---
 Propellor/Attr.hs         |  6 +++
 Propellor/Property/Dns.hs | 78 +++++++++++++++++++++++++--------------
 Propellor/Types/Attr.hs   |  9 +++--
 Propellor/Types/Dns.hs    |  4 +-
 config-joey.hs            | 42 ++++++++++-----------
 debian/changelog          |  9 +++--
 6 files changed, 91 insertions(+), 57 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 8c4a2ad..a54d883 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -49,6 +49,12 @@ aka domain = pureAttrProperty ("aka " ++ domain)
 addDNS :: Record -> SetAttr
 addDNS record d = d { _dns = S.insert record (_dns d) }
 
+addNamedConf :: NamedConf -> SetAttr
+addNamedConf conf d = d { _namedconf = S.insert conf (_namedconf d) }
+
+getNamedConf :: Propellor (S.Set NamedConf)
+getNamedConf = asks _namedconf
+
 sshPubKey :: String -> Property
 sshPubKey k = pureAttrProperty ("ssh pubkey known") $
 	\d -> d { _sshPubKey = Just k }
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 7c26f1d..90556d2 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -2,7 +2,6 @@ module Propellor.Property.Dns (
 	module Propellor.Types.Dns,
 	primary,
 	secondary,
-	servingZones,
 	mkSOA,
 	rootAddressesFrom,
 	writeZoneFile,
@@ -26,8 +25,6 @@ import Data.List
 
 -- | Primary dns server for a domain.
 --
--- TODO: Does not yet add it to named.conf.local.
---
 -- Most of the content of the zone file is configured by setting properties
 -- of hosts. For example,
 --
@@ -35,40 +32,70 @@ import Data.List
 -- >   & ipv4 "192.168.1.1"
 -- >   & aka "mail.exmaple.com"
 --
--- Will cause that host and its cnames to appear in the zone file.
+-- Will cause that hostmame and its alias to appear in the zone file,
+-- with the configured IP address.
 --
 -- The [(Domain, Record)] list can be used for additional records
 -- that cannot be configured elsewhere. For example, it might contain
 -- CNAMEs pointing at hosts that propellor does not control.
 primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
 primary hosts domain soa rs = withwarnings (check needupdate baseprop)
-	`requires` Apt.serviceInstalledRunning "bind9"
+	`requires` servingZones
 	`onChange` Service.reloaded "bind9"
   where
 	(partialzone, warnings) = genZone hosts domain soa
 	zone = partialzone { zHosts = zHosts partialzone ++ rs }
 	zonefile = "/etc/bind/propellor/db." ++ domain
-	needupdate = (/= Just zone) <$> readZonePropellorFile zonefile
-	baseprop = property ("dns primary for " ++ domain) $ makeChange $ do
-		writeZoneFile zone zonefile
+	baseprop = Property ("dns primary for " ++ domain)
+		(makeChange $ writeZoneFile zone zonefile)
+		(addNamedConf conf)
 	withwarnings p = adjustProperty p $ \satisfy -> do
 		mapM_ warningMessage warnings
 		satisfy
+	conf = NamedConf
+		{ confDomain = domain
+		, confType = Master
+		, confFile = zonefile
+		, confMasters = []
+		, confLines = []
+		}
+	needupdate = do
+		v <- readZonePropellorFile zonefile
+		return $ case v of
+			Nothing -> True
+			Just oldzone ->
+				-- compare everything except serial
+				let oldserial = sSerial (zSOA oldzone)
+				    z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
+				in z /= oldzone || oldserial < sSerial (zSOA zone)
 
-namedconf :: FilePath
-namedconf = "/etc/bind/named.conf.local"
+-- | Secondary dns server for a domain.
+secondary :: [Host] -> Domain -> HostName -> Property
+secondary hosts domain master = pureAttrProperty desc (addNamedConf conf)
+	`requires` servingZones
+  where
+ 	desc = "dns secondary for " ++ domain
+	conf = NamedConf
+		{ confDomain = domain
+		, confType = Secondary
+		, confFile = "db." ++ domain
+		, confMasters = hostAddresses master hosts
+		, confLines = ["allow-transfer { }"]
+		}
 
-zoneDesc :: NamedConf -> String
-zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")"
-
-secondary :: Domain -> [IPAddr] -> NamedConf
-secondary domain masters = NamedConf
-	{ confDomain = domain
-	, confType = Secondary
-	, confFile = "db." ++ domain
-	, confMasters = masters
-	, confLines = ["allow-transfer { }"]
-	}
+-- | Rewrites the whole named.conf.local file to serve the zones
+-- configured by `primary` and `secondary`, and ensures that bind9 is
+-- running.
+servingZones :: Property
+servingZones = property "serving configured dns zones" go
+	`requires` Apt.serviceInstalledRunning "bind9"
+	`onChange` Service.reloaded "bind9"
+  where
+	go = do
+		zs <- getNamedConf
+		ensureProperty $
+			hasContent namedConfFile $
+				concatMap confStanza $ S.toList zs
 
 confStanza :: NamedConf -> [Line]
 confStanza c =
@@ -89,13 +116,8 @@ confStanza c =
 		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
 		[ "\t};" ]
 
--- | Rewrites the whole named.conf.local file to serve the specified
--- zones.
-servingZones :: [NamedConf] -> Property
-servingZones zs = hasContent namedconf (concatMap confStanza zs)
-	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
-	`requires` Apt.serviceInstalledRunning "bind9"
-	`onChange` Service.reloaded "bind9"
+namedConfFile :: FilePath
+namedConfFile = "/etc/bind/named.conf.local"
 
 -- | Generates a SOA with some fairly sane numbers in it.
 --
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index cf8bdf1..f64b048 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -9,8 +9,9 @@ import qualified Data.Set as S
 data Attr = Attr
 	{ _hostname :: HostName
 	, _os :: Maybe System
-	, _dns :: S.Set Dns.Record
 	, _sshPubKey :: Maybe String
+	, _dns :: S.Set Dns.Record
+	, _namedconf :: S.Set Dns.NamedConf
 
 	, _dockerImage :: Maybe String
 	, _dockerRunParams :: [HostName -> String]
@@ -21,6 +22,7 @@ instance Eq Attr where
 		[ _hostname x == _hostname y
 		, _os x == _os y
 		, _dns x == _dns y
+		, _namedconf x == _namedconf y
 		, _sshPubKey x == _sshPubKey y
 
 		, _dockerImage x == _dockerImage y
@@ -32,13 +34,14 @@ instance Show Attr where
 	show a = unlines
 		[ "hostname " ++ _hostname a
 		, "OS " ++ show (_os a)
-		, "dns " ++ show (_dns a)
 		, "sshPubKey " ++ show (_sshPubKey a)
+		, "dns " ++ show (_dns a)
+		, "namedconf " ++ show (_namedconf a)
 		, "docker image " ++ show (_dockerImage a)
 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
 		]
 
 newAttr :: HostName -> Attr
-newAttr hn = Attr hn Nothing S.empty Nothing Nothing []
+newAttr hn = Attr hn Nothing Nothing S.empty S.empty Nothing []
 
 type SetAttr = Attr -> Attr
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 9d801ef..e367202 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -19,10 +19,10 @@ data NamedConf = NamedConf
 	, confMasters :: [IPAddr]
 	, confLines :: [String]
 	}
-	deriving (Show, Eq)
+	deriving (Show, Eq, Ord)
 
 data Type = Master | Secondary
-	deriving (Show, Eq)
+	deriving (Show, Eq, Ord)
 
 -- | Represents a bind 9 zone file.
 data Zone = Zone
diff --git a/config-joey.hs b/config-joey.hs
index eae3a15..e49a062 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -64,17 +64,6 @@ hosts =               --                  (o)  `
 
 		& Docker.garbageCollected `period` Daily
 		& Apt.installed ["git-annex", "mtr", "screen"]
-		
-		& Dns.primary hosts "olduse.net"
-			( Dns.mkSOA "ns1.kitenet.net" 100
-				[ NS (AbsDomain "ns1.kitenet.net")
-				, NS (AbsDomain "ns6.gandi.net")
-				, NS (AbsDomain "ns2.kitenet.net")
-				, MX 0 (AbsDomain "kitenet.net")
-				, TXT "v=spf1 a -all"
-				]
-			)
-			[ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ]
 	
 	-- Orca is the main git-annex build box.
 	, standardSystem "orca.kitenet.net" Unstable "amd64"
@@ -101,7 +90,7 @@ hosts =               --                  (o)  `
 		& Ssh.hostKey SshEcdsa
 		& Apt.unattendedUpgrades
 		& Apt.serviceInstalledRunning "ntp"
-		& Dns.servingZones myDnsSecondary
+		& myDnsSecondary
 		& Postfix.satellite
 	
 		& Apt.serviceInstalledRunning "apache2"
@@ -133,6 +122,17 @@ hosts =               --                  (o)  `
 		& aka "nntp.olduse.net"
 		& JoeySites.oldUseNetServer hosts
 		
+		& Dns.primary hosts "olduse.net"
+			( Dns.mkSOA "ns1.kitenet.net" 100
+				[ NS (AbsDomain "ns1.kitenet.net")
+				, NS (AbsDomain "ns6.gandi.net")
+				, NS (AbsDomain "ns2.kitenet.net")
+				, MX 0 (AbsDomain "kitenet.net")
+				, TXT "v=spf1 a -all"
+				]
+			)
+			[ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ]
+
 		& Apt.installed ["ntop"]
 
 
@@ -244,17 +244,17 @@ cleanCloudAtCost = propertyList "cloudatcost cleanup"
 		]
 	]
 
-myDnsSecondary :: [Dns.NamedConf]
-myDnsSecondary =
-	[ Dns.secondary "kitenet.net" master
-	, Dns.secondary "joeyh.name" master
-	, Dns.secondary "ikiwiki.info" master
-	, Dns.secondary "olduse.net" master
-	, Dns.secondary "branchable.com" branchablemaster
+myDnsSecondary :: Property
+myDnsSecondary = propertyList "dns secondary for all my domains"
+	[ Dns.secondary hosts "kitenet.net" master
+	, Dns.secondary hosts "joeyh.name" master
+	, Dns.secondary hosts "ikiwiki.info" master
+	, Dns.secondary hosts "olduse.net" master
+	, Dns.secondary hosts "branchable.com" branchablemaster
 	]
   where
-	master = hostAddresses "wren.kitenet.net" hosts
-	branchablemaster = hostAddresses "branchable.com" hosts
+	master = "wren.kitenet.net"
+	branchablemaster = "branchable.com"
 
 main :: IO ()
 main = defaultMain hosts
diff --git a/debian/changelog b/debian/changelog
index 2442dd1..463b181 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,12 +1,15 @@
 propellor (0.4.0) UNRELEASED; urgency=medium
 
-  * Constructor of Property has changed (use property function instead).
+  * Propellor can configure primary DNS servers, including generating
+    zone files, which is done by looking at the properties of hosts
+    in a domain.
+  * The `cname` property was renamed to `aka` as it does not always generate
+    CNAME in the DNS.
+  * Constructor of Property has changed (use `property` function instead).
   * All Property combinators now combine together their Attr settings.
     So Attr settings can be made inside a propertyList, for example.
   * Run all cron jobs under chronic from moreutils to avoid unnecessary
     mails.
-  * The `cname` property was renamed to `aka` as it does not always generate
-    CNAME in the DNS.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400
 

From 9e578aca6b0914443c95f8691fd3ba39522f28fc Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 01:28:46 -0400
Subject: [PATCH 25/34] rename aka to alias

---
 Propellor/Attr.hs            |  4 ++--
 Propellor/Property/Dns.hs    |  4 ++--
 Propellor/Property/Docker.hs |  4 ++--
 config-joey.hs               | 26 +++++++++++++-------------
 debian/changelog             |  4 ++--
 5 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index a54d883..fb94dc3 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -42,8 +42,8 @@ ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
 	(addDNS $ Address $ IPv6 addr)
 
 -- | Indicates another name for the host in the DNS.
-aka :: Domain -> Property
-aka domain = pureAttrProperty ("aka " ++ domain)
+alias :: Domain -> Property
+alias domain = pureAttrProperty ("aka " ++ domain)
 	(addDNS $ CNAME $ AbsDomain domain)
 
 addDNS :: Record -> SetAttr
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 90556d2..e47d6c3 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -30,7 +30,7 @@ import Data.List
 --
 -- > host "foo.example.com"
 -- >   & ipv4 "192.168.1.1"
--- >   & aka "mail.exmaple.com"
+-- >   & alias "mail.exmaple.com"
 --
 -- Will cause that hostmame and its alias to appear in the zone file,
 -- with the configured IP address.
@@ -134,7 +134,7 @@ namedConfFile = "/etc/bind/named.conf.local"
 -- repository to the SerialNumber.
 --
 -- Handy trick: You don't need to list IPAddrs in the [Record],
--- just make some Host sets its `aka` to the root of domain.
+-- just make some Host sets its `alias` to the root of domain.
 mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
 mkSOA d sn rs = SOA
 	{ sDomain = AbsDomain d
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index e05a8dd..e5b8d64 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -183,8 +183,8 @@ memory = runProp "memory"
 
 -- | Link with another container on the same host.
 link :: ContainerName -> ContainerAlias -> Property
-link linkwith alias = genProp "link" $ \hn ->
-	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
+link linkwith calias = genProp "link" $ \hn ->
+	fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
 
 -- | A short alias for a linked container.
 -- Each container has its own alias namespace.
diff --git a/config-joey.hs b/config-joey.hs
index e49a062..b22f0e0 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -48,18 +48,18 @@ hosts =               --                  (o)  `
 		& Postfix.satellite
 		& Docker.configured
 
-		& aka "shell.olduse.net"
+		& alias "shell.olduse.net"
 		& JoeySites.oldUseNetShellBox
 
-		& aka "openid.kitenet.net"
+		& alias "openid.kitenet.net"
 		& Docker.docked hosts "openid-provider"
 		 	`requires` Apt.installed ["ntp"]
 
-		& aka "ancient.kitenet.net"
+		& alias "ancient.kitenet.net"
 		& Docker.docked hosts "ancient-kitenet"
 
 		-- I'd rather this were on diatom, but it needs unstable.
-		& aka "kgb.kitenet.net"
+		& alias "kgb.kitenet.net"
 		& JoeySites.kgbServer
 
 		& Docker.garbageCollected `period` Daily
@@ -101,25 +101,25 @@ hosts =               --                  (o)  `
 		& Apache.multiSSL
 		& File.ownerGroup "/srv/web" "joey" "joey"
 
-		& aka "git.kitenet.net"
-		& aka "git.joeyh.name"
+		& alias "git.kitenet.net"
+		& alias "git.joeyh.name"
 		& JoeySites.gitServer hosts
 	
-		& aka "downloads.kitenet.net"
+		& alias "downloads.kitenet.net"
 		& JoeySites.annexWebSite hosts "/srv/git/downloads.git"
 			"downloads.kitenet.net"
 			"840760dc-08f0-11e2-8c61-576b7e66acfd"
 			[("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")]
 		& JoeySites.annexRsyncServer
 
-		& aka "tmp.kitenet.net"
+		& alias "tmp.kitenet.net"
 		& JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git"
 			"tmp.kitenet.net"
 			"26fd6e38-1226-11e2-a75f-ff007033bdba"
 			[]
 		& JoeySites.twitRss
 		
-		& aka "nntp.olduse.net"
+		& alias "nntp.olduse.net"
 		& JoeySites.oldUseNetServer hosts
 		
 		& Dns.primary hosts "olduse.net"
@@ -285,11 +285,11 @@ monsters =	      -- but do want to track their public keys etc.
 	, host "wren.kitenet.net"
 		& ipv4 "80.68.85.49"
 		& ipv6 "2001:41c8:125:49::10"
-		& aka "kite.kitenet.net"
+		& alias "kite.kitenet.net"
 	, host "branchable.com"
 		& ipv4 "66.228.46.55"
 		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
-		& aka "olduse.net"
-		& aka "www.olduse.net"
-		& aka "git.olduse.net"
+		& alias "olduse.net"
+		& alias "www.olduse.net"
+		& alias "git.olduse.net"
 	]
diff --git a/debian/changelog b/debian/changelog
index 463b181..136d61b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,8 +3,8 @@ propellor (0.4.0) UNRELEASED; urgency=medium
   * Propellor can configure primary DNS servers, including generating
     zone files, which is done by looking at the properties of hosts
     in a domain.
-  * The `cname` property was renamed to `aka` as it does not always generate
-    CNAME in the DNS.
+  * The `cname` property was renamed to `alias` as it does not always
+    generate CNAME in the DNS.
   * Constructor of Property has changed (use `property` function instead).
   * All Property combinators now combine together their Attr settings.
     So Attr settings can be made inside a propertyList, for example.

From f10c4d4aff6810a502cfc770013046e42efc33ef Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 01:42:19 -0400
Subject: [PATCH 26/34] make primary dns server beat secondary if both are
 defined for a domain

Made my config file simpler..
---
 Propellor/Attr.hs         | 15 +++++++++++++--
 Propellor/Property/Dns.hs |  5 ++++-
 Propellor/Types/Attr.hs   |  5 +++--
 config-joey.hs            |  2 +-
 4 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index fb94dc3..05ea3ff 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -49,10 +49,21 @@ alias domain = pureAttrProperty ("aka " ++ domain)
 addDNS :: Record -> SetAttr
 addDNS record d = d { _dns = S.insert record (_dns d) }
 
+-- | Adds a DNS NamedConf stanza.
+--
+-- Note that adding a Master stanza for a domain always overrides an
+-- existing Secondary stanza, while a Secondary stanza is only added
+-- when there is no existing Master stanza.
 addNamedConf :: NamedConf -> SetAttr
-addNamedConf conf d = d { _namedconf = S.insert conf (_namedconf d) }
+addNamedConf conf d = d { _namedconf = new }
+  where
+	m = _namedconf d
+	domain = confDomain conf
+	new = case (confType conf, confType <$> M.lookup domain m) of
+		(Secondary, Just Master) -> m
+		_  -> M.insert domain conf m
 
-getNamedConf :: Propellor (S.Set NamedConf)
+getNamedConf :: Propellor (M.Map Domain NamedConf)
 getNamedConf = asks _namedconf
 
 sshPubKey :: String -> Property
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index e47d6c3..4c93799 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -70,6 +70,9 @@ primary hosts domain soa rs = withwarnings (check needupdate baseprop)
 				in z /= oldzone || oldserial < sSerial (zSOA zone)
 
 -- | Secondary dns server for a domain.
+--
+-- Note that if a host is declared to be a primary and a secondary dns
+-- server for the same domain, the primary server config always wins.
 secondary :: [Host] -> Domain -> HostName -> Property
 secondary hosts domain master = pureAttrProperty desc (addNamedConf conf)
 	`requires` servingZones
@@ -95,7 +98,7 @@ servingZones = property "serving configured dns zones" go
 		zs <- getNamedConf
 		ensureProperty $
 			hasContent namedConfFile $
-				concatMap confStanza $ S.toList zs
+				concatMap confStanza $ M.elems zs
 
 confStanza :: NamedConf -> [Line]
 confStanza c =
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index f64b048..8b7d3b0 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -4,6 +4,7 @@ import Propellor.Types.OS
 import qualified Propellor.Types.Dns as Dns
 
 import qualified Data.Set as S
+import qualified Data.Map as M
 
 -- | The attributes of a host. For example, its hostname.
 data Attr = Attr
@@ -11,7 +12,7 @@ data Attr = Attr
 	, _os :: Maybe System
 	, _sshPubKey :: Maybe String
 	, _dns :: S.Set Dns.Record
-	, _namedconf :: S.Set Dns.NamedConf
+	, _namedconf :: M.Map Dns.Domain Dns.NamedConf
 
 	, _dockerImage :: Maybe String
 	, _dockerRunParams :: [HostName -> String]
@@ -42,6 +43,6 @@ instance Show Attr where
 		]
 
 newAttr :: HostName -> Attr
-newAttr hn = Attr hn Nothing Nothing S.empty S.empty Nothing []
+newAttr hn = Attr hn Nothing Nothing S.empty M.empty Nothing []
 
 type SetAttr = Attr -> Attr
diff --git a/config-joey.hs b/config-joey.hs
index b22f0e0..7fadd8b 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -90,7 +90,6 @@ hosts =               --                  (o)  `
 		& Ssh.hostKey SshEcdsa
 		& Apt.unattendedUpgrades
 		& Apt.serviceInstalledRunning "ntp"
-		& myDnsSecondary
 		& Postfix.satellite
 	
 		& Apt.serviceInstalledRunning "apache2"
@@ -122,6 +121,7 @@ hosts =               --                  (o)  `
 		& alias "nntp.olduse.net"
 		& JoeySites.oldUseNetServer hosts
 		
+		& myDnsSecondary
 		& Dns.primary hosts "olduse.net"
 			( Dns.mkSOA "ns1.kitenet.net" 100
 				[ NS (AbsDomain "ns1.kitenet.net")

From f4c0df84eeccbf27c0a3937cbd2aabff0a2420bd Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 01:55:32 -0400
Subject: [PATCH 27/34] secondaryFor

---
 Propellor/Property/Dns.hs | 20 +++++++++++++++++---
 config-joey.hs            | 14 +++++++-------
 2 files changed, 24 insertions(+), 10 deletions(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 4c93799..68ce757 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Dns (
 	module Propellor.Types.Dns,
 	primary,
 	secondary,
+	secondaryFor,
 	mkSOA,
 	rootAddressesFrom,
 	writeZoneFile,
@@ -71,10 +72,23 @@ primary hosts domain soa rs = withwarnings (check needupdate baseprop)
 
 -- | Secondary dns server for a domain.
 --
+-- The primary server is determined by looking at the properties of other
+-- hosts to find which one is configured as the primary.
+--
 -- Note that if a host is declared to be a primary and a secondary dns
 -- server for the same domain, the primary server config always wins.
-secondary :: [Host] -> Domain -> HostName -> Property
-secondary hosts domain master = pureAttrProperty desc (addNamedConf conf)
+secondary :: [Host] -> Domain -> Property
+secondary hosts domain = secondaryFor masters hosts domain
+  where
+	masters = M.keys $ M.filter ismaster $ hostAttrMap hosts
+	ismaster attr = case M.lookup domain (_namedconf attr) of
+		Nothing -> False
+		Just conf -> confType conf == Master && confDomain conf == domain
+
+-- | This variant is useful if the primary server does not have its DNS
+-- configured via propellor.
+secondaryFor :: [HostName] -> [Host] -> Domain -> -> Property
+secondaryFor masters hosts domain = pureAttrProperty desc (addNamedConf conf)
 	`requires` servingZones
   where
  	desc = "dns secondary for " ++ domain
@@ -82,7 +96,7 @@ secondary hosts domain master = pureAttrProperty desc (addNamedConf conf)
 		{ confDomain = domain
 		, confType = Secondary
 		, confFile = "db." ++ domain
-		, confMasters = hostAddresses master hosts
+		, confMasters = concatMap (\m -> hostAddresses m hosts) masters
 		, confLines = ["allow-transfer { }"]
 		}
 
diff --git a/config-joey.hs b/config-joey.hs
index 7fadd8b..a130612 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -246,15 +246,15 @@ cleanCloudAtCost = propertyList "cloudatcost cleanup"
 
 myDnsSecondary :: Property
 myDnsSecondary = propertyList "dns secondary for all my domains"
-	[ Dns.secondary hosts "kitenet.net" master
-	, Dns.secondary hosts "joeyh.name" master
-	, Dns.secondary hosts "ikiwiki.info" master
-	, Dns.secondary hosts "olduse.net" master
-	, Dns.secondary hosts "branchable.com" branchablemaster
+	[ Dns.secondaryFor wren hosts "kitenet.net"
+	, Dns.secondaryFor wren hosts "joeyh.name"
+	, Dns.secondaryFor wren hosts "ikiwiki.info"
+	, Dns.secondary hosts "olduse.net"
+	, Dns.secondaryFor branchable hosts "branchable.com"
 	]
   where
-	master = "wren.kitenet.net"
-	branchablemaster = "branchable.com"
+	wren = ["wren.kitenet.net"]
+	branchable = ["branchable.com"]
 
 main :: IO ()
 main = defaultMain hosts

From ba4f5599ecffd2019ede02e0267d87b818f956b1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 01:58:31 -0400
Subject: [PATCH 28/34] propellor spin

---
 Propellor/Property/Dns.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 68ce757..1984465 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -87,7 +87,7 @@ secondary hosts domain = secondaryFor masters hosts domain
 
 -- | This variant is useful if the primary server does not have its DNS
 -- configured via propellor.
-secondaryFor :: [HostName] -> [Host] -> Domain -> -> Property
+secondaryFor :: [HostName] -> [Host] -> Domain -> Property
 secondaryFor masters hosts domain = pureAttrProperty desc (addNamedConf conf)
 	`requires` servingZones
   where

From ab1e667f7be0593f384990a217136b41c832c558 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:05:23 -0400
Subject: [PATCH 29/34] propellor spin


From ecca6e6080ef37a9471cec9c05b7e3b9511bcdc8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:06:23 -0400
Subject: [PATCH 30/34] propellor spin


From 709faf085ea5d889c110110bd53a059af5771339 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:08:00 -0400
Subject: [PATCH 31/34] propellor spin

---
 config-joey.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/config-joey.hs b/config-joey.hs
index a130612..1bda9dd 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -119,6 +119,7 @@ hosts =               --                  (o)  `
 		& JoeySites.twitRss
 		
 		& alias "nntp.olduse.net"
+		& alias "resources.olduse.net"
 		& JoeySites.oldUseNetServer hosts
 		
 		& myDnsSecondary

From ae31991a203b01a9f3095e6b39f173deddc37134 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:08:38 -0400
Subject: [PATCH 32/34] ye olde file read/write laziness bug

---
 Propellor/Property/Dns.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 1984465..0708417 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -245,7 +245,7 @@ writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
 
 readZonePropellorFile :: FilePath -> IO (Maybe Zone)
 readZonePropellorFile f = catchDefaultIO Nothing $
-	readish <$> readFile (zonePropellorFile f)
+	readish <$> readFileStrict (zonePropellorFile f)
 
 -- | Generating a zone file.
 genZoneFile :: Zone -> String

From 4e628b6ce5b57ef98acd7178fb03e64005a81b8f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:08:53 -0400
Subject: [PATCH 33/34] propellor spin


From 6aeeaaab9073675e8c043d009c97ff62d809975b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 19 Apr 2014 02:10:41 -0400
Subject: [PATCH 34/34] prep release

---
 debian/changelog | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index 136d61b..beaca78 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-propellor (0.4.0) UNRELEASED; urgency=medium
+propellor (0.4.0) unstable; urgency=medium
 
   * Propellor can configure primary DNS servers, including generating
     zone files, which is done by looking at the properties of hosts
@@ -11,7 +11,7 @@ propellor (0.4.0) UNRELEASED; urgency=medium
   * Run all cron jobs under chronic from moreutils to avoid unnecessary
     mails.
 
- -- Joey Hess <joeyh@debian.org>  Thu, 17 Apr 2014 21:00:43 -0400
+ -- Joey Hess <joeyh@debian.org>  Sat, 19 Apr 2014 02:09:56 -0400
 
 propellor (0.3.1) unstable; urgency=medium