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