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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
primary [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
  (Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
setup = Domain
-> (Domain -> Domain)
-> [Host]
-> Domain
-> SOA
-> [(BindDomain, Record)]
-> Property
     (HasInfo
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setupPrimary Domain
zonefile forall a. a -> a
id [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Service.reloaded Domain
"bind9"
	cleanup :: CombinedType
  (Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
  (Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
cleanup = Domain
-> Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanupPrimary Domain
zonefile Domain
domain
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Service.reloaded Domain
"bind9"

	zonefile :: Domain
zonefile = Domain
"/etc/bind/propellor/db." 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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setupPrimary Domain
zonefile Domain -> Domain
mknamedconffile [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs =
	forall {metatypes}. Property metatypes -> Property metatypes
withwarnings Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
baseprop
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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 = forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$ forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Domain
hn Host
_ -> Domain -> BindDomain -> Bool
inDomain Domain
domain forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain 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
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
primaryprop
		forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
`setInfoProperty` (forall v. IsInfo v => v -> Info
toInfo (NamedConf -> NamedConfMap
addNamedConf NamedConf
conf))
	primaryprop :: Property DebianLike
	primaryprop :: Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
primaryprop = forall {k} (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property (Domain
"dns primary for " forall a. [a] -> [a] -> [a]
++ Domain
domain) forall a b. (a -> b) -> a -> b
$ do
		[(BindDomain, Record)]
sshfps <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) (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 forall a. [a] -> [a] -> [a]
++ [(BindDomain, Record)]
rs forall a. [a] -> [a] -> [a]
++ [(BindDomain, Record)]
sshfps }
		forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Zone -> IO Bool
needupdate Zone
zone)
			( IO () -> Propellor Result
makeChange 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 = forall metatypes.
Property metatypes
-> (Propellor Result -> Propellor Result) -> Property metatypes
adjustPropertySatisfy Property metatypes
p forall a b. (a -> b) -> a -> b
$ \Propellor Result
a -> do
		forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). MonadIO m => Domain -> m ()
warningMessage forall a b. (a -> b) -> a -> b
$ [Domain]
zonewarnings forall a. [a] -> [a] -> [a]
++ [Domain]
secondarywarnings
		Propellor Result
a
	conf :: NamedConf
conf = 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 = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
			forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Domain -> [Host] -> [IPAddr]
`hostAddresses` [Host]
hosts) forall a b. (a -> b) -> a -> b
$
				[Domain]
secondaries 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 = forall a b. (a -> b) -> [a] -> [b]
map (\Domain
h -> Domain
"No IP address defined for DNS seconary " forall a. [a] -> [a] -> [a]
++ Domain
h) forall a b. (a -> b) -> a -> b
$
		forall a. (a -> Bool) -> [a] -> [a]
filter (\Domain
h -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Domain -> [Host] -> [IPAddr]
hostAddresses Domain
h [Host]
hosts)) [Domain]
secondaries
	nssecondaries :: [Domain]
nssecondaries = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (BindDomain -> Maybe Domain
domainHostName 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$
		forall a. (a -> Bool) -> [a] -> [a]
filter (\(BindDomain
d, Record
_r) -> BindDomain
d forall a. Eq a => a -> a -> Bool
== BindDomain
RootDomain Bool -> Bool -> Bool
|| BindDomain
d 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
		forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
/= Zone
oldzone Bool -> Bool -> Bool
|| SerialNumber
oldserial forall a. Ord a => a -> a -> Bool
< SOA -> SerialNumber
sSerial (Zone -> SOA
zSOA Zone
zone)


cleanupPrimary :: FilePath -> Domain -> Property DebianLike
cleanupPrimary :: Domain
-> Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanupPrimary Domain
zonefile Domain
domain = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Domain -> IO Bool
doesFileExist Domain
zonefile) forall a b. (a -> b) -> a -> b
$
	Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
namedConfWritten
  where
	desc :: Domain
desc = Domain
"removed dns primary for " forall a. [a] -> [a] -> [a]
++ Domain
domain
	go :: Property DebianLike
	go :: Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go = forall {k} (metatypes :: k).
SingI metatypes =>
Domain -> Propellor Result -> Property (MetaTypes metatypes)
property Domain
desc (IO () -> Propellor Result
makeChange 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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
signedPrimary Recurrance
recurrance [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        (Combine
           (Combine
              (Combine
                 '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                    'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                 '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
              '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                 'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])))
  (Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
setup = forall {k} (metatypes :: k).
SingI metatypes =>
Domain
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties (Domain
"dns primary for " forall a. [a] -> [a] -> [a]
++ Domain
domain forall a. [a] -> [a] -> [a]
++ Domain
" (signed)")
		(Props UnixLike
props
			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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setupPrimary Domain
zonefile Domain -> Domain
signedZoneFile [Host]
hosts Domain
domain SOA
soa [(BindDomain, Record)]
rs'
			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
			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 forall i. Property i -> Recurrance -> Property i
`period` Recurrance
recurrance
		)
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Service.reloaded Domain
"bind9"

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

	-- Include the public keys into the zone file.
	rs' :: [(BindDomain, Record)]
rs' = DnsSecKey -> (BindDomain, Record)
include DnsSecKey
PubKSK forall a. a -> [a] -> [a]
: DnsSecKey -> (BindDomain, Record)
include DnsSecKey
PubZSK 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." 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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
secondary [Host]
hosts Domain
domain = [Domain]
-> [Host]
-> Domain
-> RevertableProperty
     (HasInfo
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
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
      + MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
secondaryFor [Domain]
masters [Host]
hosts Domain
domain = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanup
  where
	setup :: CombinedType
  (Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
  (Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
setup = forall v. IsInfo v => Domain -> v -> Property (HasInfo + UnixLike)
pureInfoProperty Domain
desc (NamedConf -> NamedConfMap
addNamedConf NamedConf
conf)
		forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
servingZones
	cleanup :: Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
cleanup = Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
namedConfWritten

	desc :: Domain
desc = Domain
"dns secondary for " forall a. [a] -> [a] -> [a]
++ Domain
domain
	conf :: NamedConf
conf = NamedConf
		{ confDomain :: Domain
confDomain = Domain
domain
		, confDnsServerType :: DnsServerType
confDnsServerType = DnsServerType
Secondary
		, confFile :: Domain
confFile = Domain
"db." forall a. [a] -> [a] -> [a]
++ Domain
domain
		, confMasters :: [IPAddr]
confMasters = 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 =
	forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter Host -> Bool
wanted forall a b. (a -> b) -> a -> b
$ [Host] -> Map Domain Host
hostMap [Host]
hosts
  where
	wanted :: Host -> Bool
wanted Host
h = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Domain
domain (NamedConfMap -> Map Domain NamedConf
fromNamedConfMap forall a b. (a -> b) -> a -> b
$ forall v. IsInfo v => Info -> v
fromInfo 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 forall a. Eq a => a -> a -> Bool
== DnsServerType
wantedtype
			Bool -> Bool -> Bool
&& NamedConf -> Domain
confDomain NamedConf
conf 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
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
servingZones = Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
namedConfWritten
	forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Service.reloaded Domain
"bind9"
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Domain
-> Property
     (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.serviceInstalledRunning Domain
"bind9"

namedConfWritten :: Property DebianLike
namedConfWritten :: Property
  (MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
namedConfWritten = forall {k} (metatypes :: k).
SingI metatypes =>
Domain
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' Domain
"named.conf configured" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
	Map Domain NamedConf
zs <- Propellor (Map Domain NamedConf)
getNamedConf
	forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$
		Domain -> [Domain] -> Property UnixLike
hasContent Domain
namedConfFile forall a b. (a -> b) -> a -> b
$
			forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NamedConf -> [Domain]
confStanza forall a b. (a -> b) -> a -> b
$ 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 \"" forall a. [a] -> [a] -> [a]
++ NamedConf -> Domain
confDomain NamedConf
c forall a. [a] -> [a] -> [a]
++ Domain
"\" {"
	, Domain -> Domain -> Domain
cfgline Domain
"type" (if NamedConf -> DnsServerType
confDnsServerType NamedConf
c forall a. Eq a => a -> a -> Bool
== DnsServerType
Master then Domain
"master" else Domain
"slave")
	, Domain -> Domain -> Domain
cfgline Domain
"file" (Domain
"\"" forall a. [a] -> [a] -> [a]
++ NamedConf -> Domain
confFile NamedConf
c forall a. [a] -> [a] -> [a]
++ Domain
"\"")
	] forall a. [a] -> [a] -> [a]
++
	[Domain]
mastersblock forall a. [a] -> [a] -> [a]
++
	[Domain]
allowtransferblock forall a. [a] -> [a] -> [a]
++
	(forall a b. (a -> b) -> [a] -> [b]
map (\Domain
l -> Domain
"\t" forall a. [a] -> [a] -> [a]
++ Domain
l forall a. [a] -> [a] -> [a]
++ Domain
";") (NamedConf -> [Domain]
confLines NamedConf
c)) forall a. [a] -> [a] -> [a]
++
	[ Domain
"};"
	, Domain
""
	]
  where
	cfgline :: Domain -> Domain -> Domain
cfgline Domain
f Domain
v = Domain
"\t" forall a. [a] -> [a] -> [a]
++ Domain
f forall a. [a] -> [a] -> [a]
++ Domain
" " forall a. [a] -> [a] -> [a]
++ Domain
v forall a. [a] -> [a] -> [a]
++ Domain
";"
	ipblock :: Domain -> [t] -> [Domain]
ipblock Domain
name [t]
l =
		[ Domain
"\t" forall a. [a] -> [a] -> [a]
++ Domain
name forall a. [a] -> [a] -> [a]
++ Domain
" {" ] forall a. [a] -> [a] -> [a]
++
		(forall a b. (a -> b) -> [a] -> [b]
map (\t
ip -> Domain
"\t\t" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> Domain
val t
ip forall a. [a] -> [a] -> [a]
++ Domain
";") [t]
l) forall a. [a] -> [a] -> [a]
++
		[ Domain
"\t};" ]
	mastersblock :: [Domain]
mastersblock
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NamedConf -> [IPAddr]
confMasters NamedConf
c) = []
		| Bool
otherwise = forall {t}. ConfigurableValue t => Domain -> [t] -> [Domain]
ipblock Domain
"masters" (NamedConf -> [IPAddr]
confMasters NamedConf
c)
	-- an empty block prohibits any transfers
	allowtransferblock :: [Domain]
allowtransferblock = 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
	{ sDomain :: BindDomain
sDomain = Domain -> BindDomain
AbsDomain Domain
d
	, sSerial :: SerialNumber
sSerial = SerialNumber
sn
	, sRefresh :: Integer
sRefresh = forall {a}. Num a => a -> a
hours Integer
4
	, sRetry :: Integer
sRetry = forall {a}. Num a => a -> a
hours Integer
1
	, sExpire :: Integer
sExpire = Integer
2419200 -- 4 weeks
	, sNegativeCacheTTL :: Integer
sNegativeCacheTTL = forall {a}. Num a => a -> a
hours Integer
8
	}
  where
	hours :: a -> a
hours a
n = a
n forall a. Num a => a -> a -> a
* a
60 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 forall a. [a] -> [a] -> [a]
++ Domain
"."
dValue (BindDomain
RootDomain) = Domain
"@"

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

rValue :: Record -> Maybe String
rValue :: Record -> Maybe Domain
rValue (Address (IPv4 Domain
addr)) = forall a. a -> Maybe a
Just Domain
addr
rValue (Address (IPv6 Domain
addr)) = forall a. a -> Maybe a
Just Domain
addr
rValue (CNAME BindDomain
d) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BindDomain -> Domain
dValue BindDomain
d
rValue (MX Int
pri BindDomain
d) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall t. ConfigurableValue t => t -> Domain
val Int
pri forall a. [a] -> [a] -> [a]
++ Domain
" " forall a. [a] -> [a] -> [a]
++ BindDomain -> Domain
dValue BindDomain
d
rValue (NS BindDomain
d) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BindDomain -> Domain
dValue BindDomain
d
rValue (SRV Word16
priority Word16
weight Word16
port BindDomain
target) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Domain] -> Domain
unwords
	[ forall t. ConfigurableValue t => t -> Domain
val Word16
priority
	, forall t. ConfigurableValue t => t -> Domain
val Word16
weight
	, forall t. ConfigurableValue t => t -> Domain
val Word16
port
	, BindDomain -> Domain
dValue BindDomain
target
	]
rValue (SSHFP Int
x Int
y Domain
s) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Domain] -> Domain
unwords
	[ forall t. ConfigurableValue t => t -> Domain
val Int
x
	, forall t. ConfigurableValue t => t -> Domain
val Int
y
	, Domain
s
	]
rValue (INCLUDE Domain
f) = forall a. a -> Maybe a
Just Domain
f
rValue (TXT Domain
s) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Domain -> Domain
zoneFileString Domain
s
rValue (PTR 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	[ [Char
op, Char
w]
	, (forall a. [a] -> [[a]] -> [a]
intercalate Domain
"\n\t" forall a b. (a -> b) -> a -> b
$
		forall a b. (a -> b) -> [a] -> [b]
map (\Domain
x -> [Char
q] forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
q) Domain
x forall a. [a] -> [a] -> [a]
++ [Char
q]) forall a b. (a -> b) -> a -> b
$
		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 forall a b. (a -> b) -> a -> b
$ \SerialNumber
sn -> forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> [Domain]
lines
	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 (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 forall a. [a] -> [a] -> [a]
++ Domain
".propellor"

oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
oldZoneFileSerialNumber :: Domain -> IO SerialNumber
oldZoneFileSerialNumber = forall b a. b -> (a -> b) -> Maybe a -> b
maybe SerialNumber
0 (SOA -> SerialNumber
sSerial forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zone -> SOA
zSOA) 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) (forall a. Show a => a -> Domain
show Zone
z)

readZonePropellorFile :: FilePath -> IO (Maybe Zone)
readZonePropellorFile :: Domain -> IO (Maybe Zone)
readZonePropellorFile Domain
f = forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$
	forall a. Read a => Domain -> Maybe a
readish 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 forall a b. (a -> b) -> a -> b
$
	Domain
header forall a. a -> [a] -> [a]
: SOA -> [Domain]
genSOA SOA
soa forall a. [a] -> [a] -> [a]
++ 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 forall a b. (a -> b) -> a -> b
$ Domain
"BIND zone file for " forall a. [a] -> [a] -> [a]
++ Domain
zdomain 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
_) -> forall a. Maybe a
Nothing
	(Maybe Domain
_, Maybe Domain
Nothing) -> forall a. Maybe a
Nothing
	(Just Domain
rfield, Just Domain
rvalue) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate Domain
"\t" 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 ("
	[ 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
"("
		]
	, forall {a}. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> SerialNumber
sSerial Domain
"Serial"
	, forall {a}. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sRefresh Domain
"Refresh"
	, forall {a}. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sRetry Domain
"Retry"
	, forall {a}. Show a => (SOA -> a) -> Domain -> Domain
headerline SOA -> Integer
sExpire Domain
"Expire"
	, 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Domain
show (SOA -> a
r SOA
soa) forall a. [a] -> [a] -> [a]
++ Domain
"\t\t" forall a. [a] -> [a] -> [a]
++ Domain -> Domain
com Domain
comment
	inheader :: Domain -> Domain
inheader Domain
l = Domain
"\t\t\t" forall a. [a] -> [a] -> [a]
++ Domain
l

-- | Comment line in a zone file.
com :: String -> String
com :: Domain -> Domain
com Domain
s = 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) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
		[ forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
hostips [Host]
inzdomain
		, forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
hostrecords [Host]
inzdomain
		, forall a b. (a -> b) -> [a] -> [b]
map Host -> [Either Domain (BindDomain, Record)]
addcnames (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
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(BindDomain, Record)]
l = [forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Domain
"no IP address defined for host " forall a. [a] -> [a] -> [a]
++ Host -> Domain
hostName Host
h]
		| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [(BindDomain, Record)]
l
	  where
		info :: Info
info = Host -> Info
hostInfo Host
h
		l :: [(BindDomain, Record)]
l = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain forall a b. (a -> b) -> a -> b
$ Host -> Domain
hostName Host
h)
			(forall a b. (a -> b) -> [a] -> [b]
map IPAddr -> Record
Address 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. BindDomain -> [Either a (BindDomain, Record)]
gen forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Domain -> BindDomain -> Bool
inDomain Domain
zdomain) forall a b. (a -> b) -> a -> b
$
		forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Record -> Maybe BindDomain
getCNAME forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList 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
			[] -> [forall {b} {a}. b -> Either a (BindDomain, b)
ret (BindDomain -> Record
CNAME BindDomain
c)]
			[IPAddr]
l -> forall a b. (a -> b) -> [a] -> [b]
map (forall {b} {a}. b -> Either a (BindDomain, b)
ret 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 = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right [(BindDomain, Record)]
l
	  where
		info :: Info
info = Host -> Info
hostInfo Host
h
		l :: [(BindDomain, Record)]
l = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat forall a b. (a -> b) -> a -> b
$ Domain -> BindDomain
AbsDomain forall a b. (a -> b) -> a -> b
$ Host -> Domain
hostName Host
h)
			(forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Set a -> Set a
S.filter (\Record
r -> forall a. Maybe a -> Bool
isNothing (Record -> Maybe IPAddr
getIPAddr Record
r) Bool -> Bool -> 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 = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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
_) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (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 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 forall a. Eq a => a -> a -> Bool
== Domain
d Bool -> Bool -> Bool
|| (Char
'.'forall a. a -> [a] -> [a]
:Domain
domain) 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 forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Domain
d = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length Domain
d forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length Domain
dotbase) Domain
d
	| Domain
base forall a. Eq a => a -> a -> Bool
== Domain
d = Domain
"@"
	| Bool
otherwise = Domain
d
  where
	dotbase :: Domain
dotbase = Char
'.'forall a. a -> [a] -> [a]
:Domain
base

addNamedConf :: NamedConf -> NamedConfMap
addNamedConf :: NamedConf -> NamedConfMap
addNamedConf NamedConf
conf = Map Domain NamedConf -> NamedConfMap
NamedConfMap (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 = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ NamedConfMap -> Map Domain NamedConf
fromNamedConfMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. b -> [(BindDomain, b)]
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {k}. Maybe (Map k Domain) -> Propellor [[Record]]
gen 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 = 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Domain -> IO [Record]
genSSHFP' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
M.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty
	mk :: b -> [(BindDomain, b)]
mk b
r = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\BindDomain
d -> if Domain -> BindDomain -> Bool
inDomain Domain
domain BindDomain
d then forall a. a -> Maybe a
Just (BindDomain
d, b
r) else forall a. Maybe a
Nothing)
		(Domain -> BindDomain
AbsDomain Domain
hostname forall a. a -> [a] -> [a]
: [BindDomain]
cnames)
	cnames :: [BindDomain]
cnames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Record -> Maybe BindDomain
getCNAME forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList 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 = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Domain -> (Domain -> Handle -> m a) -> m a
withTmpFile Domain
"sshfp" 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 <- forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO Domain
"" forall a b. (a -> b) -> a -> b
$
			Domain -> [Domain] -> IO Domain
readProcess Domain
"ssh-keygen" [Domain
"-r", Domain
"dummy", Domain
"-f", Domain
tmp]
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Domain] -> Maybe Record
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> [Domain]
words) 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' <- forall a. Read a => Domain -> Maybe a
readish Domain
x
		Int
y' <- forall a. Read a => Domain -> Maybe a
readish Domain
y
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Int -> Domain -> Record
SSHFP Int
x' Int
y' Domain
s
	parse [Domain]
_ = forall a. Maybe a
Nothing