summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-01-04 19:52:09 -0400
committerJoey Hess2015-01-04 19:52:09 -0400
commite22002a7a99ceaaf193a6aa83d3c03e256d79f52 (patch)
tree8a6460e3da5abfd0109d40e518fd1a8f233dc35b /src
parent2de60a902794669b40fae8c7135f989ccca2f8d5 (diff)
parent0794dfbd7c6f854c3e517486be0722e4cf61db34 (diff)
Merge branch 'joeyconfig'
Conflicts: privdata.joey/privdata.gpg
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Info.hs1
-rw-r--r--src/Propellor/Property/Dns.hs73
-rw-r--r--src/Propellor/Property/HostingProvider/CloudAtCost.hs1
-rw-r--r--src/Propellor/Property/Ssh.hs3
-rw-r--r--src/Propellor/Types/Dns.hs1
-rw-r--r--src/Propellor/Types/PrivData.hs4
6 files changed, 64 insertions, 19 deletions
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index b7ca81b5..ccb27cf3 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -64,6 +64,7 @@ addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
rdesc (NS d) = unwords ["NS", ddesc d]
rdesc (TXT s) = unwords ["TXT", s]
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]
ddesc (AbsDomain domain) = domain
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 581a9bfe..7b1fbcc5 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -17,6 +17,7 @@ import Propellor
import Propellor.Types.Dns
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
@@ -38,6 +39,9 @@ import Data.List
-- Will cause that hostmame and its alias to appear in the zone file,
-- with the configured IP address.
--
+-- Also, if a host has a ssh public key configured, a SSHFP record will
+-- be automatically generated for it.
+--
-- The [(BindDomain, Record)] list can be used for additional records
-- that cannot be configured elsewhere. This often includes NS records,
-- TXT records and perhaps CNAMEs pointing at hosts that propellor does
@@ -65,17 +69,27 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
setupPrimary zonefile mknamedconffile hosts domain soa rs =
- withwarnings (check needupdate baseprop)
+ withwarnings baseprop
`requires` servingZones
where
- (partialzone, zonewarnings) = genZone hosts domain soa
- zone = partialzone { zHosts = zHosts partialzone ++ rs }
- baseprop = Property ("dns primary for " ++ domain)
- (makeChange $ writeZoneFile zone zonefile)
+ hostmap = hostMap hosts
+ -- Known hosts with hostname located in the domain.
+ indomain = M.elems $ M.filterWithKey (\hn _ -> inDomain domain $ AbsDomain $ hn) hostmap
+
+ (partialzone, zonewarnings) = genZone indomain hostmap domain soa
+ baseprop = Property ("dns primary for " ++ domain) satisfy
(addNamedConf conf)
- withwarnings p = adjustProperty p $ \satisfy -> do
+ satisfy = do
+ sshfps <- 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
- satisfy
+ a
conf = NamedConf
{ confDomain = domain
, confDnsServerType = Master
@@ -92,7 +106,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs =
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
rootRecords = map snd $
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
- needupdate = do
+ needupdate zone = do
v <- readZonePropellorFile zonefile
return $ case v of
Nothing -> True
@@ -278,6 +292,7 @@ rField (MX _ _) = "MX"
rField (NS _) = "NS"
rField (TXT _) = "TXT"
rField (SRV _ _ _ _) = "SRV"
+rField (SSHFP _ _ _) = "SSHFP"
rField (INCLUDE _) = "$INCLUDE"
rValue :: Record -> String
@@ -292,6 +307,11 @@ rValue (SRV priority weight port target) = unwords
, show port
, dValue target
]
+rValue (SSHFP x y s) = unwords
+ [ show x
+ , show y
+ , s
+ ]
rValue (INCLUDE f) = f
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
where
@@ -397,21 +417,44 @@ com s = "; " ++ s
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 [(BindDomain, Record)]
+genSSHFP h = map (\r -> (AbsDomain hostname, r)) . concat <$> (gen =<< get)
+ where
+ hostname = hostName h
+ get = fromHost [h] hostname Ssh.getPubKey
+ gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
+
+genSSHFP' :: String -> IO [Record]
+genSSHFP' 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
+ where
+ 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
-- 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
[ map hostips inzdomain
, map hostrecords inzdomain
- , map addcnames (M.elems m)
+ , map addcnames (M.elems hostmap)
]
in (Zone zdomain soa (simplify zhosts), warnings)
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
-- should have 1 or more IPAddrs in its Info.
--
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index f45a4aa8..84c8a787 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -3,7 +3,6 @@ module Propellor.Property.HostingProvider.CloudAtCost where
import Propellor
import qualified Propellor.Property.Hostname as Hostname
import qualified Propellor.Property.File as File
-import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.User as User
-- Clean up a system as installed by cloudatcost.com
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index b6ed476e..238e67e4 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -9,6 +9,7 @@ module Propellor.Property.Ssh (
hostKeys,
hostKey,
pubKey,
+ getPubKey,
keyImported,
knownHost,
authorizedKeys,
@@ -120,7 +121,7 @@ hostKey context keytype pub = combineProperties desc
desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
install writer ispub key = do
let f = keyFile keytype ispub
- s <- liftIO $ readFileStrict f
+ s <- liftIO $ catchDefaultIO "" $ readFileStrict f
if s == key
then noChange
else makeChange $ writer f key
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 2fbf51e5..50297f57 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -62,6 +62,7 @@ data Record
| NS BindDomain
| TXT String
| SRV Word16 Word16 Word16 BindDomain
+ | SSHFP Int Int String
| INCLUDE FilePath
deriving (Read, Show, Eq, Ord)
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index c760ae55..c7909a6b 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -7,8 +7,8 @@ import Propellor.Types.OS
-- It's fine to add new constructors.
data PrivDataField
= DockerAuthentication
- | SshPubKey SshKeyType UserName -- ^ For host key, use empty UserName
- | SshPrivKey SshKeyType UserName
+ | SshPubKey SshKeyType UserName
+ | SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName
| SshAuthorizedKeys UserName
| Password UserName
| CryptPassword UserName