Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg

config-joey.hs

@@ -73,20 +73,6 @@ darkstar = host "darkstar.kitenet.net"
 	& Apt.buildDep ["git-annex"] `period` Daily
 	& Docker.configured
 	! Docker.docked gitAnnexAndroidDev
-	! website "foo"
-
-website :: String -> RevertableProperty
-website hn = Apache.siteEnabled hn apachecfg
-        where
-          apachecfg = [ "<VirtualHost *>"
-                      , "DocumentRoot /tmp/xx"
-                      , "<Directory  /tmp/xx>"
-                      , "  Options Indexes FollowSymLinks Multiviews"
-                      , "  Order allow,deny"
-                      , Apache.allowAll
-                      , "</Directory>"
-                      , "</VirtualHost>"
-                      ]
 
 clam :: Host
 clam = standardSystem "clam.kitenet.net" Unstable "amd64"
@@ -133,29 +119,29 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64"
 	& Docker.docked (GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h")
 	& Docker.garbageCollected `period` Daily
 	& Apt.buildDep ["git-annex"] `period` Daily
-	
+
 -- This is not a complete description of kite, since it's a
 -- multiuser system with eg, user passwords that are not deployed
 -- with propellor.
 kite :: Host
 kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
-	[ "Welcome to the new kitenet.net server!"
+	[ "Welcome to the new kitenet.net server!" ]
-	]
 	& ipv4 "66.228.36.95"
 	& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
 	& alias "kitenet.net"
 	& alias "wren.kitenet.net" -- temporary
+	& Ssh.hostKeys (Context "kitenet.net")
+		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAO9tnPUT4p+9z7K6/OYuiBNHaij4Nzv5YVBih1vMl+ALz0gYAj8RWJzXmqp5buFAyfgOoLw+H9s1bBS01Sy3i07Dm6cx1fWG4RXL/E/3w1tavX99GD2bBxDBu890ebA5Tp+eFRJkS9+JwSvFiF6CP7NbVjifCagoUO56Ig048RwDAAAAFQDPY2xM3q6KwsVQliel23nrd0rV2QAAAIEAga3hj1hL00rYPNnAUzT8GAaSP62S4W68lusErH+KPbsMwFBFY/Ib1FVf8k6Zn6dZLh/HH/RtJi0JwdzPI1IFW+lwVbKfwBvhQ1lw9cH2rs1UIVgi7Wxdgfy8gEWxf+QIqn62wG+Ulf/HkWGvTrRpoJqlYRNS/gnOWj9Z/4s99koAAACBAM/uJIo2I0nK15wXiTYs/NYUZA7wcErugFn70TRbSgduIFH6U/CQa3rgHJw9DCPCQJLq7pwCnFH7too/qaK+czDk04PsgqV0+Jc7957gU5miPg50d60eJMctHV4eQ1FpwmGGfXxRBR9k2ZvikWYatYir3L6/x1ir7M0bA9IzNU45")
+		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA2QAJEuvbTmaN9ex9i9bjPhMGj+PHUYq2keIiaIImJ+8mo+yKSaGUxebG4tpuDPx6KZjdycyJt74IXfn1voGUrfzwaEY9NkqOP3v6OWTC3QeUGqDCeJ2ipslbEd9Ep9XBp+/ldDQm60D0XsIZdmDeN6MrHSbKF4fXv1bqpUoUILk=")
+		, (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBLF+dzqBJZix+CWUkAd3Bd3cofFCKwHMNRIfwx1G7dL4XFe6fMKxmrNetQcodo2edyufwoPmCPr3NmnwON9vyh0=")
+		, (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFZftKMnH/zH29BHMKbcBO4QsgTrstYFVhbrzrlRzBO3")
+		]
 
 	& Apt.installed ["linux-image-amd64"]
 	& Linode.chainPVGrub 5
 	& Apt.unattendedUpgrades
 	& Systemd.installed
 	& Systemd.persistentJournal
-	& Ssh.hostKeys (Context "kitenet.net")
-		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAO9tnPUT4p+9z7K6/OYuiBNHaij4Nzv5YVBih1vMl+ALz0gYAj8RWJzXmqp5buFAyfgOoLw+H9s1bBS01Sy3i07Dm6cx1fWG4RXL/E/3w1tavX99GD2bBxDBu890ebA5Tp+eFRJkS9+JwSvFiF6CP7NbVjifCagoUO56Ig048RwDAAAAFQDPY2xM3q6KwsVQliel23nrd0rV2QAAAIEAga3hj1hL00rYPNnAUzT8GAaSP62S4W68lusErH+KPbsMwFBFY/Ib1FVf8k6Zn6dZLh/HH/RtJi0JwdzPI1IFW+lwVbKfwBvhQ1lw9cH2rs1UIVgi7Wxdgfy8gEWxf+QIqn62wG+Ulf/HkWGvTrRpoJqlYRNS/gnOWj9Z/4s99koAAACBAM/uJIo2I0nK15wXiTYs/NYUZA7wcErugFn70TRbSgduIFH6U/CQa3rgHJw9DCPCQJLq7pwCnFH7too/qaK+czDk04PsgqV0+Jc7957gU5miPg50d60eJMctHV4eQ1FpwmGGfXxRBR9k2ZvikWYatYir3L6/x1ir7M0bA9IzNU45")
-		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA2QAJEuvbTmaN9ex9i9bjPhMGj+PHUYq2keIiaIImJ+8mo+yKSaGUxebG4tpuDPx6KZjdycyJt74IXfn1voGUrfzwaEY9NkqOP3v6OWTC3QeUGqDCeJ2ipslbEd9Ep9XBp+/ldDQm60D0XsIZdmDeN6MrHSbKF4fXv1bqpUoUILk=")
-		, (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBLF+dzqBJZix+CWUkAd3Bd3cofFCKwHMNRIfwx1G7dL4XFe6fMKxmrNetQcodo2edyufwoPmCPr3NmnwON9vyh0=")
-		]
 	& Ssh.passwordAuthentication True
 	-- Since ssh password authentication is allowed:
 	& Apt.serviceInstalledRunning "fail2ban"
@@ -200,7 +186,7 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64"
 		`onChange` Service.restarted "bitlbee"
 
 	& Apt.installed
-		["git-annex", "myrepos"
+		[ "git-annex", "myrepos"
 		, "build-essential", "make"
 		, "rss2email", "archivemail"
 		, "devscripts"
@@ -216,12 +202,12 @@ diatom :: Host
 diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64"
 	[ "Important stuff that needs not too much memory or CPU." ]
 	& ipv4 "107.170.31.195"
-
-	& DigitalOcean.distroKernel
 	& Ssh.hostKeys hostContext
 		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAO9tnPUT4p+9z7K6/OYuiBNHaij4Nzv5YVBih1vMl+ALz0gYAj8RWJzXmqp5buFAyfgOoLw+H9s1bBS01Sy3i07Dm6cx1fWG4RXL/E/3w1tavX99GD2bBxDBu890ebA5Tp+eFRJkS9+JwSvFiF6CP7NbVjifCagoUO56Ig048RwDAAAAFQDPY2xM3q6KwsVQliel23nrd0rV2QAAAIEAga3hj1hL00rYPNnAUzT8GAaSP62S4W68lusErH+KPbsMwFBFY/Ib1FVf8k6Zn6dZLh/HH/RtJi0JwdzPI1IFW+lwVbKfwBvhQ1lw9cH2rs1UIVgi7Wxdgfy8gEWxf+QIqn62wG+Ulf/HkWGvTrRpoJqlYRNS/gnOWj9Z/4s99koAAACBAM/uJIo2I0nK15wXiTYs/NYUZA7wcErugFn70TRbSgduIFH6U/CQa3rgHJw9DCPCQJLq7pwCnFH7too/qaK+czDk04PsgqV0+Jc7957gU5miPg50d60eJMctHV4eQ1FpwmGGfXxRBR9k2ZvikWYatYir3L6/x1ir7M0bA9IzNU45")
 		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA2QAJEuvbTmaN9ex9i9bjPhMGj+PHUYq2keIiaIImJ+8mo+yKSaGUxebG4tpuDPx6KZjdycyJt74IXfn1voGUrfzwaEY9NkqOP3v6OWTC3QeUGqDCeJ2ipslbEd9Ep9XBp+/ldDQm60D0XsIZdmDeN6MrHSbKF4fXv1bqpUoUILk=")
 		]
+
+	& DigitalOcean.distroKernel
 	& Apt.unattendedUpgrades
 	& Apt.serviceInstalledRunning "ntp"
 	& Postfix.satellite
@@ -279,17 +265,18 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"
 	, "(Encrypt all data stored here.)"
 	]
 	& ipv4 "193.234.225.114"
+	& Ssh.hostKeys hostContext
+		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBANxXGWac0Yz58akI3UbLkphAa8VPDCGswTS0CT3D5xWyL9OeArISAi/OKRIvxA4c+9XnWtNXS7nYVFDJmzzg8v3ZMx543AxXK82kXCfvTOc/nAlVz9YKJAA+FmCloxpmOGrdiTx1k36FE+uQgorslGW/QTxnOcO03fDZej/ppJifAAAAFQCnenyJIw6iJB1+zuF/1TSLT8UAeQAAAIEA1WDrI8rKnxnh2rGaQ0nk+lOcVMLEr7AxParnZjgC4wt2mm/BmkF/feI1Fjft2z4D+V1W7MJHOqshliuproxhFUNGgX9fTbstFJf66p7h7OLAlwK8ZkpRk/uV3h5cIUPel6aCwjL5M2gN6/yq+gcCTXeHLq9OPyUTmlN77SBL71UAAACBAJJiCHWxPAGooe7Vv3W7EIBbsDyf7b2kDH3bsIlo+XFcKIN6jysBu4kn9utjFlrlPeHUDzGQHe+DmSqTUQQ0JPCRGcAcuJL8XUqhJi6A6ye51M9hVt51cJMXmERx9TjLOP/adkEuxpv3Fj20FxRUr1HOmvRvewSHrJ1GeA1bjbYL")
+		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCrEQ7aNmRYyLKY7xHILQsyV/w0B3++D98vn5IvjHkDnitrUWjB+vPxlS7LYKLzN9Jx7Hb14R2lg7+wdgtFMxLZZukA8b0tqFpTdRFBvBYGh8IM8Id1iE/6io/NZl+hTQEDp0LJP+RljH1CLfz7J3qtc+v6NbfTP5cOgH104mWYoLWzJGaZ4p53jz6THRWnVXy5nPO3dSBr2f/SQgRuJQWHNIh0jicRGD8H2kzOQzilpo+Y46PWtkufl3Yu3UsP5UMAyLRIXwZ6nNRZqRiVWrX44hoNfDbooTdFobbHlqMl+y6291bOXaOA6PACk8B4IVcC89/gmc9Oe4EaDuszU5kD")
+		, (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0=")
+		, (SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB6VtXi0uygxZeCo26n6PuCTlSFCBcwRifv6N8HdWh2Z")
+		]
 
 	& Grub.chainPVGrub "hd0,0" "xen/xvda1" 30
 	& Postfix.satellite
 	& Apt.unattendedUpgrades
 	& Systemd.installed
 	& Systemd.persistentJournal
-	& Ssh.hostKeys hostContext
-		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBANxXGWac0Yz58akI3UbLkphAa8VPDCGswTS0CT3D5xWyL9OeArISAi/OKRIvxA4c+9XnWtNXS7nYVFDJmzzg8v3ZMx543AxXK82kXCfvTOc/nAlVz9YKJAA+FmCloxpmOGrdiTx1k36FE+uQgorslGW/QTxnOcO03fDZej/ppJifAAAAFQCnenyJIw6iJB1+zuF/1TSLT8UAeQAAAIEA1WDrI8rKnxnh2rGaQ0nk+lOcVMLEr7AxParnZjgC4wt2mm/BmkF/feI1Fjft2z4D+V1W7MJHOqshliuproxhFUNGgX9fTbstFJf66p7h7OLAlwK8ZkpRk/uV3h5cIUPel6aCwjL5M2gN6/yq+gcCTXeHLq9OPyUTmlN77SBL71UAAACBAJJiCHWxPAGooe7Vv3W7EIBbsDyf7b2kDH3bsIlo+XFcKIN6jysBu4kn9utjFlrlPeHUDzGQHe+DmSqTUQQ0JPCRGcAcuJL8XUqhJi6A6ye51M9hVt51cJMXmERx9TjLOP/adkEuxpv3Fj20FxRUr1HOmvRvewSHrJ1GeA1bjbYL")
-		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCrEQ7aNmRYyLKY7xHILQsyV/w0B3++D98vn5IvjHkDnitrUWjB+vPxlS7LYKLzN9Jx7Hb14R2lg7+wdgtFMxLZZukA8b0tqFpTdRFBvBYGh8IM8Id1iE/6io/NZl+hTQEDp0LJP+RljH1CLfz7J3qtc+v6NbfTP5cOgH104mWYoLWzJGaZ4p53jz6THRWnVXy5nPO3dSBr2f/SQgRuJQWHNIh0jicRGD8H2kzOQzilpo+Y46PWtkufl3Yu3UsP5UMAyLRIXwZ6nNRZqRiVWrX44hoNfDbooTdFobbHlqMl+y6291bOXaOA6PACk8B4IVcC89/gmc9Oe4EaDuszU5kD")
-		, (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0=")
-		]
 	& Ssh.keyImported SshRsa "joey" hostContext
 	& Apt.serviceInstalledRunning "swapspace"
 
@@ -412,7 +399,7 @@ standardSystemUnhardened hn suite arch motd = host hn
 standardStableContainer :: Docker.ContainerName -> Docker.Container
 standardStableContainer name = standardContainer name (Stable "wheezy") "amd64"
 
--- This is my standard container setup, featuring automatic upgrades.
+-- This is my standard container setup, Featuring automatic upgrades.
 standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container
 standardContainer name suite arch = Docker.container name (dockerImage system)
 	& os system
@@ -442,13 +429,14 @@ branchableSecondary :: RevertableProperty
 branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
 
 -- Currently using diatom (ns2) as primary with secondaries
--- elephant (ns3) and gandi.
+-- elephant (ns3), kite (ns4) and gandi.
 -- kite handles all mail.
 myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty
 myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain
 	(Dns.mkSOA "ns2.kitenet.net" 100) $
 	[ (RootDomain, NS $ AbsDomain "ns2.kitenet.net")
 	, (RootDomain, NS $ AbsDomain "ns3.kitenet.net")
+	, (RootDomain, NS $ AbsDomain "ns4.kitenet.net")
 	, (RootDomain, NS $ AbsDomain "ns6.gandi.net")
 	, (RootDomain, MX 0 $ AbsDomain "kitenet.net")
 	-- SPF only allows IP address of kitenet.net to send mail.
@@ -481,14 +469,10 @@ monsters =            -- but do want to track their public keys etc.
 		& alias "backup.kitenet.net"
 		& alias "usbackup.kitenet.net"
 		& Ssh.pubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
-	, host "old.kitenet.net"
-		& ipv4 "80.68.85.49"
 	, host "mouse.kitenet.net"
 		& ipv6 "2001:4830:1600:492::2"
 	, host "beaver.kitenet.net"
 		& ipv6 "2001:4830:1600:195::2"
-	, host "hydra.kitenet.net"
-		& ipv4 "192.25.206.60"
 	, host "branchable.com"
 		& ipv4 "66.228.46.55"
 		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"

debian/changelog

@@ -1,3 +1,12 @@
+propellor (1.3.1) unstable; urgency=medium
+
+  * Fix bug that prevented deploying ssh host keys when the file for the
+    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 19:51:34 -0400
+
 propellor (1.3.0) unstable; urgency=medium
 
   * --spin checks if the DNS matches any configured IP address property

debian/control

@@ -17,7 +17,7 @@ Build-Depends:
 	libghc-mtl-dev,
 	libghc-monadcatchio-transformers-dev,
 Maintainer: Gergely Nagy <algernon@madhouse-project.org>
-Standards-Version: 3.9.5
+Standards-Version: 3.9.6
 Vcs-Git: git://git.kitenet.net/propellor
 Homepage: http://propellor.branchable.com/
 

propellor.cabal

@@ -1,5 +1,5 @@
 Name: propellor
-Version: 1.3.0
+Version: 1.3.1
 Cabal-Version: >= 1.6
 License: BSD3
 Maintainer: Joey Hess <id@joeyh.name>

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

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
+	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)
-	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.
 	--

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

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

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)
 

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
+	| SshPubKey SshKeyType UserName
-	| SshPrivKey SshKeyType UserName
+	| SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName
 	| SshAuthorizedKeys UserName
 	| Password UserName
 	| CryptPassword UserName