summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 17:19:28 -0400
committerJoey Hess2014-04-18 17:19:28 -0400
commit39d697ca789c04da07bb14cc7476899e717d9413 (patch)
tree9e2c45e9f66e9a7d7e419cb6c38e37e1a9ebdd88
parent2b9ee5b29b03a4a18fb43dafab38d6d185c653e0 (diff)
add dns records to Attr
-rw-r--r--Propellor/Attr.hs10
-rw-r--r--Propellor/Property/Dns.hs121
-rw-r--r--Propellor/Types.hs1
-rw-r--r--Propellor/Types/Attr.hs12
-rw-r--r--Propellor/Types/Dns.hs73
-rw-r--r--Propellor/Types/OS.hs1
-rw-r--r--config-joey.hs6
-rw-r--r--propellor.cabal1
8 files changed, 122 insertions, 103 deletions
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