diff --git a/config-joey.hs b/config-joey.hs index 4525f22..d81a18c 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -25,8 +25,6 @@ import qualified Propellor.Property.Grub as Grub import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd -import qualified Propellor.Property.Chroot as Chroot -import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.OS as OS import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost @@ -48,7 +46,6 @@ hosts = -- (o) ` , kite , diatom , elephant - , alien , testvm ] ++ monsters @@ -94,9 +91,10 @@ website hn = Apache.siteEnabled hn apachecfg clam :: Host clam = standardSystem "clam.kitenet.net" Unstable "amd64" [ "Unreliable server. Anything here may be lost at any time!" ] - & ipv4 "162.248.9.29" + & ipv4 "167.88.41.194" & CloudAtCost.decruft + & Ssh.randomHostKeys & Apt.unattendedUpgrades & Network.ipv6to4 & Tor.isBridge @@ -118,20 +116,6 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64" ! Ssh.listenPort 443 & Systemd.persistentJournal - ! Systemd.nspawned meow - -meow :: Systemd.Container -meow = Systemd.container "meow" (Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty) - & Apt.serviceInstalledRunning "uptimed" - & alias "meow.kitenet.net" - -alien :: Host -alien = host "alientest.kitenet.net" - & ipv4 "104.131.106.199" - & Chroot.provisioned - ( Chroot.debootstrapped (System (Debian Unstable) "amd64") Debootstrap.MinBase "/debian" - & Apt.serviceInstalledRunning "uptimed" - ) orca :: Host orca = standardSystem "orca.kitenet.net" Unstable "amd64" @@ -168,6 +152,10 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" & 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" @@ -191,6 +179,11 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" & alias "pop.kitenet.net" & alias "mail.kitenet.net" & JoeySites.kiteMailServer + + & alias "ns4.kitenet.net" + & myDnsSecondary + & alias "ns4.branchable.com" + & branchableSecondary & JoeySites.legacyWebSites @@ -226,6 +219,9 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64" & 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=") + ] & Apt.unattendedUpgrades & Apt.serviceInstalledRunning "ntp" & Postfix.satellite @@ -265,10 +261,10 @@ diatom = standardSystem "diatom.kitenet.net" (Stable "wheezy") "amd64" & JoeySites.oldUseNetServer hosts & alias "ns2.kitenet.net" - & myDnsPrimary "kitenet.net" [] - & myDnsPrimary "joeyh.name" [] - & myDnsPrimary "ikiwiki.info" [] - & myDnsPrimary "olduse.net" + & myDnsPrimary False "kitenet.net" [] + & myDnsPrimary True "joeyh.name" [] + & myDnsPrimary False "ikiwiki.info" [] + & myDnsPrimary False "olduse.net" [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ] @@ -290,7 +286,10 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" & Systemd.installed & Systemd.persistentJournal & Ssh.hostKeys hostContext - & sshPubKey "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0=" + [ (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" @@ -445,14 +444,15 @@ branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com" -- Currently using diatom (ns2) as primary with secondaries -- elephant (ns3) and gandi. -- kite handles all mail. -myDnsPrimary :: Domain -> [(BindDomain, Record)] -> RevertableProperty -myDnsPrimary domain extras = Dns.primary hosts domain +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 "ns6.gandi.net") , (RootDomain, MX 0 $ AbsDomain "kitenet.net") - , (RootDomain, TXT "v=spf1 a ?all") + -- SPF only allows IP address of kitenet.net to send mail. + , (RootDomain, TXT "v=spf1 a:kitenet.net -all") ] ++ extras @@ -470,9 +470,9 @@ myDnsPrimary domain extras = Dns.primary hosts domain monsters :: [Host] -- Systems I don't manage with propellor, monsters = -- but do want to track their public keys etc. [ host "usw-s002.rsync.net" - & sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ==" + & Ssh.pubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ==" , host "github.com" - & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" + & Ssh.pubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" , host "ns6.gandi.net" & ipv4 "217.70.177.40" , host "turtle.kitenet.net" @@ -480,7 +480,7 @@ monsters = -- but do want to track their public keys etc. & ipv6 "2001:4978:f:2d9::2" & alias "backup.kitenet.net" & alias "usbackup.kitenet.net" - & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw==" + & 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" diff --git a/debian/changelog b/debian/changelog index 463b3d4..6bcee3e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,23 @@ +propellor (1.3.0) UNRELEASED; urgency=medium + + * --spin checks if the DNS matches any configured IP address property + of the host, and if not, sshes to the host by IP address. + * Detect #774376 and refuse to use docker if the system is so broken + that docker exec doesn't enter a chroot. + * Update intermediary propellor in --spin --via + * Added support for DNSSEC. + * Ssh.hostKey and Ssh.hostKeys no longer install public keys from + the privdata. Instead, the public keys are included in the + configuration. (API change) + * Ssh.hostKeys now removes any host keys of types that the host is not + configured to have. + * sshPubKey is renamed to Ssh.pubKey, and has an added SshKeyType + parameter. (API change) + * CloudAtCost.deCruft no longer forces randomHostKeys. + * Fix build with process 1.2.1.0. + + -- Joey Hess Thu, 01 Jan 2015 13:27:23 -0400 + propellor (1.2.2) unstable; urgency=medium * Revert ensureProperty warning message, too many false positives in places diff --git a/doc/todo/spin_and_ipv6_addresses.mdwn b/doc/todo/spin_and_ipv6_addresses.mdwn new file mode 100644 index 0000000..8693f16 --- /dev/null +++ b/doc/todo/spin_and_ipv6_addresses.mdwn @@ -0,0 +1,8 @@ +Currently, --spin uses Network.BSD to look up IPv4 addresses of hostnames. +Not Ipv6. + +This doesn't prevent using propellor with IPv6 only hosts. But it prevents +using short names for such hosts with --spin. And, propellor only looks at +configured ipv4 properties of a host when deciding if the DNS hostname is +out of date, and falling back to contacting the host by IPv6 address. + diff --git a/doc/todo/ssh_hostkey_Info.mdwn b/doc/todo/ssh_hostkey_Info.mdwn index a7f8a66..70c8833 100644 --- a/doc/todo/ssh_hostkey_Info.mdwn +++ b/doc/todo/ssh_hostkey_Info.mdwn @@ -5,3 +5,5 @@ the PrivData, and instead configured using the info. Getting the ssh host key into the info will allow automatically exporting it via DNS (SSHFP record) + +[[done]]; although I did not implement SSHFTP yet, it should be doable now. diff --git a/doc/usage.mdwn b/doc/usage.mdwn index 6ef2e96..8cd9af2 100644 --- a/doc/usage.mdwn +++ b/doc/usage.mdwn @@ -13,11 +13,13 @@ and configured in haskell. # MODES OF OPERATION -* The first time you run `propellor`, without any options, - it will set up a `~/.propellor/` repository. - Edit `~/.propellor/config.hs` to configure it. +* propellor -* Once propellor is configured, running it without any options will take + The first time you run `propellor`, without any options, + it will set up a `~/.propellor/` repository. Edit `~/.propellor/config.hs` + to configure it. + + Once propellor is configured, running it without any options will take action as needed to satisfy the configured properties of the local host. If there's a central git repository, it will first fetch from the @@ -28,7 +30,7 @@ and configured in haskell. the same as running propellor --spin with the hostname of the local host. -* --spin targethost [targethost ...] [--via relayhost] +* propellor --spin targethost [targethost ...] [--via relayhost] Causes propellor to automatically install itself on the specified target host, or if it's already installed there, push any updates. Propellor is @@ -47,7 +49,11 @@ and configured in haskell. uses ssh agent forwarding to make this work, and the relay host sees any privdata belonging to the target host. -* --add-key keyid + Propellor configuration typically uses the FQDN of hosts. + The hostname given to --spin can be a short name, which is + then looked up in the DNS to find the FQDN. + +* propellor --add-key keyid Adds a gpg key, which is used to encrypt the privdata. @@ -55,25 +61,25 @@ and configured in haskell. using this key. Propellor requires signed commits when pulling from a central git repository. -* --list-fields +* propellor --list-fields Lists all privdata fields that are used by your propellor configuration. The first 2 columns are the field name and context, and are followed by a list of the hosts that use that privdata value. -* --set field context +* propellor --set field context Sets a field of privdata. The content is read in from stdin. -* --dump field context +* propellor --dump field context Outputs the privdata value to stdout. -* --edit field context +* propellor --edit field context Opens $EDITOR on the privdata value. -* --merge +* propellor --merge Combine multiple --spin commits into a single, more useful commit. @@ -89,7 +95,7 @@ and configured in haskell. (This will result in a trapezoid pattern in gitk.) -* hostname +* propellor hostname When run with a hostname and no other options, propellor will provision the local host with the configuration of that hostname. diff --git a/propellor.cabal b/propellor.cabal index 7a9ba50..a239bf4 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 1.2.2 +Version: 1.3.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess @@ -77,6 +77,7 @@ Library Propellor.Property.Cron Propellor.Property.Debootstrap Propellor.Property.Dns + Propellor.Property.DnsSec Propellor.Property.Docker Propellor.Property.File Propellor.Property.Firewall @@ -154,4 +155,4 @@ Library source-repository head type: git - location: git://git.kitenet.net/propellor.git + location: git://git.joeyh.name/propellor.git diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 3e375c7..378367e 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -54,7 +54,6 @@ processCmdLine = go =<< getArgs go ("--help":_) = do usage stdout exitFailure - go ("--update":_:[]) = return $ Update Nothing go ("--boot":_:[]) = return $ Update Nothing -- for back-compat go ("--serialized":s:[]) = serialized Serialized s go ("--continue":s:[]) = serialized Continue s @@ -98,8 +97,9 @@ defaultMain hostlist = do go _ (DockerChain hn cid) = Docker.chain hostlist hn cid go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout + go _ (Relay h) = forceConsole >> updateFirst (Update (Just h)) (update (Just h)) go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing)) - go _ (Update (Just h)) = forceConsole >> fetchFirst (update (Just h)) + go _ (Update (Just h)) = update (Just h) go _ Merge = mergeSpin go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index f29ce1a..667f6bf 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -77,7 +77,7 @@ ensureProperties ps = ensure ps NoChange -- | Lifts an action into a different host. -- --- For example, `fromHost hosts "otherhost" getSshPubKey` +-- For example, `fromHost hosts "otherhost" getPubKey` fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) fromHost l hn getter = case findHost l hn of Nothing -> return Nothing diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs index a91f69c..b7ca81b 100644 --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -26,8 +26,13 @@ getOS = askInfo _os -- | Indidate that a host has an A record in the DNS. -- --- TODO check at run time if the host really has this address. --- (Can't change the host's address, but as a sanity check.) +-- When propellor is used to deploy a DNS server for a domain, +-- the hosts in the domain are found by looking for these +-- and similar properites. +-- +-- When propellor --spin is used to deploy a host, it checks +-- if the host's IP Property matches the DNS. If the DNS is missing or +-- out of date, the host will instead be contacted directly by IP address. ipv4 :: String -> Property ipv4 = addDNS . Address . IPv4 @@ -59,18 +64,12 @@ 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 (INCLUDE f) = unwords ["$INCLUDE", f] ddesc (AbsDomain domain) = domain ddesc (RelDomain domain) = domain ddesc RootDomain = "@" -sshPubKey :: String -> Property -sshPubKey k = pureInfoProperty ("ssh pubkey known") $ - mempty { _sshPubKey = Val k } - -getSshPubKey :: Propellor (Maybe String) -getSshPubKey = askInfo _sshPubKey - hostMap :: [Host] -> M.Map HostName Host hostMap l = M.fromList $ zip (map hostName l) l diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index 6253e92..2b27f22 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -55,7 +55,7 @@ withPrivData -> Property withPrivData s = withPrivData' snd [s] --- Like withPrivData, but here any of a list of PrivDataFields can be used. +-- Like withPrivData, but here any one of a list of PrivDataFields can be used. withSomePrivData :: (IsContext c, IsPrivDataSource s) => [s] diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 37fd90d..c0878fb 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -26,8 +26,7 @@ propertyList :: Desc -> [Property] -> Property propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps) -- | Combines a list of properties, resulting in one property that --- ensures each in turn. Does not stop on failure; does propigate --- overall success/failure. +-- ensures each in turn. Stops if a property fails. combineProperties :: Desc -> [Property] -> Property combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps) where diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index f351804..581a9bf 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -1,6 +1,7 @@ module Propellor.Property.Dns ( module Propellor.Types.Dns, primary, + signedPrimary, secondary, secondaryFor, mkSOA, @@ -17,6 +18,8 @@ import Propellor.Types.Dns import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service +import Propellor.Property.Scheduled +import Propellor.Property.DnsSec import Utility.Applicative import qualified Data.Map as M @@ -53,18 +56,20 @@ import Data.List primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty primary hosts domain soa rs = RevertableProperty setup cleanup where - setup = withwarnings (check needupdate baseprop) - `requires` servingZones + setup = setupPrimary zonefile id hosts domain soa rs + `onChange` Service.reloaded "bind9" + cleanup = cleanupPrimary zonefile domain `onChange` Service.reloaded "bind9" - cleanup = check (doesFileExist zonefile) $ - property ("removed dns primary for " ++ domain) - (makeChange $ removeZoneFile zonefile) - `requires` namedConfWritten - `onChange` Service.reloaded "bind9" + zonefile = "/etc/bind/propellor/db." ++ domain + +setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property +setupPrimary zonefile mknamedconffile hosts domain soa rs = + withwarnings (check needupdate baseprop) + `requires` servingZones + where (partialzone, zonewarnings) = genZone hosts domain soa zone = partialzone { zHosts = zHosts partialzone ++ rs } - zonefile = "/etc/bind/propellor/db." ++ domain baseprop = Property ("dns primary for " ++ domain) (makeChange $ writeZoneFile zone zonefile) (addNamedConf conf) @@ -74,7 +79,7 @@ primary hosts domain soa rs = RevertableProperty setup cleanup conf = NamedConf { confDomain = domain , confDnsServerType = Master - , confFile = zonefile + , confFile = mknamedconffile zonefile , confMasters = [] , confAllowTransfer = nub $ concatMap (\h -> hostAddresses h hosts) $ @@ -97,6 +102,63 @@ primary hosts domain soa rs = RevertableProperty setup cleanup z = zone { zSOA = (zSOA zone) { sSerial = oldserial } } in z /= oldzone || oldserial < sSerial (zSOA zone) + +cleanupPrimary :: FilePath -> Domain -> Property +cleanupPrimary zonefile domain = check (doesFileExist zonefile) $ + property ("removed dns primary for " ++ domain) + (makeChange $ removeZoneFile zonefile) + `requires` namedConfWritten + +-- | Primary dns server for a domain, secured with DNSSEC. +-- +-- This is like `primary`, except the resulting zone +-- file is signed. +-- The Zone Signing Key (ZSK) and Key Signing Key (KSK) +-- used in signing it are taken from the PrivData. +-- +-- As a side effect of signing the zone, a +-- +-- file will be created. This file contains the DS records +-- which need to be communicated to your domain registrar +-- to make DNSSEC be used for your domain. Doing so is outside +-- the scope of propellor (currently). See for example the tutorial +-- +-- +-- The 'Recurrance' controls how frequently the signature +-- should be regenerated, using a new random salt, to prevent +-- zone walking attacks. `Weekly Nothing` is a reasonable choice. +-- +-- To transition from 'primary' to 'signedPrimary', you can revert +-- the 'primary' property, and add this property. +-- +-- Note that DNSSEC zone files use a serial number based on the unix epoch. +-- This is different from the serial number used by 'primary', so if you +-- want to later disable DNSSEC you will need to adjust the serial number +-- passed to mkSOA to ensure it is larger. +signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty +signedPrimary recurrance hosts domain soa rs = RevertableProperty setup cleanup + where + setup = combineProperties ("dns primary for " ++ domain ++ " (signed)") + [ setupPrimary zonefile signedZoneFile hosts domain soa rs' + , toProp (zoneSigned domain zonefile) + , forceZoneSigned domain zonefile `period` recurrance + ] + `onChange` Service.reloaded "bind9" + + cleanup = cleanupPrimary zonefile domain + `onChange` toProp (revert (zoneSigned domain zonefile)) + `onChange` Service.reloaded "bind9" + + -- Include the public keys into the zone file. + rs' = include PubKSK : include PubZSK : rs + include k = (RootDomain, INCLUDE (keyFn domain k)) + + -- Put DNSSEC zone files in a different directory than is used for + -- the regular ones. This allows 'primary' to be reverted and + -- 'signedPrimary' enabled, without the reverted property stomping + -- on the new one's settings. + zonefile = "/etc/bind/propellor/dnssec/db." ++ domain + -- | Secondary dns server for a domain. -- -- The primary server is determined by looking at the properties of other @@ -216,6 +278,7 @@ rField (MX _ _) = "MX" rField (NS _) = "NS" rField (TXT _) = "TXT" rField (SRV _ _ _ _) = "SRV" +rField (INCLUDE _) = "$INCLUDE" rValue :: Record -> String rValue (Address (IPv4 addr)) = addr @@ -229,6 +292,7 @@ rValue (SRV priority weight port target) = unwords , show port , dValue target ] +rValue (INCLUDE f) = f rValue (TXT s) = [q] ++ filter (/= q) s ++ [q] where q = '"' @@ -294,12 +358,16 @@ genZoneFile (Zone zdomain soa rs) = unlines $ header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit." genRecord :: Domain -> (BindDomain, Record) -> String +genRecord _ (_, record@(INCLUDE _)) = intercalate "\t" + [ rField record + , rValue record + ] genRecord zdomain (domain, record) = intercalate "\t" - [ domainHost zdomain domain - , "IN" - , rField record - , rValue record - ] + [ domainHost zdomain domain + , "IN" + , rField record + , rValue record + ] genSOA :: SOA -> [String] genSOA soa = diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs new file mode 100644 index 0000000..b755700 --- /dev/null +++ b/src/Propellor/Property/DnsSec.hs @@ -0,0 +1,122 @@ +module Propellor.Property.DnsSec where + +import Propellor +import qualified Propellor.Property.File as File + +-- | Puts the DNSSEC key files in place from PrivData. +-- +-- signedPrimary uses this, so this property does not normally need to be +-- used directly. +keysInstalled :: Domain -> RevertableProperty +keysInstalled domain = RevertableProperty setup cleanup + where + setup = propertyList "DNSSEC keys installed" $ + map installkey keys + + cleanup = propertyList "DNSSEC keys removed" $ + map (File.notPresent . keyFn domain) keys + + installkey k = writer (keysrc k) (keyFn domain k) (Context domain) + where + writer + | isPublic k = File.hasPrivContentExposedFrom + | otherwise = File.hasPrivContentFrom + + keys = [ PubZSK, PrivZSK, PubKSK, PrivKSK ] + + keysrc k = PrivDataSource (DnsSec k) $ unwords + [ "The file with extension" + , keyExt k + , "created by running:" + , if isZoneSigningKey k + then "dnssec-keygen -a RSASHA256 -b 2048 -n ZONE " ++ domain + else "dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " ++ domain + ] + +-- | Uses dnssec-signzone to sign a domain's zone file. +-- +-- signedPrimary uses this, so this property does not normally need to be +-- used directly. +zoneSigned :: Domain -> FilePath -> RevertableProperty +zoneSigned domain zonefile = RevertableProperty setup cleanup + where + setup = check needupdate (forceZoneSigned domain zonefile) + `requires` toProp (keysInstalled domain) + + cleanup = combineProperties ("removed signed zone for " ++ domain) + [ File.notPresent (signedZoneFile zonefile) + , File.notPresent dssetfile + , toProp (revert (keysInstalled domain)) + ] + + dssetfile = dir "-" ++ domain ++ "." + dir = takeDirectory zonefile + + -- Need to update the signed zone file if the zone file or + -- any of the keys have a newer timestamp. + needupdate = do + v <- catchMaybeIO $ getModificationTime (signedZoneFile zonefile) + case v of + Nothing -> return True + Just t1 -> anyM (newerthan t1) $ + zonefile : map (keyFn domain) [minBound..maxBound] + + newerthan t1 f = do + t2 <- getModificationTime f + return (t2 >= t1) + +forceZoneSigned :: Domain -> FilePath -> Property +forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do + salt <- take 16 <$> saltSha1 + let p = proc "dnssec-signzone" + [ "-A" + , "-3", salt + -- The serial number needs to be increased each time the + -- zone is resigned, even if there are no other changes, + -- so that it will propigate to secondaries. So, use the + -- unixtime serial format. + , "-N", "unixtime" + , "-o", domain + , zonefile + -- the ordering of these key files does not matter + , keyFn domain PubZSK + , keyFn domain PubKSK + ] + -- Run in the same directory as the zonefile, so it will + -- write the dsset file there. + (_, _, _, h) <- createProcess $ + p { cwd = Just (takeDirectory zonefile) } + ifM (checkSuccessProcess h) + ( return MadeChange + , return FailedChange + ) + +saltSha1 :: IO String +saltSha1 = readProcess "sh" + [ "-c" + , "head -c 1024 /dev/urandom | sha1sum | cut -d ' ' -f 1" + ] + +-- | The file used for a given key. +keyFn :: Domain -> DnsSecKey -> FilePath +keyFn domain k = "/etc/bind/propellor/dnssec" concat + [ "K" ++ domain ++ "." + , if isZoneSigningKey k then "ZSK" else "KSK" + , keyExt k + ] + +-- | These are the extensions that dnssec-keygen looks for. +keyExt :: DnsSecKey -> String +keyExt k + | isPublic k = ".key" + | otherwise = ".private" + +isPublic :: DnsSecKey -> Bool +isPublic k = k `elem` [PubZSK, PubKSK] + +isZoneSigningKey :: DnsSecKey -> Bool +isZoneSigningKey k = k `elem` [PubZSK, PrivZSK] + +-- | dnssec-signzone makes a .signed file +signedZoneFile :: FilePath -> FilePath +signedZoneFile zonefile = zonefile ++ ".signed" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 02bda2e..eb0d8ec 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -351,29 +351,44 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope -- Check if the ident has changed; if so the -- parameters of the container differ and it must -- be restarted. - checkident runningident + checkident (Right runningident) | runningident == Just ident = noChange | otherwise = do void $ liftIO $ stopContainer cid restartcontainer + checkident (Left errmsg) = do + warningMessage errmsg + return FailedChange restartcontainer = do oldimage <- liftIO $ fromMaybe image <$> commitContainer cid void $ liftIO $ removeContainer cid go oldimage - getrunningident = readish - <$> readProcess' (inContainerProcess cid [] ["cat", propellorIdent]) + getrunningident = withTmpFile "dockerrunsane" $ \t h -> do + -- detect #774376 which caused docker exec to not enter + -- the container namespace, and be able to access files + -- outside + hClose h + void . checkSuccessProcess . processHandle =<< + createProcess (inContainerProcess cid [] + ["rm", "-f", t]) + ifM (doesFileExist t) + ( Right . readish <$> + readProcess' (inContainerProcess cid [] + ["cat", propellorIdent]) + , return $ Left "docker exec failed to enter chroot properly (maybe an old kernel version?)" + ) - retry :: Int -> IO (Maybe a) -> IO (Maybe a) - retry 0 _ = return Nothing + retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a)) + retry 0 _ = return (Right Nothing) retry n a = do v <- a case v of - Just _ -> return v - Nothing -> do - threadDelaySeconds (Seconds 1) + Right Nothing -> do + threadDelaySeconds (Seconds 1) retry (n-1) a + _ -> return v go img = do liftIO $ do diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 76de68c..032268c 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -18,18 +18,26 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f) -- The file's permissions are preserved if the file already existed. -- Otherwise, they're set to 600. hasPrivContent :: IsContext c => FilePath -> c -> Property -hasPrivContent = hasPrivContent' writeFileProtected +hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f + +-- | Like hasPrivContent, but allows specifying a source +-- for PrivData, rather than using PrivDataSourceFile. +hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property +hasPrivContentFrom = hasPrivContent' writeFileProtected -- | Leaves the file at its default or current mode, -- allowing "private" data to be read. -- -- Use with caution! hasPrivContentExposed :: IsContext c => FilePath -> c -> Property -hasPrivContentExposed = hasPrivContent' writeFile +hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f -hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property -hasPrivContent' writer f context = - withPrivData (PrivDataSourceFile (PrivFile f) f) context $ \getcontent -> +hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property +hasPrivContentExposedFrom = hasPrivContent' writeFile + +hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (String -> FilePath -> IO ()) -> s -> FilePath -> c -> Property +hasPrivContent' writer source f context = + withPrivData source context $ \getcontent -> property desc $ getcontent $ \privcontent -> ensureProperty $ fileProperty' writer desc (\_oldcontent -> lines privcontent) f diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs index 003bd3c..f45a4aa 100644 --- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs +++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs @@ -10,7 +10,6 @@ import qualified Propellor.Property.User as User decruft :: Property decruft = propertyList "cloudatcost cleanup" [ Hostname.sane - , Ssh.randomHostKeys , "worked around grub/lvm boot bug #743126" ==> "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" `onChange` cmdProperty "update-grub" [] @@ -18,6 +17,7 @@ decruft = propertyList "cloudatcost cleanup" , combineProperties "nuked cloudatcost cruft" [ File.notPresent "/etc/rc.local" , File.notPresent "/etc/init.d/S97-setup.sh" + , File.notPresent "/zang-debian.sh" , User.nuked "user" User.YesReallyDeleteHome ] ] diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 695b67c..b6ed476 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -8,6 +8,7 @@ module Propellor.Property.Ssh ( randomHostKeys, hostKeys, hostKey, + pubKey, keyImported, knownHost, authorizedKeys, @@ -22,6 +23,9 @@ import Utility.SafeCommand import Utility.FileMode import System.PosixCompat +import qualified Data.Map as M + +type PubKeyText = String sshBool :: Bool -> String sshBool True = "yes" @@ -79,27 +83,43 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" ensureProperty $ scriptProperty [ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] --- | Sets all types of ssh host keys from the privdata. -hostKeys :: IsContext c => c -> Property -hostKeys ctx = propertyList "known ssh host keys" - [ hostKey SshDsa ctx - , hostKey SshRsa ctx - , hostKey SshEcdsa ctx - ] +-- | Installs the specified list of ssh host keys. +-- +-- The corresponding private keys come from the privdata. +-- +-- Any host keysthat are not in the list are removed from the host. +hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property +hostKeys ctx l = propertyList desc $ catMaybes $ + map (\(t, pub) -> Just $ hostKey ctx t pub) l ++ [cleanup] + where + desc = "ssh host keys configured " ++ typelist (map fst l) + typelist tl = "(" ++ unwords (map fromKeyType tl) ++ ")" + alltypes = [minBound..maxBound] + staletypes = let have = map fst l in filter (`notElem` have) alltypes + removestale b = map (File.notPresent . flip keyFile b) staletypes + cleanup + | null staletypes || null l = Nothing + | otherwise = Just $ property ("any other ssh host keys removed " ++ typelist staletypes) $ + ensureProperty $ + combineProperties desc (removestale True ++ removestale False) + `onChange` restarted --- | Sets a single ssh host key from the privdata. -hostKey :: IsContext c => SshKeyType -> c -> Property -hostKey keytype context = combineProperties desc - [ installkey (keysrc ".pub" (SshPubKey keytype "")) (install writeFile ".pub") - , installkey (keysrc "" (SshPrivKey keytype "")) (install writeFileProtected "") +-- | Installs a single ssh host key of a particular type. +-- +-- The public key is provided to this function; +-- the private key comes from the privdata; +hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property +hostKey context keytype pub = combineProperties desc + [ pubKey keytype pub + , property desc $ install writeFile True pub + , withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> + property desc $ getkey $ install writeFileProtected False ] `onChange` restarted where - desc = "known ssh host key (" ++ fromKeyType keytype ++ ")" - installkey p a = withPrivData p context $ \getkey -> - property desc $ getkey a - install writer ext key = do - let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext + desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")" + install writer ispub key = do + let f = keyFile keytype ispub s <- liftIO $ readFileStrict f if s == key then noChange @@ -107,6 +127,21 @@ hostKey keytype context = combineProperties desc keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) ("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey") +keyFile :: SshKeyType -> Bool -> FilePath +keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext + where + ext = if ispub then ".pub" else "" + +-- | Indicates the host key that is used by a Host, but does not actually +-- configure the host to use it. Normally this does not need to be used; +-- use 'hostKey' instead. +pubKey :: SshKeyType -> PubKeyText -> Property +pubKey t k = pureInfoProperty ("ssh pubkey known") $ + mempty { _sshPubKey = M.singleton t k } + +getPubKey :: Propellor (M.Map SshKeyType String) +getPubKey = asks (_sshPubKey . hostInfo) + -- | Sets up a user with a ssh private key and public key pair from the -- PrivData. keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property @@ -140,21 +175,23 @@ fromKeyType SshDsa = "dsa" fromKeyType SshEcdsa = "ecdsa" fromKeyType SshEd25519 = "ed25519" --- | Puts some host's ssh public key into the known_hosts file for a user. +-- | Puts some host's ssh public key(s), as set using 'pubKey', +-- into the known_hosts file for a user. knownHost :: [Host] -> HostName -> UserName -> Property knownHost hosts hn user = property desc $ - go =<< fromHost hosts hn getSshPubKey + go =<< fromHost hosts hn getPubKey where desc = user ++ " knows ssh key for " ++ hn - go (Just (Just k)) = do + go (Just m) | not (M.null m) = do f <- liftIO $ dotFile "known_hosts" user ensureProperty $ combineProperties desc [ File.dirExists (takeDirectory f) - , f `File.containsLine` (hn ++ " " ++ k) + , f `File.containsLines` + (map (\k -> hn ++ " " ++ k) (M.elems m)) , File.ownerGroup f user user ] go _ = do - warningMessage $ "no configred sshPubKey for " ++ hn + warningMessage $ "no configred pubKey for " ++ hn return FailedChange -- | Makes a user have authorized_keys from the PrivData diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 3bafd16..a103538 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -14,6 +14,9 @@ import System.Posix.Directory import Control.Concurrent.Async import Control.Exception (bracket) import qualified Data.ByteString as B +import qualified Data.Set as S +import qualified Network.BSD as BSD +import Network.Socket (inet_ntoa) import Propellor import Propellor.Protocol @@ -44,17 +47,20 @@ spin target relay hst = do when viarelay $ void $ boolSystem "ssh-add" [] + sshtarget <- ("root@" ++) <$> case relay of + Just r -> pure r + Nothing -> getSshTarget target hst + -- Install, or update the remote propellor. updateServer target relay hst - (proc "ssh" $ cacheparams ++ [user, shellWrap probecmd]) - (proc "ssh" $ cacheparams ++ [user, shellWrap updatecmd]) + (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd]) + (proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd]) -- And now we can run it. - unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, shellWrap runcmd])) $ + unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $ error $ "remote propellor failed" where hn = fromMaybe target relay - user = "root@"++hn relaying = relay == Just target viarelay = isJust relay && not relaying @@ -74,7 +80,7 @@ spin target relay hst = do , "if ! test -x ./propellor; then make deps build; fi" , if viarelay then "./propellor --continue " ++ - shellEscape (show (Update (Just target))) + shellEscape (show (Relay target)) -- Still using --boot for back-compat... else "./propellor --boot " ++ target ] @@ -84,6 +90,34 @@ spin target relay hst = do then "--serialized " ++ shellEscape (show (Spin [target] (Just target))) else "--continue " ++ shellEscape (show (SimpleRun target)) +-- Check if the Host contains an IP address that matches one of the IPs +-- in the DNS for the HostName. If so, the HostName is used as-is, +-- but if the DNS is out of sync with the Host config, or doesn't have +-- the host in it at all, use one of the Host's IPs instead. +getSshTarget :: HostName -> Host -> IO String +getSshTarget target hst + | null configips = return target + | otherwise = go =<< tryIO (BSD.getHostByName target) + where + go (Left e) = useip (show e) + go (Right hostentry) = ifM (anyM matchingconfig (BSD.hostAddresses hostentry)) + ( return target + , do + ips <- mapM inet_ntoa (BSD.hostAddresses hostentry) + useip ("DNS " ++ show ips ++ " vs configured " ++ show configips) + ) + + matchingconfig a = flip elem configips <$> inet_ntoa a + + useip why = case headMaybe configips of + Nothing -> return target + Just ip -> do + warningMessage $ "DNS seems out of date for " ++ target ++ " (" ++ why ++ "); using IP address from configuration instead." + return ip + + configips = map fromIPAddr $ mapMaybe getIPAddr $ + S.toList $ _dns $ hostInfo hst + -- Update the privdata, repo url, and git repo over the ssh -- connection, talking to the user's local propellor instance which is -- running the updateServer diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 63abd22..ca3a958 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -37,6 +37,7 @@ import System.Posix.Types import "mtl" Control.Monad.RWS.Strict import "MonadCatchIO-transformers" Control.Monad.CatchIO import qualified Data.Set as S +import qualified Data.Map as M import qualified Propellor.Types.Dns as Dns import Propellor.Types.OS @@ -165,6 +166,7 @@ data CmdLine | Serialized CmdLine | Continue CmdLine | Update (Maybe HostName) + | Relay HostName | DockerInit HostName | DockerChain HostName String | ChrootChain HostName FilePath Bool Bool @@ -175,7 +177,7 @@ data CmdLine data Info = Info { _os :: Val System , _privDataFields :: S.Set (PrivDataField, HostContext) - , _sshPubKey :: Val String + , _sshPubKey :: M.Map SshKeyType String , _aliases :: S.Set HostName , _dns :: S.Set Dns.Record , _namedconf :: Dns.NamedConfMap @@ -189,7 +191,7 @@ instance Monoid Info where mappend old new = Info { _os = _os old <> _os new , _privDataFields = _privDataFields old <> _privDataFields new - , _sshPubKey = _sshPubKey old <> _sshPubKey new + , _sshPubKey = _sshPubKey new `M.union` _sshPubKey old , _aliases = _aliases old <> _aliases new , _dns = _dns old <> _dns new , _namedconf = _namedconf old <> _namedconf new diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs index 5e9666d..2fbf51e 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 + | INCLUDE FilePath deriving (Read, Show, Eq, Ord) getIPAddr :: Record -> Maybe IPAddr diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs index f746a74..c760ae5 100644 --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -2,18 +2,19 @@ module Propellor.Types.PrivData where import Propellor.Types.OS --- | Note that removing or changing field names will break the +-- | Note that removing or changing constructors will break the -- serialized privdata files, so don't do that! --- It's fine to add new fields. +-- It's fine to add new constructors. data PrivDataField = DockerAuthentication - | SshPubKey SshKeyType UserName + | SshPubKey SshKeyType UserName -- ^ For host key, use empty UserName | SshPrivKey SshKeyType UserName | SshAuthorizedKeys UserName | Password UserName | CryptPassword UserName | PrivFile FilePath | GpgKey + | DnsSec DnsSecKey deriving (Read, Show, Ord, Eq) -- | Combines a PrivDataField with a description of how to generate @@ -49,7 +50,7 @@ instance IsPrivDataSource PrivDataSource where -- for the web server serving that domain. Multiple hosts might -- use that privdata. -- --- This appears in serlialized privdata files. +-- This appears in serialized privdata files. newtype Context = Context String deriving (Read, Show, Ord, Eq) @@ -89,7 +90,7 @@ hostContext = HostContext Context type PrivData = String data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519 - deriving (Read, Show, Ord, Eq) + deriving (Read, Show, Ord, Eq, Enum, Bounded) -- | Parameter that would be passed to ssh-keygen to generate key of this type sshKeyTypeParam :: SshKeyType -> String @@ -98,3 +99,9 @@ sshKeyTypeParam SshDsa = "DSA" sshKeyTypeParam SshEcdsa = "ECDSA" sshKeyTypeParam SshEd25519 = "ED25519" +data DnsSecKey + = PubZSK -- ^ DNSSEC Zone Signing Key (public) + | PrivZSK -- ^ DNSSEC Zone Signing Key (private) + | PubKSK -- ^ DNSSEC Key Signing Key (public) + | PrivKSK -- ^ DNSSEC Key Signing Key (private) + deriving (Read, Show, Ord, Eq, Bounded, Enum) diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index 3e01054..8fefaa5 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -38,7 +38,7 @@ module Utility.Process ( ) where import qualified System.Process -import System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) +import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) import System.Process hiding (createProcess, readProcess) import System.Exit import System.IO @@ -47,7 +47,7 @@ import Control.Concurrent import qualified Control.Exception as E import Control.Monad #ifndef mingw32_HOST_OS -import System.Posix.IO +import qualified System.Posix.IO #else import Control.Applicative #endif @@ -175,9 +175,9 @@ processTranscript' cmd opts environ input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} - (readf, writef) <- createPipe - readh <- fdToHandle readf - writeh <- fdToHandle writef + (readf, writef) <- System.Posix.IO.createPipe + readh <- System.Posix.IO.fdToHandle readf + writeh <- System.Posix.IO.fdToHandle writef p@(_, _, _, pid) <- createProcess $ (proc cmd opts) { std_in = if isJust input then CreatePipe else Inherit