module Propellor.Property.Dns (
	module Propellor.Types.Dns,
	primary,
	signedPrimary,
	secondary,
	secondaryFor,
	mkSOA,
	writeZoneFile,
	nextSerialNumber,
	adjustSerialNumber,
	serialNumberOffset,
	WarningMessage,
	genZone,
) where

import Propellor.Base
import Propellor.Types.Dns
import Propellor.Types.Info
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Service as Service
import Propellor.Property.Scheduled
import Propellor.Property.DnsSec
import Utility.Applicative

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.List.Split as Split (chunksOf)
import Data.List

-- | Primary dns server for a domain, using bind.
--
-- Currently, this only configures bind to serve forward DNS, not reverse DNS.
--
-- 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"
-- >   & alias "mail.exmaple.com"
--
-- Will cause that hostmame and its alias to appear in the zone file,
-- with the configured IP address.
--
-- Also, if a host has a ssh public key configured, a SSHFP record will
-- be automatically generated for it.
--
-- The [(BindDomain, Record)] list can be used for additional records
-- that cannot be configured elsewhere. This often includes NS records,
-- TXT records and perhaps CNAMEs pointing at hosts that propellor does
-- not control.
--
-- The primary server is configured to only allow zone transfers to
-- secondary dns servers. These are determined in two ways:
--
-- 1. By looking at the properties of other hosts, to find hosts that
-- are configured as the secondary dns server.
--
-- 2. By looking for NS Records in the passed list of records.
--
-- In either case, the secondary dns server Host should have an ipv4 and/or
-- ipv6 property defined.
primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
primary :: [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> RevertableProperty (HasInfo + DebianLike) DebianLike
primary [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
  (Property DebianLike)
setup = Domain
-> (Domain -> Domain)
-> [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> Property (HasInfo + DebianLike)
setupPrimary Domain
zonefile Domain -> Domain
forall a. a -> a
id [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs
		Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain -> Property DebianLike
Service.reloaded Domain
"bind9"
	cleanup :: CombinedType (Property DebianLike) (Property DebianLike)
cleanup = Domain -> Domain -> Property DebianLike
cleanupPrimary Domain
zonefile Domain
domain
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain -> Property DebianLike
Service.reloaded Domain
"bind9"

	zonefile :: Domain
zonefile = Domain
"/etc/bind/propellor/db." Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain

setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property (HasInfo + DebianLike)
setupPrimary :: Domain
-> (Domain -> Domain)
-> [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> Property (HasInfo + DebianLike)
setupPrimary Domain
zonefile Domain -> Domain
mknamedconffile [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs =
	Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall metatypes. Property metatypes -> Property metatypes
withwarnings Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
baseprop
		Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
servingZones
  where
	hostmap :: Map Domain Host
hostmap = [Host] -> Map Domain Host
hostMap [Host]
hosts
	-- Known hosts with hostname located in the domain.
	indomain :: [Host]
indomain = Map Domain Host -> [Host]
forall k a. Map k a -> [a]
M.elems (Map Domain Host -> [Host]) -> Map Domain Host -> [Host]
forall a b. (a -> b) -> a -> b
$ (Domain -> Host -> Bool) -> Map Domain Host -> Map Domain Host
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Domain
hn Host
_ -> Domain -> BindDomain -> Bool
inDomain Domain
domain (BindDomain -> Bool) -> BindDomain -> Bool
forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain (Domain -> BindDomain) -> Domain -> BindDomain
forall a b. (a -> b) -> a -> b
$ Domain
hn) Map Domain Host
hostmap

	(Zone
partialzone, [Domain]
zonewarnings) = [Host] -> Map Domain Host -> Domain -> SOA -> (Zone, [Domain])
genZone [Host]
indomain Map Domain Host
hostmap Domain
domain SOA
soa
	baseprop :: Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
baseprop = Property DebianLike
primaryprop
		Property DebianLike
-> Info
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (NamedConfMap -> Info
forall v. IsInfo v => v -> Info
toInfo (NamedConf -> NamedConfMap
addNamedConf NamedConf
conf))
	primaryprop :: Property DebianLike
	primaryprop :: Property DebianLike
primaryprop = Domain -> Propellor Result -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property (Domain
"dns primary for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain) (Propellor Result -> Property DebianLike)
-> Propellor Result -> Property DebianLike
forall a b. (a -> b) -> a -> b
$ do
		[(BindDomain, Record)]
sshfps <- [[(BindDomain, Record)]] -> [(BindDomain, Record)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(BindDomain, Record)]] -> [(BindDomain, Record)])
-> Propellor [[(BindDomain, Record)]]
-> Propellor [(BindDomain, Record)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Host -> Propellor [(BindDomain, Record)])
-> [Host] -> Propellor [[(BindDomain, Record)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Domain -> Host -> Propellor [(BindDomain, Record)]
genSSHFP Domain
domain) (Map Domain Host -> [Host]
forall k a. Map k a -> [a]
M.elems Map Domain Host
hostmap)
		let zone :: Zone
zone = Zone
partialzone
			{ zHosts :: [(BindDomain, Record)]
zHosts = Zone -> [(BindDomain, Record)]
zHosts Zone
partialzone [(BindDomain, Record)]
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. [a] -> [a] -> [a]
++ [(BindDomain, Record)]
rs [(BindDomain, Record)]
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. [a] -> [a] -> [a]
++ [(BindDomain, Record)]
sshfps }
		Propellor Bool
-> (Propellor Result, Propellor Result) -> Propellor Result
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (IO Bool -> Propellor Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
forall a b. (a -> b) -> a -> b
$ Zone -> IO Bool
needupdate Zone
zone)
			( IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Zone -> Domain -> IO ()
writeZoneFile Zone
zone Domain
zonefile
			, Propellor Result
noChange
			)
	withwarnings :: Property metatypes -> Property metatypes
withwarnings Property metatypes
p = Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property metatypes
p ((Propellor Result -> Propellor Result) -> Property metatypes)
-> (Propellor Result -> Propellor Result) -> Property metatypes
forall a b. (a -> b) -> a -> b
$ \Propellor Result
a -> do
		(Domain -> Propellor ()) -> [Domain] -> Propellor ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Domain -> Propellor ()
forall (m :: * -> *). MonadIO m => Domain -> m ()
warningMessage ([Domain] -> Propellor ()) -> [Domain] -> Propellor ()
forall a b. (a -> b) -> a -> b
$ [Domain]
zonewarnings [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++ [Domain]
secondarywarnings
		Propellor Result
a
	conf :: NamedConf
conf = NamedConf :: Domain
-> DnsServerType
-> Domain
-> [IPAddr]
-> [IPAddr]
-> [Domain]
-> NamedConf
NamedConf
		{ confDomain :: Domain
confDomain = Domain
domain
		, confDnsServerType :: DnsServerType
confDnsServerType = DnsServerType
Master
		, confFile :: Domain
confFile = Domain -> Domain
mknamedconffile Domain
zonefile
		, confMasters :: [IPAddr]
confMasters = []
		, confAllowTransfer :: [IPAddr]
confAllowTransfer = [IPAddr] -> [IPAddr]
forall a. Eq a => [a] -> [a]
nub ([IPAddr] -> [IPAddr]) -> [IPAddr] -> [IPAddr]
forall a b. (a -> b) -> a -> b
$
			(Domain -> [IPAddr]) -> [Domain] -> [IPAddr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Domain -> [Host] -> [IPAddr]
`hostAddresses` [Host]
hosts) ([Domain] -> [IPAddr]) -> [Domain] -> [IPAddr]
forall a b. (a -> b) -> a -> b
$
				[Domain]
secondaries [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++ [Domain]
nssecondaries
		, confLines :: [Domain]
confLines = []
		}
	secondaries :: [Domain]
secondaries = DnsServerType -> [Host] -> Domain -> [Domain]
otherServers DnsServerType
Secondary [Host]
hosts Domain
domain
	secondarywarnings :: [Domain]
secondarywarnings = (Domain -> Domain) -> [Domain] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map (\Domain
h -> Domain
"No IP address defined for DNS seconary " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
h) ([Domain] -> [Domain]) -> [Domain] -> [Domain]
forall a b. (a -> b) -> a -> b
$
		(Domain -> Bool) -> [Domain] -> [Domain]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Domain
h -> [IPAddr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Domain -> [Host] -> [IPAddr]
hostAddresses Domain
h [Host]
hosts)) [Domain]
secondaries
	nssecondaries :: [Domain]
nssecondaries = (Record -> Maybe Domain) -> [Record] -> [Domain]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (BindDomain -> Maybe Domain
domainHostName (BindDomain -> Maybe Domain)
-> (Record -> Maybe BindDomain) -> Record -> Maybe Domain
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Record -> Maybe BindDomain
getNS) [Record]
rootRecords
	rootRecords :: [Record]
rootRecords = ((BindDomain, Record) -> Record)
-> [(BindDomain, Record)] -> [Record]
forall a b. (a -> b) -> [a] -> [b]
map (BindDomain, Record) -> Record
forall a b. (a, b) -> b
snd ([(BindDomain, Record)] -> [Record])
-> [(BindDomain, Record)] -> [Record]
forall a b. (a -> b) -> a -> b
$
		((BindDomain, Record) -> Bool)
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(BindDomain
d, Record
_r) -> BindDomain
d BindDomain -> BindDomain -> Bool
forall a. Eq a => a -> a -> Bool
== BindDomain
RootDomain Bool -> Bool -> Bool
|| BindDomain
d BindDomain -> BindDomain -> Bool
forall a. Eq a => a -> a -> Bool
== Domain -> BindDomain
AbsDomain Domain
domain) [(BindDomain, Record)]
rs
	needupdate :: Zone -> IO Bool
needupdate Zone
zone = do
		Maybe Zone
v <- Domain -> IO (Maybe Zone)
readZonePropellorFile Domain
zonefile
		Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case Maybe Zone
v of
			Maybe Zone
Nothing -> Bool
True
			Just Zone
oldzone ->
				-- compare everything except serial
				let oldserial :: SerialNumber
oldserial = SOA -> SerialNumber
sSerial (Zone -> SOA
zSOA Zone
oldzone)
				    z :: Zone
z = Zone
zone { zSOA :: SOA
zSOA = (Zone -> SOA
zSOA Zone
zone) { sSerial :: SerialNumber
sSerial = SerialNumber
oldserial } }
				in Zone
z Zone -> Zone -> Bool
forall a. Eq a => a -> a -> Bool
/= Zone
oldzone Bool -> Bool -> Bool
|| SerialNumber
oldserial SerialNumber -> SerialNumber -> Bool
forall a. Ord a => a -> a -> Bool
< SOA -> SerialNumber
sSerial (Zone -> SOA
zSOA Zone
zone)


cleanupPrimary :: FilePath -> Domain -> Property DebianLike
cleanupPrimary :: Domain -> Domain -> Property DebianLike
cleanupPrimary Domain
zonefile Domain
domain = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Domain -> IO Bool
doesFileExist Domain
zonefile) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	Property DebianLike
go Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
namedConfWritten
  where
	desc :: Domain
desc = Domain
"removed dns primary for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
	go :: Property DebianLike
	go :: Property DebianLike
go = Domain -> Propellor Result -> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property Domain
desc (IO () -> Propellor Result
makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
forall a b. (a -> b) -> a -> b
$ Domain -> IO ()
removeZoneFile Domain
zonefile)

-- | Primary dns server for a domain, secured with DNSSEC.
--
-- This is like `primary`, except the resulting zone
-- file is signed.
-- The Zone Signing Key (ZSK) and Key Signing Key (KSK)
-- used in signing it are taken from the PrivData.
--
-- As a side effect of signing the zone, a
-- </var/cache/bind/dsset-domain.>
-- file will be created. This file contains the DS records
-- which need to be communicated to your domain registrar
-- to make DNSSEC be used for your domain. Doing so is outside
-- the scope of propellor (currently). See for example the tutorial
-- <https://www.digitalocean.com/community/tutorials/how-to-setup-dnssec-on-an-authoritative-bind-dns-server--2>
--
-- The 'Recurrance' controls how frequently the signature
-- should be regenerated, using a new random salt, to prevent
-- zone walking attacks. `Weekly Nothing` is a reasonable choice.
--
-- To transition from 'primary' to 'signedPrimary', you can revert
-- the 'primary' property, and add this property.
--
-- Note that DNSSEC zone files use a serial number based on the unix epoch.
-- This is different from the serial number used by 'primary', so if you
-- want to later disable DNSSEC you will need to adjust the serial number
-- passed to mkSOA to ensure it is larger.
signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty (HasInfo + DebianLike) DebianLike
signedPrimary :: Recurrance
-> [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> RevertableProperty (HasInfo + DebianLike) DebianLike
signedPrimary Recurrance
recurrance [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
  (Property DebianLike)
setup = Domain
-> Props
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Domain
"dns primary for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
" (signed)")
		(Props UnixLike
props
			Props UnixLike
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Domain
-> (Domain -> Domain)
-> [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> Property (HasInfo + DebianLike)
setupPrimary Domain
zonefile Domain -> Domain
signedZoneFile [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs'
			Props
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Domain
-> Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
zoneSigned Domain
domain Domain
zonefile
			Props
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall a p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Domain -> Domain -> Property UnixLike
forceZoneSigned Domain
domain Domain
zonefile Property UnixLike -> Recurrance -> Property UnixLike
forall i. Property i -> Recurrance -> Property i
`period` Recurrance
recurrance
		)
		Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain -> Property DebianLike
Service.reloaded Domain
"bind9"

	cleanup :: CombinedType (Property DebianLike) (Property DebianLike)
cleanup = Domain -> Domain -> Property DebianLike
cleanupPrimary Domain
zonefile Domain
domain
		Property DebianLike
-> RevertableProperty
     UnixLike
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property DebianLike)
     (RevertableProperty
        UnixLike
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` RevertableProperty
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
  UnixLike
-> RevertableProperty
     UnixLike
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert (Domain
-> Domain -> RevertableProperty (HasInfo + UnixLike) UnixLike
zoneSigned Domain
domain Domain
zonefile)
		Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain -> Property DebianLike
Service.reloaded Domain
"bind9"

	-- Include the public keys into the zone file.
	rs' :: [(BindDomain, Record)]
rs' = DnsSecKey -> (BindDomain, Record)
include DnsSecKey
PubKSK (BindDomain, Record)
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. a -> [a] -> [a]
: DnsSecKey -> (BindDomain, Record)
include DnsSecKey
PubZSK (BindDomain, Record)
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. a -> [a] -> [a]
: [(BindDomain, Record)]
rs
	include :: DnsSecKey -> (BindDomain, Record)
include DnsSecKey
k = (BindDomain
RootDomain, Domain -> Record
INCLUDE (Domain -> DnsSecKey -> Domain
keyFn Domain
domain DnsSecKey
k))

	-- Put DNSSEC zone files in a different directory than is used for
	-- the regular ones. This allows 'primary' to be reverted and
	-- 'signedPrimary' enabled, without the reverted property stomping
	-- on the new one's settings.
	zonefile :: Domain
zonefile = Domain
"/etc/bind/propellor/dnssec/db." Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain

-- | 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 -> RevertableProperty (HasInfo + DebianLike) DebianLike
secondary :: [Host]
-> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
secondary [Host]
hosts Domain
domain = [Domain]
-> [Host]
-> Domain
-> RevertableProperty (HasInfo + DebianLike) DebianLike
secondaryFor (DnsServerType -> [Host] -> Domain -> [Domain]
otherServers DnsServerType
Master [Host]
hosts Domain
domain) [Host]
hosts Domain
domain

-- | This variant is useful if the primary server does not have its DNS
-- configured via propellor.
secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty (HasInfo + DebianLike) DebianLike
secondaryFor :: [Domain]
-> [Host]
-> Domain
-> RevertableProperty (HasInfo + DebianLike) DebianLike
secondaryFor [Domain]
masters [Host]
hosts Domain
domain = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property DebianLike
-> RevertableProperty
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     DebianLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
  (Property DebianLike)
setup = Domain -> NamedConfMap -> Property (HasInfo + UnixLike)
forall v. IsInfo v => Domain -> v -> Property (HasInfo + UnixLike)
pureInfoProperty Domain
desc (NamedConf -> NamedConfMap
addNamedConf NamedConf
conf)
		Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (MetaTypes
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
servingZones
	cleanup :: Property DebianLike
cleanup = Property DebianLike
namedConfWritten

	desc :: Domain
desc = Domain
"dns secondary for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
	conf :: NamedConf
conf = NamedConf :: Domain
-> DnsServerType
-> Domain
-> [IPAddr]
-> [IPAddr]
-> [Domain]
-> NamedConf
NamedConf
		{ confDomain :: Domain
confDomain = Domain
domain
		, confDnsServerType :: DnsServerType
confDnsServerType = DnsServerType
Secondary
		, confFile :: Domain
confFile = Domain
"db." Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
		, confMasters :: [IPAddr]
confMasters = (Domain -> [IPAddr]) -> [Domain] -> [IPAddr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Domain -> [Host] -> [IPAddr]
`hostAddresses` [Host]
hosts) [Domain]
masters
		, confAllowTransfer :: [IPAddr]
confAllowTransfer = []
		, confLines :: [Domain]
confLines = []
		}

otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
otherServers :: DnsServerType -> [Host] -> Domain -> [Domain]
otherServers DnsServerType
wantedtype [Host]
hosts Domain
domain =
	Map Domain Host -> [Domain]
forall k a. Map k a -> [k]
M.keys (Map Domain Host -> [Domain]) -> Map Domain Host -> [Domain]
forall a b. (a -> b) -> a -> b
$ (Host -> Bool) -> Map Domain Host -> Map Domain Host
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Host -> Bool
wanted (Map Domain Host -> Map Domain Host)
-> Map Domain Host -> Map Domain Host
forall a b. (a -> b) -> a -> b
$ [Host] -> Map Domain Host
hostMap [Host]
hosts
  where
	wanted :: Host -> Bool
wanted Host
h = case Domain -> Map Domain NamedConf -> Maybe NamedConf
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Domain
domain (NamedConfMap -> Map Domain NamedConf
fromNamedConfMap (NamedConfMap -> Map Domain NamedConf)
-> NamedConfMap -> Map Domain NamedConf
forall a b. (a -> b) -> a -> b
$ Info -> NamedConfMap
forall v. IsInfo v => Info -> v
fromInfo (Info -> NamedConfMap) -> Info -> NamedConfMap
forall a b. (a -> b) -> a -> b
$ Host -> Info
hostInfo Host
h) of
		Maybe NamedConf
Nothing -> Bool
False
		Just NamedConf
conf -> NamedConf -> DnsServerType
confDnsServerType NamedConf
conf DnsServerType -> DnsServerType -> Bool
forall a. Eq a => a -> a -> Bool
== DnsServerType
wantedtype
			Bool -> Bool -> Bool
&& NamedConf -> Domain
confDomain NamedConf
conf Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
== Domain
domain

-- | Rewrites the whole named.conf.local file to serve the zones
-- configured by `primary` and `secondary`, and ensures that bind9 is
-- running.
servingZones :: Property DebianLike
servingZones :: Property DebianLike
servingZones = Property DebianLike
namedConfWritten
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain -> Property DebianLike
Service.reloaded Domain
"bind9"
	Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Domain -> Property DebianLike
Apt.serviceInstalledRunning Domain
"bind9"

namedConfWritten :: Property DebianLike
namedConfWritten :: Property DebianLike
namedConfWritten = Domain
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
Domain
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Domain
"named.conf configured" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
	Map Domain NamedConf
zs <- Propellor (Map Domain NamedConf)
getNamedConf
	OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property UnixLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$
		Domain -> [Domain] -> Property UnixLike
hasContent Domain
namedConfFile ([Domain] -> Property UnixLike) -> [Domain] -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
			(NamedConf -> [Domain]) -> [NamedConf] -> [Domain]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NamedConf -> [Domain]
confStanza ([NamedConf] -> [Domain]) -> [NamedConf] -> [Domain]
forall a b. (a -> b) -> a -> b
$ Map Domain NamedConf -> [NamedConf]
forall k a. Map k a -> [a]
M.elems Map Domain NamedConf
zs

confStanza :: NamedConf -> [Line]
confStanza :: NamedConf -> [Domain]
confStanza NamedConf
c =
	[ Domain
"// automatically generated by propellor"
	, Domain
"zone \"" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ NamedConf -> Domain
confDomain NamedConf
c Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"\" {"
	, Domain -> Domain -> Domain
cfgline Domain
"type" (if NamedConf -> DnsServerType
confDnsServerType NamedConf
c DnsServerType -> DnsServerType -> Bool
forall a. Eq a => a -> a -> Bool
== DnsServerType
Master then Domain
"master" else Domain
"slave")
	, Domain -> Domain -> Domain
cfgline Domain
"file" (Domain
"\"" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ NamedConf -> Domain
confFile NamedConf
c Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"\"")
	] [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
	[Domain]
mastersblock [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
	[Domain]
allowtransferblock [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
	((Domain -> Domain) -> [Domain] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map (\Domain
l -> Domain
"\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
l Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
";") (NamedConf -> [Domain]
confLines NamedConf
c)) [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
	[ Domain
"};"
	, Domain
""
	]
  where
	cfgline :: Domain -> Domain -> Domain
cfgline Domain
f Domain
v = Domain
"\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
f Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
" " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
v Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
";"
	ipblock :: Domain -> [t] -> [Domain]
ipblock Domain
name [t]
l =
		[ Domain
"\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
name Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
" {" ] [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
		((t -> Domain) -> [t] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map (\t
ip -> Domain
"\t\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ t -> Domain
forall t. ConfigurableValue t => t -> Domain
val t
ip Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
";") [t]
l) [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++
		[ Domain
"\t};" ]
	mastersblock :: [Domain]
mastersblock
		| [IPAddr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NamedConf -> [IPAddr]
confMasters NamedConf
c) = []
		| Bool
otherwise = Domain -> [IPAddr] -> [Domain]
forall t. ConfigurableValue t => Domain -> [t] -> [Domain]
ipblock Domain
"masters" (NamedConf -> [IPAddr]
confMasters NamedConf
c)
	-- an empty block prohibits any transfers
	allowtransferblock :: [Domain]
allowtransferblock = Domain -> [IPAddr] -> [Domain]
forall t. ConfigurableValue t => Domain -> [t] -> [Domain]
ipblock Domain
"allow-transfer" (NamedConf -> [IPAddr]
confAllowTransfer NamedConf
c)

namedConfFile :: FilePath
namedConfFile :: Domain
namedConfFile = Domain
"/etc/bind/named.conf.local"

-- | 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. So, 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.
--
-- 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 -> SOA
mkSOA :: Domain -> SerialNumber -> SOA
mkSOA Domain
d SerialNumber
sn = SOA :: BindDomain
-> SerialNumber -> Integer -> Integer -> Integer -> Integer -> SOA
SOA
	{ sDomain :: BindDomain
sDomain = Domain -> BindDomain
AbsDomain Domain
d
	, sSerial :: SerialNumber
sSerial = SerialNumber
sn
	, sRefresh :: Integer
sRefresh = Integer -> Integer
forall a. Num a => a -> a
hours Integer
4
	, sRetry :: Integer
sRetry = Integer -> Integer
forall a. Num a => a -> a
hours Integer
1
	, sExpire :: Integer
sExpire = Integer
2419200 -- 4 weeks
	, sNegativeCacheTTL :: Integer
sNegativeCacheTTL = Integer -> Integer
forall a. Num a => a -> a
hours Integer
8
	}
  where
	hours :: a -> a
hours a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
60 a -> a -> a
forall a. Num a => a -> a -> a
* a
60

dValue :: BindDomain -> String
dValue :: BindDomain -> Domain
dValue (RelDomain Domain
d) = Domain
d
dValue (AbsDomain Domain
d) = Domain
d Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"."
dValue (BindDomain
RootDomain) = Domain
"@"

rField :: Record -> Maybe String
rField :: Record -> Maybe Domain
rField (Address (IPv4 Domain
_)) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"A"
rField (Address (IPv6 Domain
_)) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"AAAA"
rField (CNAME BindDomain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"CNAME"
rField (MX Int
_ BindDomain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"MX"
rField (NS BindDomain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"NS"
rField (TXT Domain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"TXT"
rField (SRV Word16
_ Word16
_ Word16
_ BindDomain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"SRV"
rField (SSHFP Int
_ Int
_ Domain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"SSHFP"
rField (INCLUDE Domain
_) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
"$INCLUDE"
rField (PTR Domain
_) = Maybe Domain
forall a. Maybe a
Nothing

rValue :: Record -> Maybe String
rValue :: Record -> Maybe Domain
rValue (Address (IPv4 Domain
addr)) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
addr
rValue (Address (IPv6 Domain
addr)) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
addr
rValue (CNAME BindDomain
d) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ BindDomain -> Domain
dValue BindDomain
d
rValue (MX Int
pri BindDomain
d) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ Int -> Domain
forall t. ConfigurableValue t => t -> Domain
val Int
pri Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
" " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ BindDomain -> Domain
dValue BindDomain
d
rValue (NS BindDomain
d) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ BindDomain -> Domain
dValue BindDomain
d
rValue (SRV Word16
priority Word16
weight Word16
port BindDomain
target) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ [Domain] -> Domain
unwords
	[ Word16 -> Domain
forall t. ConfigurableValue t => t -> Domain
val Word16
priority
	, Word16 -> Domain
forall t. ConfigurableValue t => t -> Domain
val Word16
weight
	, Word16 -> Domain
forall t. ConfigurableValue t => t -> Domain
val Word16
port
	, BindDomain -> Domain
dValue BindDomain
target
	]
rValue (SSHFP Int
x Int
y Domain
s) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ [Domain] -> Domain
unwords
	[ Int -> Domain
forall t. ConfigurableValue t => t -> Domain
val Int
x
	, Int -> Domain
forall t. ConfigurableValue t => t -> Domain
val Int
y
	, Domain
s
	]
rValue (INCLUDE Domain
f) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just Domain
f
rValue (TXT Domain
s) = Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ Domain -> Domain
zoneFileString Domain
s
rValue (PTR Domain
_) = Maybe Domain
forall a. Maybe a
Nothing

-- Bind has a limit on the length of a string in its zone file,
-- but a string can be split into sections that are glued together
-- inside parens to configure a longer value.
--
-- This adds quotes around each substring.
zoneFileString :: String -> String
zoneFileString :: Domain -> Domain
zoneFileString Domain
s = [Domain] -> Domain
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	[ [Char
op, Char
w]
	, (Domain -> [Domain] -> Domain
forall a. [a] -> [[a]] -> [a]
intercalate Domain
"\n\t" ([Domain] -> Domain) -> [Domain] -> Domain
forall a b. (a -> b) -> a -> b
$
		(Domain -> Domain) -> [Domain] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map (\Domain
x -> [Char
q] Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ (Char -> Bool) -> Domain -> Domain
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
q) Domain
x Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ [Char
q]) ([Domain] -> [Domain]) -> [Domain] -> [Domain]
forall a b. (a -> b) -> a -> b
$
		Int -> Domain -> [Domain]
forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
255 Domain
s)
	, [Char
w, Char
cp]
	]
  where
	op :: Char
op = Char
'('
	cp :: Char
cp = Char
')'
	w :: Char
w = Char
' '
	q :: Char
q = Char
'"'

-- | Adjusts the serial number of the zone to always be larger
-- than the serial number in the Zone record,
-- and always be larger than the passed SerialNumber.
nextSerialNumber :: Zone -> SerialNumber -> Zone
nextSerialNumber :: Zone -> SerialNumber -> Zone
nextSerialNumber Zone
z SerialNumber
serial = Zone -> (SerialNumber -> SerialNumber) -> Zone
adjustSerialNumber Zone
z ((SerialNumber -> SerialNumber) -> Zone)
-> (SerialNumber -> SerialNumber) -> Zone
forall a b. (a -> b) -> a -> b
$ \SerialNumber
sn -> SerialNumber -> SerialNumber
forall a. Enum a => a -> a
succ (SerialNumber -> SerialNumber) -> SerialNumber -> SerialNumber
forall a b. (a -> b) -> a -> b
$ SerialNumber -> SerialNumber -> SerialNumber
forall a. Ord a => a -> a -> a
max SerialNumber
sn SerialNumber
serial

adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
adjustSerialNumber (Zone Domain
d SOA
soa [(BindDomain, Record)]
l) SerialNumber -> SerialNumber
f = Domain -> SOA -> [(BindDomain, Record)] -> Zone
Zone Domain
d SOA
soa' [(BindDomain, Record)]
l
  where
	soa' :: SOA
soa' = SOA
soa { sSerial :: SerialNumber
sSerial = SerialNumber -> SerialNumber
f (SOA -> SerialNumber
sSerial SOA
soa) }

-- | Count the number of git commits made to the current branch.
serialNumberOffset :: IO SerialNumber
serialNumberOffset :: IO SerialNumber
serialNumberOffset = Int -> SerialNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SerialNumber) -> (Domain -> Int) -> Domain -> SerialNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Domain] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Domain] -> Int) -> (Domain -> [Domain]) -> Domain -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> [Domain]
lines
	(Domain -> SerialNumber) -> IO Domain -> IO SerialNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> [Domain] -> IO Domain
readProcess Domain
"git" [Domain
"log", Domain
"--pretty=%H"]

-- | Write a Zone out to a to a file.
--
-- 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 :: Zone -> Domain -> IO ()
writeZoneFile Zone
z Domain
f = do
	SerialNumber
oldserial <- Domain -> IO SerialNumber
oldZoneFileSerialNumber Domain
f
	SerialNumber
offset <- IO SerialNumber
serialNumberOffset
	let z' :: Zone
z' = Zone -> SerialNumber -> Zone
nextSerialNumber
		(Zone -> (SerialNumber -> SerialNumber) -> Zone
adjustSerialNumber Zone
z (SerialNumber -> SerialNumber -> SerialNumber
forall a. Num a => a -> a -> a
+ SerialNumber
offset))
		SerialNumber
oldserial
	Bool -> Domain -> IO ()
createDirectoryIfMissing Bool
True (Domain -> Domain
takeDirectory Domain
f)
	Domain -> Domain -> IO ()
writeFile Domain
f (Zone -> Domain
genZoneFile Zone
z')
	Domain -> Zone -> IO ()
writeZonePropellorFile Domain
f Zone
z'

removeZoneFile :: FilePath -> IO ()
removeZoneFile :: Domain -> IO ()
removeZoneFile Domain
f = do
	Domain -> IO ()
nukeFile Domain
f
	Domain -> IO ()
nukeFile (Domain -> Domain
zonePropellorFile Domain
f)

-- | 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 :: Domain -> Domain
zonePropellorFile Domain
f = Domain
f Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
".propellor"

oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
oldZoneFileSerialNumber :: Domain -> IO SerialNumber
oldZoneFileSerialNumber = SerialNumber
-> (Zone -> SerialNumber) -> Maybe Zone -> SerialNumber
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SerialNumber
0 (SOA -> SerialNumber
sSerial (SOA -> SerialNumber) -> (Zone -> SOA) -> Zone -> SerialNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zone -> SOA
zSOA) (Maybe Zone -> SerialNumber)
-> (Domain -> IO (Maybe Zone)) -> Domain -> IO SerialNumber
forall (f :: * -> *) a b c.
Functor f =>
(a -> b) -> (c -> f a) -> c -> f b
<$$> Domain -> IO (Maybe Zone)
readZonePropellorFile

writeZonePropellorFile :: FilePath -> Zone -> IO ()
writeZonePropellorFile :: Domain -> Zone -> IO ()
writeZonePropellorFile Domain
f Zone
z = Domain -> Domain -> IO ()
writeFile (Domain -> Domain
zonePropellorFile Domain
f) (Zone -> Domain
forall a. Show a => a -> Domain
show Zone
z)

readZonePropellorFile :: FilePath -> IO (Maybe Zone)
readZonePropellorFile :: Domain -> IO (Maybe Zone)
readZonePropellorFile Domain
f = Maybe Zone -> IO (Maybe Zone) -> IO (Maybe Zone)
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Maybe Zone
forall a. Maybe a
Nothing (IO (Maybe Zone) -> IO (Maybe Zone))
-> IO (Maybe Zone) -> IO (Maybe Zone)
forall a b. (a -> b) -> a -> b
$
	Domain -> Maybe Zone
forall a. Read a => Domain -> Maybe a
readish (Domain -> Maybe Zone) -> IO Domain -> IO (Maybe Zone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain -> IO Domain
readFileStrict (Domain -> Domain
zonePropellorFile Domain
f)

-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile :: Zone -> Domain
genZoneFile (Zone Domain
zdomain SOA
soa [(BindDomain, Record)]
rs) = [Domain] -> Domain
unlines ([Domain] -> Domain) -> [Domain] -> Domain
forall a b. (a -> b) -> a -> b
$
	Domain
header Domain -> [Domain] -> [Domain]
forall a. a -> [a] -> [a]
: SOA -> [Domain]
genSOA SOA
soa [Domain] -> [Domain] -> [Domain]
forall a. [a] -> [a] -> [a]
++ ((BindDomain, Record) -> Maybe Domain)
-> [(BindDomain, Record)] -> [Domain]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Domain -> (BindDomain, Record) -> Maybe Domain
genRecord Domain
zdomain) [(BindDomain, Record)]
rs
  where
	header :: Domain
header = Domain -> Domain
com (Domain -> Domain) -> Domain -> Domain
forall a b. (a -> b) -> a -> b
$ Domain
"BIND zone file for " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
zdomain Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
". Generated by propellor, do not edit."

genRecord :: Domain -> (BindDomain, Record) -> Maybe String
genRecord :: Domain -> (BindDomain, Record) -> Maybe Domain
genRecord Domain
zdomain (BindDomain
domain, Record
record) = case (Record -> Maybe Domain
rField Record
record, Record -> Maybe Domain
rValue Record
record) of
	(Maybe Domain
Nothing, Maybe Domain
_) -> Maybe Domain
forall a. Maybe a
Nothing
	(Maybe Domain
_, Maybe Domain
Nothing) -> Maybe Domain
forall a. Maybe a
Nothing
	(Just Domain
rfield, Just Domain
rvalue) -> Domain -> Maybe Domain
forall a. a -> Maybe a
Just (Domain -> Maybe Domain) -> Domain -> Maybe Domain
forall a b. (a -> b) -> a -> b
$ Domain -> [Domain] -> Domain
forall a. [a] -> [[a]] -> [a]
intercalate Domain
"\t" ([Domain] -> Domain) -> [Domain] -> Domain
forall a b. (a -> b) -> a -> b
$ case Record
record of
		INCLUDE Domain
_ -> [ Domain
rfield, Domain
rvalue ]
		Record
_ ->
			[ Domain -> BindDomain -> Domain
domainHost Domain
zdomain BindDomain
domain
			, Domain
"IN"
			, Domain
rfield
			, Domain
rvalue
			]

genSOA :: SOA -> [String]
genSOA :: SOA -> [Domain]
genSOA SOA
soa =
	-- "@ IN SOA ns1.example.com. root ("
	[ Domain -> [Domain] -> Domain
forall a. [a] -> [[a]] -> [a]
intercalate Domain
"\t"
		[ BindDomain -> Domain
dValue BindDomain
RootDomain
		, Domain
"IN"
		, Domain
"SOA"
		, BindDomain -> Domain
dValue (SOA -> BindDomain
sDomain SOA
soa)
		, Domain
"root"
		, Domain
"("
		]
	, (SOA -> SerialNumber) -> Domain -> Domain
forall a. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> SerialNumber
sSerial Domain
"Serial"
	, (SOA -> Integer) -> Domain -> Domain
forall a. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sRefresh Domain
"Refresh"
	, (SOA -> Integer) -> Domain -> Domain
forall a. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sRetry Domain
"Retry"
	, (SOA -> Integer) -> Domain -> Domain
forall a. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sExpire Domain
"Expire"
	, (SOA -> Integer) -> Domain -> Domain
forall a. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sNegativeCacheTTL Domain
"Negative Cache TTL"
	, Domain -> Domain
inheader Domain
")"
	]
  where
	headerline :: (SOA -> a) -> Domain -> Domain
headerline SOA -> a
r Domain
comment = Domain -> Domain
inheader (Domain -> Domain) -> Domain -> Domain
forall a b. (a -> b) -> a -> b
$ a -> Domain
forall a. Show a => a -> Domain
show (SOA -> a
r SOA
soa) Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
"\t\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain -> Domain
com Domain
comment
	inheader :: Domain -> Domain
inheader Domain
l = Domain
"\t\t\t" Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
l

-- | Comment line in a zone file.
com :: String -> String
com :: Domain -> Domain
com Domain
s = Domain
"; " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
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.
--
-- Does not include SSHFP records.
genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage])
genZone :: [Host] -> Map Domain Host -> Domain -> SOA -> (Zone, [Domain])
genZone [Host]
inzdomain Map Domain Host
hostmap Domain
zdomain SOA
soa =
	let ([Domain]
warnings, [(BindDomain, Record)]
zhosts) = [Either Domain (BindDomain, Record)]
-> ([Domain], [(BindDomain, Record)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Domain (BindDomain, Record)]
 -> ([Domain], [(BindDomain, Record)]))
-> [Either Domain (BindDomain, Record)]
-> ([Domain], [(BindDomain, Record)])
forall a b. (a -> b) -> a -> b
$ ([[Either Domain (BindDomain, Record)]]
 -> [Either Domain (BindDomain, Record)])
-> [[[Either Domain (BindDomain, Record)]]]
-> [Either Domain (BindDomain, Record)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [[Either Domain (BindDomain, Record)]]
-> [Either Domain (BindDomain, Record)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
		[ (Host -> [Either Domain (BindDomain, Record)])
-> [Host] -> [[Either Domain (BindDomain, Record)]]
forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
hostips [Host]
inzdomain
		, (Host -> [Either Domain (BindDomain, Record)])
-> [Host] -> [[Either Domain (BindDomain, Record)]]
forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
hostrecords [Host]
inzdomain
		, (Host -> [Either Domain (BindDomain, Record)])
-> [Host] -> [[Either Domain (BindDomain, Record)]]
forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
addcnames (Map Domain Host -> [Host]
forall k a. Map k a -> [a]
M.elems Map Domain Host
hostmap)
		]
	in (Domain -> SOA -> [(BindDomain, Record)] -> Zone
Zone Domain
zdomain SOA
soa ([(BindDomain, Record)] -> [(BindDomain, Record)]
simplify [(BindDomain, Record)]
zhosts), [Domain]
warnings)
  where
	-- Each host with a hostname located in the zdomain
	-- should have 1 or more IPAddrs in its Info.
	--
	-- If a host lacks any IPAddr, it's probably a misconfiguration,
	-- so warn.
	hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
	hostips :: Host -> [Either Domain (BindDomain, Record)]
hostips Host
h
		| [(BindDomain, Record)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(BindDomain, Record)]
l = [Domain -> Either Domain (BindDomain, Record)
forall a b. a -> Either a b
Left (Domain -> Either Domain (BindDomain, Record))
-> Domain -> Either Domain (BindDomain, Record)
forall a b. (a -> b) -> a -> b
$ Domain
"no IP address defined for host " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Host -> Domain
hostName Host
h]
		| Bool
otherwise = ((BindDomain, Record) -> Either Domain (BindDomain, Record))
-> [(BindDomain, Record)] -> [Either Domain (BindDomain, Record)]
forall a b. (a -> b) -> [a] -> [b]
map (BindDomain, Record) -> Either Domain (BindDomain, Record)
forall a b. b -> Either a b
Right [(BindDomain, Record)]
l
	  where
		info :: Info
info = Host -> Info
hostInfo Host
h
		l :: [(BindDomain, Record)]
l = [BindDomain] -> [Record] -> [(BindDomain, Record)]
forall a b. [a] -> [b] -> [(a, b)]
zip (BindDomain -> [BindDomain]
forall a. a -> [a]
repeat (BindDomain -> [BindDomain]) -> BindDomain -> [BindDomain]
forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain (Domain -> BindDomain) -> Domain -> BindDomain
forall a b. (a -> b) -> a -> b
$ Host -> Domain
hostName Host
h)
			((IPAddr -> Record) -> [IPAddr] -> [Record]
forall a b. (a -> b) -> [a] -> [b]
map IPAddr -> Record
Address ([IPAddr] -> [Record]) -> [IPAddr] -> [Record]
forall a b. (a -> b) -> a -> b
$ Info -> [IPAddr]
getAddresses Info
info)

	-- Any host, whether its hostname is in the zdomain or not,
	-- 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, 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.
	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
	addcnames :: Host -> [Either Domain (BindDomain, Record)]
addcnames Host
h = (BindDomain -> [Either Domain (BindDomain, Record)])
-> [BindDomain] -> [Either Domain (BindDomain, Record)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BindDomain -> [Either Domain (BindDomain, Record)]
forall a. BindDomain -> [Either a (BindDomain, Record)]
gen ([BindDomain] -> [Either Domain (BindDomain, Record)])
-> [BindDomain] -> [Either Domain (BindDomain, Record)]
forall a b. (a -> b) -> a -> b
$ (BindDomain -> Bool) -> [BindDomain] -> [BindDomain]
forall a. (a -> Bool) -> [a] -> [a]
filter (Domain -> BindDomain -> Bool
inDomain Domain
zdomain) ([BindDomain] -> [BindDomain]) -> [BindDomain] -> [BindDomain]
forall a b. (a -> b) -> a -> b
$
		(Record -> Maybe BindDomain) -> [Record] -> [BindDomain]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Record -> Maybe BindDomain
getCNAME ([Record] -> [BindDomain]) -> [Record] -> [BindDomain]
forall a b. (a -> b) -> a -> b
$ Set Record -> [Record]
forall a. Set a -> [a]
S.toList (Set Record -> [Record]) -> Set Record -> [Record]
forall a b. (a -> b) -> a -> b
$ Info -> Set Record
getDnsInfo Info
info
	  where
		info :: Info
info = Host -> Info
hostInfo Host
h
		gen :: BindDomain -> [Either a (BindDomain, Record)]
gen BindDomain
c = case Info -> [IPAddr]
getAddresses Info
info of
			[] -> [Record -> Either a (BindDomain, Record)
forall b a. b -> Either a (BindDomain, b)
ret (BindDomain -> Record
CNAME BindDomain
c)]
			[IPAddr]
l -> (IPAddr -> Either a (BindDomain, Record))
-> [IPAddr] -> [Either a (BindDomain, Record)]
forall a b. (a -> b) -> [a] -> [b]
map (Record -> Either a (BindDomain, Record)
forall b a. b -> Either a (BindDomain, b)
ret (Record -> Either a (BindDomain, Record))
-> (IPAddr -> Record) -> IPAddr -> Either a (BindDomain, Record)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPAddr -> Record
Address) [IPAddr]
l
		  where
			ret :: b -> Either a (BindDomain, b)
ret b
record = (BindDomain, b) -> Either a (BindDomain, b)
forall a b. b -> Either a b
Right (BindDomain
c, b
record)

	-- Adds any other DNS records for a host located in the zdomain.
	hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
	hostrecords :: Host -> [Either Domain (BindDomain, Record)]
hostrecords Host
h = ((BindDomain, Record) -> Either Domain (BindDomain, Record))
-> [(BindDomain, Record)] -> [Either Domain (BindDomain, Record)]
forall a b. (a -> b) -> [a] -> [b]
map (BindDomain, Record) -> Either Domain (BindDomain, Record)
forall a b. b -> Either a b
Right [(BindDomain, Record)]
l
	  where
		info :: Info
info = Host -> Info
hostInfo Host
h
		l :: [(BindDomain, Record)]
l = [BindDomain] -> [Record] -> [(BindDomain, Record)]
forall a b. [a] -> [b] -> [(a, b)]
zip (BindDomain -> [BindDomain]
forall a. a -> [a]
repeat (BindDomain -> [BindDomain]) -> BindDomain -> [BindDomain]
forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain (Domain -> BindDomain) -> Domain -> BindDomain
forall a b. (a -> b) -> a -> b
$ Host -> Domain
hostName Host
h)
			(Set Record -> [Record]
forall a. Set a -> [a]
S.toList (Set Record -> [Record]) -> Set Record -> [Record]
forall a b. (a -> b) -> a -> b
$ (Record -> Bool) -> Set Record -> Set Record
forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Record
r -> Maybe IPAddr -> Bool
forall a. Maybe a -> Bool
isNothing (Record -> Maybe IPAddr
getIPAddr Record
r) Bool -> Bool -> Bool
&& Maybe BindDomain -> Bool
forall a. Maybe a -> Bool
isNothing (Record -> Maybe BindDomain
getCNAME Record
r)) (Info -> Set Record
getDnsInfo Info
info))

	-- Simplifies the list of hosts. Remove duplicate entries.
	-- Also, filter out any CHAMES where the same domain has an
	-- IP address, since that's not legal.
	simplify :: [(BindDomain, Record)] -> [(BindDomain, Record)]
	simplify :: [(BindDomain, Record)] -> [(BindDomain, Record)]
simplify [(BindDomain, Record)]
l = [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. Eq a => [a] -> [a]
nub ([(BindDomain, Record)] -> [(BindDomain, Record)])
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a b. (a -> b) -> a -> b
$ ((BindDomain, Record) -> Bool)
-> [(BindDomain, Record)] -> [(BindDomain, Record)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((BindDomain, Record) -> Bool) -> (BindDomain, Record) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BindDomain, Record) -> Bool
dupcname ) [(BindDomain, Record)]
l
	  where
		dupcname :: (BindDomain, Record) -> Bool
dupcname (BindDomain
d, CNAME BindDomain
_) | ((BindDomain, Record) -> Bool) -> [(BindDomain, Record)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (BindDomain -> (BindDomain, Record) -> Bool
forall a. Eq a => a -> (a, Record) -> Bool
matchingaddr BindDomain
d) [(BindDomain, Record)]
l = Bool
True
		dupcname (BindDomain, Record)
_ = Bool
False
		matchingaddr :: a -> (a, Record) -> Bool
matchingaddr a
d (a
d', (Address IPAddr
_)) | a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d' = Bool
True
		matchingaddr a
_ (a, Record)
_ = Bool
False

inDomain :: Domain -> BindDomain -> Bool
inDomain :: Domain -> BindDomain -> Bool
inDomain Domain
domain (AbsDomain Domain
d) = Domain
domain Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
== Domain
d Bool -> Bool -> Bool
|| (Char
'.'Char -> Domain -> Domain
forall a. a -> [a] -> [a]
:Domain
domain) Domain -> Domain -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Domain
d
inDomain Domain
_ BindDomain
_ = Bool
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 :: Domain -> BindDomain -> Domain
domainHost Domain
_ (RelDomain Domain
d) = Domain
d
domainHost Domain
_ BindDomain
RootDomain = Domain
"@"
domainHost Domain
base (AbsDomain Domain
d)
	| Domain
dotbase Domain -> Domain -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Domain
d = Int -> Domain -> Domain
forall a. Int -> [a] -> [a]
take (Domain -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Domain
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Domain -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Domain
dotbase) Domain
d
	| Domain
base Domain -> Domain -> Bool
forall a. Eq a => a -> a -> Bool
== Domain
d = Domain
"@"
	| Bool
otherwise = Domain
d
  where
	dotbase :: Domain
dotbase = Char
'.'Char -> Domain -> Domain
forall a. a -> [a] -> [a]
:Domain
base

addNamedConf :: NamedConf -> NamedConfMap
addNamedConf :: NamedConf -> NamedConfMap
addNamedConf NamedConf
conf = Map Domain NamedConf -> NamedConfMap
NamedConfMap (Domain -> NamedConf -> Map Domain NamedConf
forall k a. k -> a -> Map k a
M.singleton Domain
domain NamedConf
conf)
  where
	domain :: Domain
domain = NamedConf -> Domain
confDomain NamedConf
conf

getNamedConf :: Propellor (M.Map Domain NamedConf)
getNamedConf :: Propellor (Map Domain NamedConf)
getNamedConf = (Host -> Map Domain NamedConf) -> Propellor (Map Domain NamedConf)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Host -> Map Domain NamedConf)
 -> Propellor (Map Domain NamedConf))
-> (Host -> Map Domain NamedConf)
-> Propellor (Map Domain NamedConf)
forall a b. (a -> b) -> a -> b
$ NamedConfMap -> Map Domain NamedConf
fromNamedConfMap (NamedConfMap -> Map Domain NamedConf)
-> (Host -> NamedConfMap) -> Host -> Map Domain NamedConf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> NamedConfMap
forall v. IsInfo v => Info -> v
fromInfo (Info -> NamedConfMap) -> (Host -> Info) -> Host -> NamedConfMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo

-- | Generates SSHFP records for hosts in the domain (or with CNAMES
-- in the domain) that have configured ssh public keys.
--
-- This is done using ssh-keygen, so sadly needs IO.
genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]
genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]
genSSHFP Domain
domain Host
h = (Record -> [(BindDomain, Record)])
-> [Record] -> [(BindDomain, Record)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Record -> [(BindDomain, Record)]
forall b. b -> [(BindDomain, b)]
mk ([Record] -> [(BindDomain, Record)])
-> ([[Record]] -> [Record]) -> [[Record]] -> [(BindDomain, Record)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Record]] -> [Record]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Record]] -> [(BindDomain, Record)])
-> Propellor [[Record]] -> Propellor [(BindDomain, Record)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Map SshKeyType Domain) -> Propellor [[Record]]
forall k. Maybe (Map k Domain) -> Propellor [[Record]]
gen (Maybe (Map SshKeyType Domain) -> Propellor [[Record]])
-> Propellor (Maybe (Map SshKeyType Domain))
-> Propellor [[Record]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Propellor (Maybe (Map SshKeyType Domain))
get)
  where
	get :: Propellor (Maybe (Map SshKeyType Domain))
get = [Host]
-> Domain
-> Propellor (Map SshKeyType Domain)
-> Propellor (Maybe (Map SshKeyType Domain))
forall a. [Host] -> Domain -> Propellor a -> Propellor (Maybe a)
fromHost [Host
h] Domain
hostname Propellor (Map SshKeyType Domain)
Ssh.getHostPubKey
	gen :: Maybe (Map k Domain) -> Propellor [[Record]]
gen = IO [[Record]] -> Propellor [[Record]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Record]] -> Propellor [[Record]])
-> (Maybe (Map k Domain) -> IO [[Record]])
-> Maybe (Map k Domain)
-> Propellor [[Record]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Domain -> IO [Record]) -> [Domain] -> IO [[Record]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Domain -> IO [Record]
genSSHFP' ([Domain] -> IO [[Record]])
-> (Maybe (Map k Domain) -> [Domain])
-> Maybe (Map k Domain)
-> IO [[Record]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k Domain -> [Domain]
forall k a. Map k a -> [a]
M.elems (Map k Domain -> [Domain])
-> (Maybe (Map k Domain) -> Map k Domain)
-> Maybe (Map k Domain)
-> [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k Domain -> Maybe (Map k Domain) -> Map k Domain
forall a. a -> Maybe a -> a
fromMaybe Map k Domain
forall k a. Map k a
M.empty
	mk :: b -> [(BindDomain, b)]
mk b
r = (BindDomain -> Maybe (BindDomain, b))
-> [BindDomain] -> [(BindDomain, b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\BindDomain
d -> if Domain -> BindDomain -> Bool
inDomain Domain
domain BindDomain
d then (BindDomain, b) -> Maybe (BindDomain, b)
forall a. a -> Maybe a
Just (BindDomain
d, b
r) else Maybe (BindDomain, b)
forall a. Maybe a
Nothing)
		(Domain -> BindDomain
AbsDomain Domain
hostname BindDomain -> [BindDomain] -> [BindDomain]
forall a. a -> [a] -> [a]
: [BindDomain]
cnames)
	cnames :: [BindDomain]
cnames = (Record -> Maybe BindDomain) -> [Record] -> [BindDomain]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Record -> Maybe BindDomain
getCNAME ([Record] -> [BindDomain]) -> [Record] -> [BindDomain]
forall a b. (a -> b) -> a -> b
$ Set Record -> [Record]
forall a. Set a -> [a]
S.toList (Set Record -> [Record]) -> Set Record -> [Record]
forall a b. (a -> b) -> a -> b
$ Info -> Set Record
getDnsInfo Info
info
	hostname :: Domain
hostname = Host -> Domain
hostName Host
h
	info :: Info
info = Host -> Info
hostInfo Host
h

genSSHFP' :: String -> IO [Record]
genSSHFP' :: Domain -> IO [Record]
genSSHFP' Domain
pubkey = Domain -> (Domain -> Handle -> IO [Record]) -> IO [Record]
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Domain -> (Domain -> Handle -> m a) -> m a
withTmpFile Domain
"sshfp" ((Domain -> Handle -> IO [Record]) -> IO [Record])
-> (Domain -> Handle -> IO [Record]) -> IO [Record]
forall a b. (a -> b) -> a -> b
$ \Domain
tmp Handle
tmph -> do
		Handle -> Domain -> IO ()
hPutStrLn Handle
tmph Domain
pubkey
		Handle -> IO ()
hClose Handle
tmph
		Domain
s <- Domain -> IO Domain -> IO Domain
forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Domain
"" (IO Domain -> IO Domain) -> IO Domain -> IO Domain
forall a b. (a -> b) -> a -> b
$
			Domain -> [Domain] -> IO Domain
readProcess Domain
"ssh-keygen" [Domain
"-r", Domain
"dummy", Domain
"-f", Domain
tmp]
		[Record] -> IO [Record]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Record] -> IO [Record]) -> [Record] -> IO [Record]
forall a b. (a -> b) -> a -> b
$ (Domain -> Maybe Record) -> [Domain] -> [Record]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Domain] -> Maybe Record
parse ([Domain] -> Maybe Record)
-> (Domain -> [Domain]) -> Domain -> Maybe Record
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> [Domain]
words) ([Domain] -> [Record]) -> [Domain] -> [Record]
forall a b. (a -> b) -> a -> b
$ Domain -> [Domain]
lines Domain
s
  where
	parse :: [Domain] -> Maybe Record
parse (Domain
"dummy":Domain
"IN":Domain
"SSHFP":Domain
x:Domain
y:Domain
s:[]) = do
		Int
x' <- Domain -> Maybe Int
forall a. Read a => Domain -> Maybe a
readish Domain
x
		Int
y' <- Domain -> Maybe Int
forall a. Read a => Domain -> Maybe a
readish Domain
y
		Record -> Maybe Record
forall (m :: * -> *) a. Monad m => a -> m a
return (Record -> Maybe Record) -> Record -> Maybe Record
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Domain -> Record
SSHFP Int
x' Int
y' Domain
s
	parse [Domain]
_ = Maybe Record
forall a. Maybe a
Nothing