module Propellor.Property.Unbound
( installed
, restarted
, reloaded
, UnboundSection
, UnboundZone
, UnboundHost
, UnboundSetting
, UnboundValue
, UnboundKey
, ConfSection
, ZoneType
, cachingDnsServer
) where
import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import Data.List (find)
type ConfSection = String
type UnboundSetting = (UnboundKey, UnboundValue)
type UnboundSection = (ConfSection, [UnboundSetting])
type UnboundZone = (BindDomain, ZoneType)
type UnboundHost = (BindDomain, Record)
type UnboundKey = String
type UnboundValue = String
type ZoneType = String
installed :: Property DebianLike
installed = Apt.installed ["unbound"]
restarted :: Property DebianLike
restarted = Service.restarted "unbound"
reloaded :: Property DebianLike
reloaded = Service.reloaded "unbound"
dValue :: BindDomain -> String
dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
sectionHeader :: ConfSection -> String
sectionHeader header = header ++ ":"
config :: FilePath
config = "/etc/unbound/unbound.conf.d/propellor.conf"
cachingDnsServer :: [UnboundSection] -> [UnboundZone] -> [UnboundHost] -> Property DebianLike
cachingDnsServer sections zones hosts =
config `hasContent` (comment : otherSections ++ serverSection)
`onChange` restarted
where
comment = "# deployed with propellor, do not modify"
serverSection = genSection (fromMaybe ("server", []) $ find ((== "server") . fst) sections)
++ map genZone zones
++ map (uncurry genRecord') hosts
otherSections = foldr ((++) . genSection) [] $ filter ((/= "server") . fst) sections
genSection :: UnboundSection -> [Line]
genSection (section, settings) = sectionHeader section : map genSetting settings
genSetting :: UnboundSetting -> Line
genSetting (key, value) = " " ++ key ++ ": " ++ value
genZone :: UnboundZone -> Line
genZone (dom, zt) = " local-zone: \"" ++ dValue dom ++ "\" " ++ zt
genRecord' :: BindDomain -> Record -> Line
genRecord' dom r = " local-data: \"" ++ fromMaybe "" (genRecord dom r) ++ "\""
genRecord :: BindDomain -> Record -> Maybe String
genRecord dom (Address addr) = Just $ genAddressNoTtl dom addr
genRecord dom (MX priority dest) = Just $ unwords
[ dValue dom
, "MX"
, val priority
, dValue dest
]
genRecord dom (PTR revip) = Just $ unwords
[ revip ++ "."
, "PTR"
, dValue dom
]
genRecord dom (CNAME dest) = Just $ unwords
[ dValue dom
, "CNAME"
, dValue dest
]
genRecord dom (NS serv) = Just $ unwords
[ dValue dom
, "NS"
, dValue serv
]
genRecord dom (TXT txt) = Just $ unwords
[ dValue dom
, "TXT"
, txt
]
genRecord dom (SRV priority weight port target) = Just $ unwords
[ dValue dom
, "SRV"
, val priority
, val weight
, val port
, dValue target
]
genRecord dom (SSHFP algo hash fingerprint) = Just $ unwords
[ dValue dom
, "SSHFP"
, val algo
, val hash
, fingerprint
]
genRecord _ (INCLUDE _) = Nothing
genAddressNoTtl :: BindDomain -> IPAddr -> String
genAddressNoTtl dom = genAddress dom Nothing
genAddress :: BindDomain -> Maybe Int -> IPAddr -> String
genAddress dom ttl addr = case addr of
IPv4 _ -> genAddress' "A" dom ttl addr
IPv6 _ -> genAddress' "AAAA" dom ttl addr
genAddress' :: String -> BindDomain -> Maybe Int -> IPAddr -> String
genAddress' recordtype dom ttl addr = unwords $
[ dValue dom ]
++ maybe [] (\ttl' -> [val ttl']) ttl ++
[ "IN"
, recordtype
, val addr
]