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 :: [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
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 ->
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)
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"
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))
zonefile :: Domain
zonefile = Domain
"/etc/bind/propellor/dnssec/db." Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
domain
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
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
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)
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"
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
, 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
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
'"'
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) }
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"]
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)
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)
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 =
[ 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
com :: String -> String
com :: Domain -> Domain
com Domain
s = Domain
"; " Domain -> Domain -> Domain
forall a. [a] -> [a] -> [a]
++ Domain
s
type WarningMessage = String
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
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)
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)
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))
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
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
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