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