DNS records for hosts with known ssh public keys now automatically include SSHFP records.
This commit is contained in:
parent
302fb3183f
commit
8e442f0656
|
@ -2,6 +2,8 @@ propellor (1.3.1) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
* Fix bug that prevented deploying ssh host keys when the file for the
|
* Fix bug that prevented deploying ssh host keys when the file for the
|
||||||
key didn't already exist.
|
key didn't already exist.
|
||||||
|
* DNS records for hosts with known ssh public keys now automatically
|
||||||
|
include SSHFP records.
|
||||||
|
|
||||||
-- Joey Hess <id@joeyh.name> Sun, 04 Jan 2015 18:19:30 -0400
|
-- Joey Hess <id@joeyh.name> Sun, 04 Jan 2015 18:19:30 -0400
|
||||||
|
|
||||||
|
|
|
@ -64,6 +64,7 @@ addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
|
||||||
rdesc (NS d) = unwords ["NS", ddesc d]
|
rdesc (NS d) = unwords ["NS", ddesc d]
|
||||||
rdesc (TXT s) = unwords ["TXT", s]
|
rdesc (TXT s) = unwords ["TXT", s]
|
||||||
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
|
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
|
||||||
|
rdesc (SSHFP x y s) = unwords ["SSHFP", show x, show y, s]
|
||||||
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
|
rdesc (INCLUDE f) = unwords ["$INCLUDE", f]
|
||||||
|
|
||||||
ddesc (AbsDomain domain) = domain
|
ddesc (AbsDomain domain) = domain
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Propellor
|
||||||
import Propellor.Types.Dns
|
import Propellor.Types.Dns
|
||||||
import Propellor.Property.File
|
import Propellor.Property.File
|
||||||
import qualified Propellor.Property.Apt as Apt
|
import qualified Propellor.Property.Apt as Apt
|
||||||
|
import qualified Propellor.Property.Ssh as Ssh
|
||||||
import qualified Propellor.Property.Service as Service
|
import qualified Propellor.Property.Service as Service
|
||||||
import Propellor.Property.Scheduled
|
import Propellor.Property.Scheduled
|
||||||
import Propellor.Property.DnsSec
|
import Propellor.Property.DnsSec
|
||||||
|
@ -65,17 +66,28 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
|
||||||
|
|
||||||
setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
|
setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
|
||||||
setupPrimary zonefile mknamedconffile hosts domain soa rs =
|
setupPrimary zonefile mknamedconffile hosts domain soa rs =
|
||||||
withwarnings (check needupdate baseprop)
|
withwarnings baseprop
|
||||||
`requires` servingZones
|
`requires` servingZones
|
||||||
where
|
where
|
||||||
(partialzone, zonewarnings) = genZone hosts domain soa
|
hostmap = hostMap hosts
|
||||||
zone = partialzone { zHosts = zHosts partialzone ++ rs }
|
-- Known hosts with hostname located in the domain.
|
||||||
baseprop = Property ("dns primary for " ++ domain)
|
indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
|
||||||
(makeChange $ writeZoneFile zone zonefile)
|
|
||||||
|
(partialzone, zonewarnings) = genZone indomain hostmap domain soa
|
||||||
|
baseprop = Property ("dns primary for " ++ domain) satisfy
|
||||||
(addNamedConf conf)
|
(addNamedConf conf)
|
||||||
withwarnings p = adjustProperty p $ \satisfy -> do
|
satisfy = do
|
||||||
|
sshfps <- zip (repeat (AbsDomain domain)) . concat
|
||||||
|
<$> mapM genSSHFP indomain
|
||||||
|
let zone = partialzone
|
||||||
|
{ zHosts = zHosts partialzone ++ rs ++ sshfps }
|
||||||
|
ifM (liftIO $ needupdate zone)
|
||||||
|
( makeChange $ writeZoneFile zone zonefile
|
||||||
|
, noChange
|
||||||
|
)
|
||||||
|
withwarnings p = adjustProperty p $ \a -> do
|
||||||
mapM_ warningMessage $ zonewarnings ++ secondarywarnings
|
mapM_ warningMessage $ zonewarnings ++ secondarywarnings
|
||||||
satisfy
|
a
|
||||||
conf = NamedConf
|
conf = NamedConf
|
||||||
{ confDomain = domain
|
{ confDomain = domain
|
||||||
, confDnsServerType = Master
|
, confDnsServerType = Master
|
||||||
|
@ -92,7 +104,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
|
||||||
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
|
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
|
||||||
rootRecords = map snd $
|
rootRecords = map snd $
|
||||||
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
|
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
|
||||||
needupdate = do
|
needupdate zone = do
|
||||||
v <- readZonePropellorFile zonefile
|
v <- readZonePropellorFile zonefile
|
||||||
return $ case v of
|
return $ case v of
|
||||||
Nothing -> True
|
Nothing -> True
|
||||||
|
@ -278,6 +290,7 @@ rField (MX _ _) = "MX"
|
||||||
rField (NS _) = "NS"
|
rField (NS _) = "NS"
|
||||||
rField (TXT _) = "TXT"
|
rField (TXT _) = "TXT"
|
||||||
rField (SRV _ _ _ _) = "SRV"
|
rField (SRV _ _ _ _) = "SRV"
|
||||||
|
rField (SSHFP _ _ _) = "SSHFP"
|
||||||
rField (INCLUDE _) = "$INCLUDE"
|
rField (INCLUDE _) = "$INCLUDE"
|
||||||
|
|
||||||
rValue :: Record -> String
|
rValue :: Record -> String
|
||||||
|
@ -292,6 +305,11 @@ rValue (SRV priority weight port target) = unwords
|
||||||
, show port
|
, show port
|
||||||
, dValue target
|
, dValue target
|
||||||
]
|
]
|
||||||
|
rValue (SSHFP x y s) = unwords
|
||||||
|
[ show x
|
||||||
|
, show y
|
||||||
|
, s
|
||||||
|
]
|
||||||
rValue (INCLUDE f) = f
|
rValue (INCLUDE f) = f
|
||||||
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
|
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
|
||||||
where
|
where
|
||||||
|
@ -397,21 +415,40 @@ com s = "; " ++ s
|
||||||
|
|
||||||
type WarningMessage = String
|
type WarningMessage = String
|
||||||
|
|
||||||
|
-- | Generates SSHFP records for hosts that have configured
|
||||||
|
-- ssh public keys.
|
||||||
|
--
|
||||||
|
-- This is done using ssh-keygen, so sadly needs IO.
|
||||||
|
genSSHFP :: Host -> Propellor [Record]
|
||||||
|
genSSHFP h = concat <$> (gen =<< get)
|
||||||
|
where
|
||||||
|
get = fromHost [h] (hostName h) Ssh.getPubKey
|
||||||
|
gen = liftIO . mapM go . M.elems . fromMaybe M.empty
|
||||||
|
go pubkey = withTmpFile "sshfp" $ \tmp tmph -> do
|
||||||
|
hPutStrLn tmph pubkey
|
||||||
|
hClose tmph
|
||||||
|
s <- catchDefaultIO "" $
|
||||||
|
readProcess "ssh-keygen" ["-r", "dummy", "-f", tmp]
|
||||||
|
return $ mapMaybe (parse . words) $ lines s
|
||||||
|
parse ("dummy":"IN":"SSHFP":x:y:s:[]) = do
|
||||||
|
x' <- readish x
|
||||||
|
y' <- readish y
|
||||||
|
return $ SSHFP x' y' s
|
||||||
|
parse _ = Nothing
|
||||||
|
|
||||||
-- | Generates a Zone for a particular Domain from the DNS properies of all
|
-- | Generates a Zone for a particular Domain from the DNS properies of all
|
||||||
-- hosts that propellor knows about that are in that Domain.
|
-- hosts that propellor knows about that are in that Domain.
|
||||||
genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
|
--
|
||||||
genZone hosts zdomain soa =
|
-- Does not include SSHFP records.
|
||||||
|
genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage])
|
||||||
|
genZone inzdomain hostmap zdomain soa =
|
||||||
let (warnings, zhosts) = partitionEithers $ concat $ map concat
|
let (warnings, zhosts) = partitionEithers $ concat $ map concat
|
||||||
[ map hostips inzdomain
|
[ map hostips inzdomain
|
||||||
, map hostrecords inzdomain
|
, map hostrecords inzdomain
|
||||||
, map addcnames (M.elems m)
|
, map addcnames (M.elems hostmap)
|
||||||
]
|
]
|
||||||
in (Zone zdomain soa (simplify zhosts), warnings)
|
in (Zone zdomain soa (simplify zhosts), warnings)
|
||||||
where
|
where
|
||||||
m = hostMap hosts
|
|
||||||
-- Known hosts with hostname located in the zone's domain.
|
|
||||||
inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
|
|
||||||
|
|
||||||
-- Each host with a hostname located in the zdomain
|
-- Each host with a hostname located in the zdomain
|
||||||
-- should have 1 or more IPAddrs in its Info.
|
-- should have 1 or more IPAddrs in its Info.
|
||||||
--
|
--
|
||||||
|
|
|
@ -9,6 +9,7 @@ module Propellor.Property.Ssh (
|
||||||
hostKeys,
|
hostKeys,
|
||||||
hostKey,
|
hostKey,
|
||||||
pubKey,
|
pubKey,
|
||||||
|
getPubKey,
|
||||||
keyImported,
|
keyImported,
|
||||||
knownHost,
|
knownHost,
|
||||||
authorizedKeys,
|
authorizedKeys,
|
||||||
|
|
|
@ -62,6 +62,7 @@ data Record
|
||||||
| NS BindDomain
|
| NS BindDomain
|
||||||
| TXT String
|
| TXT String
|
||||||
| SRV Word16 Word16 Word16 BindDomain
|
| SRV Word16 Word16 Word16 BindDomain
|
||||||
|
| SSHFP Int Int String
|
||||||
| INCLUDE FilePath
|
| INCLUDE FilePath
|
||||||
deriving (Read, Show, Eq, Ord)
|
deriving (Read, Show, Eq, Ord)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue