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: All Property combinators now combine together their Attr settings.

So Attr settings can be made inside a propertyList, for example.
---
 Propellor/Types/Attr.hs | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'Propellor/Types')

diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index 1ff58148..00611775 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
-- 
cgit v1.3-2-g0d8e


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: 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

(limited to 'Propellor/Types')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 03c882cc..21736588 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 1d4a8e49..99a60145 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 42401d12..ad822a8b 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 00611775..cf8bdf1a 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 00000000..4b5925c1
--- /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 0635b271..23cc8a29 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 b6d1664d..48b43266 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 677b9a89..68d7fb70 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
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'Propellor/Types')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 21736588..f3e2e2e5 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 4b5925c1..026920fb 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 48b43266..8c61c325 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"
 	]
-- 
cgit v1.3-2-g0d8e


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: better serial number offsets

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

(limited to 'Propellor/Types')

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 99a60145..cefbd712 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 026920fb..b5cfcffd 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.
 --
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'Propellor/Types')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index f3e2e2e5..37ed1bad 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 cefbd712..131079ea 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 b5cfcffd..0474ea96 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 8c61c325..289d3240 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
-- 
cgit v1.3-2-g0d8e


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: rename TTL field, per RFC 2308

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

(limited to 'Propellor/Types')

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index a9a8619c..4b51eebd 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 0474ea96..3bdd6c3a 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
 	}
-- 
cgit v1.3-2-g0d8e


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: add SOA

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

(limited to 'Propellor/Types')

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index e4dfb199..7abeb552 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 3bdd6c3a..9d801ef6 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
-- 
cgit v1.3-2-g0d8e


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: 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 | 82 ++++++++++++++++++++++++++++++-----------------
 Propellor/Types/Attr.hs   |  9 ++++--
 Propellor/Types/Dns.hs    |  4 +--
 config-joey.hs            | 42 ++++++++++++------------
 debian/changelog          |  9 ++++--
 6 files changed, 93 insertions(+), 59 deletions(-)

(limited to 'Propellor/Types')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 8c4a2add..a54d8833 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 7c26f1d5..90556d2d 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
-
-namedconf :: FilePath
-namedconf = "/etc/bind/named.conf.local"
-
-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 { }"]
-	}
+	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)
+
+-- | 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 { }"]
+		}
+
+-- | 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 cf8bdf1a..f64b0487 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 9d801ef6..e367202a 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 eae3a155..e49a062c 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 2442dd18..463b1819 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
 
-- 
cgit v1.3-2-g0d8e


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: 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(-)

(limited to 'Propellor/Types')

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index fb94dc34..05ea3ff5 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 e47d6c32..4c93799f 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 f64b0487..8b7d3b09 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 b22f0e07..7fadd8bc 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")
-- 
cgit v1.3-2-g0d8e