propellor 1.2.1 → 1.3.2
raw patch · 38 files changed
+796/−268 lines, 38 files
Files
- CHANGELOG +44/−0
- config-joey.hs +63/−59
- debian/changelog +44/−0
- debian/control +1/−1
- propellor.cabal +3/−2
- src/Propellor/CmdLine.hs +2/−2
- src/Propellor/Engine.hs +5/−19
- src/Propellor/Info.hs +9/−9
- src/Propellor/PrivData.hs +2/−2
- src/Propellor/Property.hs +1/−2
- src/Propellor/Property/Dns.hs +142/−27
- src/Propellor/Property/DnsSec.hs +122/−0
- src/Propellor/Property/Docker.hs +25/−9
- src/Propellor/Property/File.hs +13/−5
- src/Propellor/Property/HostingProvider/CloudAtCost.hs +1/−2
- src/Propellor/Property/SiteSpecific/JoeySites.hs +98/−13
- src/Propellor/Property/Ssh.hs +61/−23
- src/Propellor/Protocol.hs +10/−2
- src/Propellor/Shim.hs +2/−3
- src/Propellor/Spin.hs +45/−5
- src/Propellor/Types.hs +4/−2
- src/Propellor/Types/Dns.hs +2/−0
- src/Propellor/Types/PrivData.hs +12/−5
- src/Utility/Applicative.hs +1/−1
- src/Utility/Data.hs +1/−1
- src/Utility/Env.hs +16/−15
- src/Utility/FileSystemEncoding.hs +2/−2
- src/Utility/LinuxMkLibs.hs +5/−4
- src/Utility/Misc.hs +1/−1
- src/Utility/Monad.hs +1/−1
- src/Utility/Path.hs +18/−16
- src/Utility/PosixFiles.hs +1/−1
- src/Utility/Process.hs +5/−5
- src/Utility/QuickCheck.hs +1/−1
- src/Utility/SafeCommand.hs +1/−1
- src/Utility/Scheduled.hs +14/−14
- src/Utility/ThreadScheduler.hs +2/−3
- src/Utility/UserInfo.hs +16/−10
CHANGELOG view
@@ -1,3 +1,47 @@+propellor (1.3.2) unstable; urgency=medium++ * SSHFP records are also generated for CNAMES of hosts.+ * Merge Utiity modules from git-annex.+ * Ignore bogus DNS when spinning the local host.++ -- Joey Hess <id@joeyh.name> Thu, 15 Jan 2015 14:02:07 -0400++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+ 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 <id@joeyh.name> Sun, 04 Jan 2015 17:17:44 -0400++propellor (1.2.2) unstable; urgency=medium++ * Revert ensureProperty warning message, too many false positives in places+ where Info is correctly propigated. Better approach needed.++ -- Joey Hess <id@joeyh.name> Sun, 21 Dec 2014 21:41:11 -0400+ propellor (1.2.1) unstable; urgency=medium * Added CryptPassword to PrivDataField, for password hashes as produced
config-joey.hs view
@@ -25,8 +25,6 @@ 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 @@ , kite , diatom , elephant- , alien , testvm ] ++ monsters @@ -76,27 +73,17 @@ & 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>"- ]+ & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")+ & JoeySites.dkimMilter 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@@ -109,6 +96,7 @@ & File.notPresent "/var/www/html/index.html" & "/var/www/index.html" `File.hasContent` ["hello, world"] & alias "helloworld.kitenet.net"+ & Docker.docked oldusenetShellBox -- ssh on some extra ports to deal with horrible networks -- while travelling@@ -117,21 +105,7 @@ ! 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" [ "Main git-annex build box." ]@@ -148,25 +122,29 @@ & 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") & Ssh.passwordAuthentication True -- Since ssh password authentication is allowed: & Apt.serviceInstalledRunning "fail2ban"@@ -190,6 +168,11 @@ & alias "pop.kitenet.net" & alias "mail.kitenet.net" & JoeySites.kiteMailServer+ + & alias "ns4.kitenet.net"+ & myDnsSecondary+ & alias "ns4.branchable.com"+ & branchableSecondary & JoeySites.legacyWebSites @@ -206,7 +189,7 @@ `onChange` Service.restarted "bitlbee" & Apt.installed- ["git-annex", "myrepos"+ [ "git-annex", "myrepos" , "build-essential", "make" , "rss2email", "archivemail" , "devscripts"@@ -216,14 +199,18 @@ & Docker.configured & Docker.garbageCollected `period` Daily+ & Docker.docked oldusenetShellBox 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"+ & 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- & Ssh.hostKeys hostContext & Apt.unattendedUpgrades & Apt.serviceInstalledRunning "ntp" & Postfix.satellite@@ -242,7 +229,6 @@ & alias "git.joeyh.name" & JoeySites.gitServer hosts - & alias "downloads.kitenet.net" & JoeySites.annexWebSite "/srv/git/downloads.git" "downloads.kitenet.net" "840760dc-08f0-11e2-8c61-576b7e66acfd"@@ -250,25 +236,30 @@ `requires` Ssh.keyImported SshRsa "joey" (Context "downloads.kitenet.net") `requires` Ssh.knownHost hosts "eubackup.kitenet.net" "joey" & JoeySites.gitAnnexDistributor- & alias "tmp.kitenet.net"+ & JoeySites.annexWebSite "/srv/git/joey/tmp.git" "tmp.kitenet.net" "26fd6e38-1226-11e2-a75f-ff007033bdba" [] & JoeySites.twitRss & JoeySites.pumpRss+ + & JoeySites.annexWebSite "/srv/git/user-liberation.git"+ "user-liberation.joeyh.name"+ "da89f112-808b-420a-b468-d990ae2e5b52"+ [] & alias "nntp.olduse.net" & alias "resources.olduse.net" & JoeySites.oldUseNetServer hosts & alias "ns2.kitenet.net"- & myDnsPrimary "kitenet.net" []- & myDnsPrimary "joeyh.name" []- & myDnsPrimary "ikiwiki.info" []- & myDnsPrimary "olduse.net"- [ (RelDomain "article",- CNAME $ AbsDomain "virgil.koldfront.dk") ]+ & myDnsPrimary False "kitenet.net" []+ & myDnsPrimary True "joeyh.name" []+ & myDnsPrimary True "ikiwiki.info" []+ & myDnsPrimary True "olduse.net"+ [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk")+ ] & alias "ns3.branchable.com" & branchableSecondary@@ -281,14 +272,18 @@ , "(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- & sshPubKey "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAJkoPRhUGT8EId6m37uBdYEtq42VNwslKnc9mmO+89ody066q6seHKeFY6ImfwjcyIjM30RTzEwftuVNQnbEB0=" & Ssh.keyImported SshRsa "joey" hostContext & Apt.serviceInstalledRunning "swapspace" @@ -319,6 +314,7 @@ & Docker.docked openidProvider `requires` Apt.serviceInstalledRunning "ntp" & Docker.docked ancientKitenet+ & Docker.docked jerryPlay & Docker.garbageCollected `period` (Weekly (Just 1)) -- For https port 443, shellinabox with ssh login to@@ -375,6 +371,15 @@ & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir) where gitannexdir = GitAnnexBuilder.homedir </> "git-annex"+ +jerryPlay :: Docker.Container+jerryPlay = standardContainer "jerryplay" Unstable "amd64"+ & alias "jerryplay.kitenet.net"+ & Docker.publish "2202:22"+ & Docker.publish "8001:80"+ & Apt.installed ["ssh"]+ & User.hasSomePassword "root"+ & Ssh.permitRootLogin True type Motd = [String] @@ -411,7 +416,7 @@ 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@@ -441,16 +446,19 @@ 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 :: 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 "ns4.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")+ , JoeySites.domainKey ] ++ extras @@ -468,9 +476,9 @@ 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"@@ -478,15 +486,11 @@ & 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=="- , host "old.kitenet.net"- & ipv4 "80.68.85.49"+ & Ssh.pubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw==" , 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 view
@@ -1,3 +1,47 @@+propellor (1.3.2) unstable; urgency=medium++ * SSHFP records are also generated for CNAMES of hosts.+ * Merge Utiity modules from git-annex.+ * Ignore bogus DNS when spinning the local host.++ -- Joey Hess <id@joeyh.name> Thu, 15 Jan 2015 14:02:07 -0400++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+ 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 <id@joeyh.name> Sun, 04 Jan 2015 17:17:44 -0400++propellor (1.2.2) unstable; urgency=medium++ * Revert ensureProperty warning message, too many false positives in places+ where Info is correctly propigated. Better approach needed.++ -- Joey Hess <id@joeyh.name> Sun, 21 Dec 2014 21:41:11 -0400+ propellor (1.2.1) unstable; urgency=medium * Added CryptPassword to PrivDataField, for password hashes as produced
debian/control view
@@ -17,7 +17,7 @@ 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 view
@@ -1,5 +1,5 @@ Name: propellor-Version: 1.2.1+Version: 1.3.2 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -77,6 +77,7 @@ 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 @@ source-repository head type: git- location: git://git.kitenet.net/propellor.git+ location: git://git.joeyh.name/propellor.git
src/Propellor/CmdLine.hs view
@@ -54,7 +54,6 @@ 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 @@ 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
src/Propellor/Engine.hs view
@@ -23,7 +23,6 @@ import System.Directory import Propellor.Types-import Propellor.Types.Empty import Propellor.Message import Propellor.Exception import Propellor.Info@@ -36,7 +35,7 @@ mainProperties :: Host -> IO () mainProperties host = do ret <- runPropellor host $- ensureProperties [Property "overall" (ensurePropertiesWith ensureProperty' $ hostProperties host) mempty]+ ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty] h <- mkMessageHandle whenConsole h $ setTitle "propellor: done"@@ -63,35 +62,22 @@ -- | For when code running in the Propellor monad needs to ensure a -- Property.------ Note that any info of the Property is not propigated out to--- the enclosing Property, and so will not be available for propellor to--- use. A warning message will be printed if this is detected. ensureProperty :: Property -> Propellor Result-ensureProperty p = do- unless (isEmpty (getInfo p)) $- warningMessage $ "ensureProperty called on " ++ show p ++ "; will not propigate its info: " ++ show (getInfo p)- ensureProperty' p--ensureProperty' :: Property -> Propellor Result-ensureProperty' = catchPropellor . propertySatisfy+ensureProperty = catchPropellor . propertySatisfy -- | Ensures a list of Properties, with a display of each as it runs. ensureProperties :: [Property] -> Propellor Result-ensureProperties = ensurePropertiesWith ensureProperty--ensurePropertiesWith :: (Property -> Propellor Result) -> [Property] -> Propellor Result-ensurePropertiesWith a ps = ensure ps NoChange+ensureProperties ps = ensure ps NoChange where ensure [] rs = return rs ensure (p:ls) rs = do hn <- asks hostName- r <- actionMessageOn hn (propertyDesc p) (a p)+ r <- actionMessageOn hn (propertyDesc p) (ensureProperty p) ensure ls (r <> rs) -- | 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
src/Propellor/Info.hs view
@@ -26,8 +26,13 @@ -- | 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,17 +64,12 @@ 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 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
src/Propellor/PrivData.hs view
@@ -55,7 +55,7 @@ -> 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]@@ -83,7 +83,7 @@ warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")" liftIO $ putStrLn $ "Fix this by running:" liftIO $ forM_ srclist $ \src -> do- putStrLn $ " propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "'"+ putStrLn $ " propellor --set '" ++ show (privDataField src) ++ "' '" ++ cname ++ "' \\" maybe noop (\d -> putStrLn $ " " ++ d) (describePrivDataSource src) putStrLn "" return FailedChange
src/Propellor/Property.hs view
@@ -26,8 +26,7 @@ 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
src/Propellor/Property/Dns.hs view
@@ -1,6 +1,7 @@ module Propellor.Property.Dns ( module Propellor.Types.Dns, primary,+ signedPrimary, secondary, secondaryFor, mkSOA,@@ -16,7 +17,10 @@ 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 import Utility.Applicative import qualified Data.Map as M@@ -35,6 +39,9 @@ -- 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@@ -53,28 +60,40 @@ 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 = check (doesFileExist zonefile) $- property ("removed dns primary for " ++ domain)- (makeChange $ removeZoneFile zonefile)- `requires` namedConfWritten- `onChange` Service.reloaded "bind9"+ cleanup = cleanupPrimary zonefile domain+ `onChange` Service.reloaded "bind9" - (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)++setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property+setupPrimary zonefile mknamedconffile hosts domain soa rs = + withwarnings baseprop+ `requires` servingZones+ where+ 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 domain) (M.elems hostmap)+ 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- , confFile = zonefile+ , confFile = mknamedconffile zonefile , confMasters = [] , confAllowTransfer = nub $ concatMap (\h -> hostAddresses h hosts) $@@ -87,7 +106,7 @@ 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@@ -97,6 +116,63 @@ 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+-- </var/cache/bind/dsset-domain.>+-- 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+-- <https://www.digitalocean.com/community/tutorials/how-to-setup-dnssec-on-an-authoritative-bind-dns-server--2>+--+-- 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 +292,8 @@ rField (NS _) = "NS" rField (TXT _) = "TXT" rField (SRV _ _ _ _) = "SRV"+rField (SSHFP _ _ _) = "SSHFP"+rField (INCLUDE _) = "$INCLUDE" rValue :: Record -> String rValue (Address (IPv4 addr)) = addr@@ -229,6 +307,12 @@ , 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 q = '"'@@ -294,12 +378,16 @@ 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 = @@ -331,19 +419,17 @@ -- | 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. --@@ -423,3 +509,32 @@ getNamedConf :: Propellor (M.Map Domain NamedConf) getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo++-- | Generates SSHFP records for hosts in the domain (or with CNAMES+-- in the domain) that have configured ssh public keys.+--+-- This is done using ssh-keygen, so sadly needs IO.+genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]+genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)+ where+ get = fromHost [h] hostname Ssh.getPubKey+ gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty+ mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)+ (AbsDomain hostname : cnames)+ cnames = mapMaybe getCNAME $ S.toList $ _dns info+ hostname = hostName h+ info = hostInfo h++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
+ src/Propellor/Property/DnsSec.hs view
@@ -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"
src/Propellor/Property/Docker.hs view
@@ -351,29 +351,44 @@ -- 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@@ -456,7 +471,8 @@ go cid h = do changeWorkingDirectory localdir onlyProcess (provisioningLock cid) $ do- r <- runPropellor h $ ensureProperties $ hostProperties h+ r <- runPropellor h $ ensureProperties $+ hostProperties h putStrLn $ "\n" ++ show r stopContainer :: ContainerId -> IO Bool
src/Propellor/Property/File.hs view
@@ -18,18 +18,26 @@ -- 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
src/Propellor/Property/HostingProvider/CloudAtCost.hs view
@@ -3,14 +3,12 @@ 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 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 +16,7 @@ , 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 ] ]
src/Propellor/Property/SiteSpecific/JoeySites.hs view
@@ -17,7 +17,6 @@ import qualified Propellor.Property.Postfix as Postfix import Utility.SafeCommand import Utility.FileMode-import Utility.Path import Data.List import System.Posix.Files@@ -88,9 +87,6 @@ , "dpkg -i ../" ++ pkg ++ "_*.deb || true" , "apt-get -fy install" -- dependencies , "rm -rf /root/tmp/oldusenet"- -- screen fails unless the directory has this mode.- -- not sure what's going on.- , "chmod 777 /var/run/screen" ] `describe` "olduse.net built" ] @@ -196,6 +192,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex") [ Git.cloned "joey" origin dir Nothing `onChange` setup+ , alias hn , postupdatehook `File.hasContent` [ "#!/bin/sh" , "exec git update-server-info"@@ -212,6 +209,7 @@ , "git config annex.uuid " ++ shellEscape uuid ] ++ map addremote remotes ++ [ "git annex get"+ , "git update-server-info" ] addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url setupapache = toProp $ Apache.siteEnabled hn $ apachecfg hn True $ @@ -314,6 +312,7 @@ "./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss") -- Work around for expired ssl cert.+-- (no longer expired, TODO remove this and change urls) pumpRss :: Property pumpRss = Cron.job "pump rss" "15 * * * *" "joey" "/srv/web/tmp.kitenet.net/" "wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom --no-check-certificate 2>/dev/null"@@ -322,7 +321,7 @@ ircBouncer = propertyList "IRC bouncer" [ Apt.installed ["znc"] , User.accountFor "znc"- , File.dirExists (parentDir conf)+ , File.dirExists (takeDirectory conf) , File.hasPrivContent conf anyContext , File.ownerGroup conf "znc" "znc" , Cron.job "znconboot" "@reboot" "znc" "~" "znc"@@ -353,13 +352,34 @@ in File.hasPrivContent f anyContext `onChange` File.ownerGroup f "joey" "joey" , Cron.niceJob "github-backup run" "30 4 * * *" "joey"- "/home/joey/lib/backup" $ intercalate "&&"+ "/home/joey/lib/backup" $ intercalate "&&" $ [ "mkdir -p github" , "cd github"- , ". $HOME/.github-keys && github-backup joeyh"+ , ". $HOME/.github-keys"+ , "github-backup joeyh" ]+ , Cron.niceJob "gitriddance" "30 4 * * *" "joey"+ "/home/joey/lib/backup" $ intercalate "&&" $+ [ "cd github"+ , ". $HOME/.github-keys"+ ] ++ map gitriddance githubMirrors ]+ where+ gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")" +-- these repos are only mirrored on github, I don't want+-- all the proprietary features+githubMirrors :: [(String, String)]+githubMirrors =+ [ ("ikiwiki", plzuseurl "http://ikiwiki.info/todo/")+ , ("git-annex", plzuseurl "http://git-annex.branchable.com/todo/")+ , ("myrepos", plzuseurl "http://myrepos.branchable.com/todo/")+ , ("propellor", plzuseurl "http://propellor.branchable.com/todo/")+ , ("etckeeper", plzuseurl "http://etckeeper.branchable.com/todo/")+ ]+ where+ plzuseurl u = "please submit changes to " ++ u ++ " instead of using github pull requests"+ rsyncNetBackup :: [Host] -> Property rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" "30 5 * * *" "joey" "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"@@ -425,6 +445,8 @@ `describe` "amavisd-milter configured for postfix" , Apt.serviceInstalledRunning "clamav-freshclam" + , dkimInstalled+ , Apt.installed ["maildrop"] , "/etc/maildroprc" `File.hasContent` [ "# Global maildrop filter file (deployed with propellor)"@@ -443,8 +465,7 @@ , "/etc/aliases" `File.hasPrivContentExposed` ctx `onChange` Postfix.newaliases , hasJoeyCAChain- , "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx- , "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx+ , hasPostfixCert ctx , "/etc/postfix/mydomain" `File.containsLines` [ "/.*\\.kitenet\\.net/\tOK"@@ -455,13 +476,13 @@ `describe` "postfix mydomain file configured" , "/etc/postfix/obscure_client_relay.pcre" `File.hasContent` -- Remove received lines for mails relayed from trusted- -- clients. These can be a privacy vilation, or trigger+ -- clients. These can be a privacy violation, or trigger -- spam filters. [ "/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE" -- Munge local Received line for postfix running on a -- trusted client that relays through. These can trigger -- spam filters.- , "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE Received: by kitenet.net"+ , "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE X-Question: 42" ] `onChange` Postfix.reloaded `describe` "postfix obscure_client_relay file configured"@@ -493,9 +514,13 @@ , "# Enable postgrey." , "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023" - , "# Enable spamass-milter and amavis-milter."- , "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"+ , "# Enable spamass-milter, amavis-milter, opendkim"+ , "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock inet:localhost:8891"+ , "# opendkim is used for outgoing mail"+ , "non_smtpd_milters = inet:localhost:8891" , "milter_connect_macros = j {daemon_name} v {if_name} _"+ , "# If a milter is broken, fall back to just accepting mail."+ , "milter_default_action = accept" , "# TLS setup -- server" , "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"@@ -563,9 +588,69 @@ pinescript = "/usr/local/bin/pine" dovecotusers = "/etc/dovecot/users" +-- Configures postfix to relay outgoing mail to kitenet.net, with+-- verification via tls cert.+postfixClientRelay :: Context -> Property+postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`+ [ "relayhost = kitenet.net"+ , "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"+ , "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"+ , "smtp_tls_key_file = /etc/ssl/private/postfix.pem"+ , "smtp_tls_loglevel = 0"+ , "smtp_use_tls = yes"+ ]+ `describe` "postfix client relay"+ `onChange` Postfix.dedupMainCf+ `onChange` Postfix.reloaded+ `requires` hasJoeyCAChain+ `requires` hasPostfixCert ctx++-- Configures postfix to have the dkim milter, and no other milters.+dkimMilter :: Property+dkimMilter = Postfix.mainCfFile `File.containsLines`+ [ "smtpd_milters = inet:localhost:8891"+ , "non_smtpd_milters = inet:localhost:8891"+ , "milter_default_action = accept"+ ]+ `describe` "postfix dkim milter"+ `onChange` Postfix.dedupMainCf+ `onChange` Postfix.reloaded+ `requires` dkimInstalled++-- This does not configure postfix to use the dkim milter,+-- nor does it set up domainkey DNS.+dkimInstalled :: Property+dkimInstalled = propertyList "opendkim installed"+ [ Apt.serviceInstalledRunning "opendkim"+ , File.dirExists "/etc/mail"+ , File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net")+ , File.ownerGroup "/etc/mail/dkim.key" "opendkim" "opendkim"+ , "/etc/default/opendkim" `File.containsLine`+ "SOCKET=\"inet:8891@localhost\""+ , "/etc/opendkim.conf" `File.containsLines`+ [ "KeyFile /etc/mail/dkim.key"+ , "SubDomains yes"+ , "Domain *"+ , "Selector mail"+ ]+ ]+ `onChange` Service.restarted "opendkim"++-- This is the dkim public key, corresponding with /etc/mail/dkim.key+-- This value can be included in a domain's additional records to make+-- it use this domainkey.+domainKey :: (BindDomain, Record)+domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; t=y; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB")+ hasJoeyCAChain :: Property hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed` Context "joeyca.pem"++hasPostfixCert :: Context -> Property+hasPostfixCert ctx = combineProperties "postfix tls cert installed"+ [ "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx+ , "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx+ ] kitenetHttps :: Property kitenetHttps = propertyList "kitenet.net https certs"
src/Propellor/Property/Ssh.hs view
@@ -8,6 +8,8 @@ randomHostKeys, hostKeys, hostKey,+ pubKey,+ getPubKey, keyImported, knownHost, authorizedKeys,@@ -22,7 +24,10 @@ import Utility.FileMode import System.PosixCompat+import qualified Data.Map as M +type PubKeyText = String+ sshBool :: Bool -> String sshBool True = "yes" sshBool False = "no"@@ -79,34 +84,65 @@ 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- s <- liftIO $ readFileStrict f+ desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"+ install writer ispub key = do+ let f = keyFile keytype ispub+ s <- liftIO $ catchDefaultIO "" $ readFileStrict f if s == key then noChange else makeChange $ writer f key 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 +176,23 @@ 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
src/Propellor/Protocol.hs view
@@ -41,6 +41,11 @@ sendMarked :: Handle -> Marker -> String -> IO () sendMarked h marker s = do+ debug ["sent marked", marker]+ sendMarked' h marker s++sendMarked' :: Handle -> Marker -> String -> IO ()+sendMarked' h marker s = do -- Prefix string with newline because sometimes a -- incomplete line has been output, and the marker needs to -- come at the start of a line.@@ -56,9 +61,12 @@ unless (null l) $ hPutStrLn stderr l getMarked h marker- Just v -> return (Just v)+ Just v -> do+ debug ["received marked", marker]+ return (Just v) req :: Stage -> Marker -> (String -> IO ()) -> IO () req stage marker a = do- sendMarked stdout statusMarker (show stage)+ debug ["requested marked", marker]+ sendMarked' stdout statusMarker (show stage) maybe noop a =<< getMarked stdin marker
src/Propellor/Shim.hs view
@@ -9,7 +9,6 @@ import Propellor import Utility.LinuxMkLibs import Utility.SafeCommand-import Utility.Path import Utility.FileMode import Utility.FileSystemEncoding @@ -34,7 +33,7 @@ let linker = (dest ++) $ fromMaybe (error "cannot find ld-linux linker") $ headMaybe $ filter ("ld-linux" `isInfixOf`) libs'- let gconvdir = (dest ++) $ parentDir $+ let gconvdir = (dest ++) $ takeDirectory $ fromMaybe (error "cannot find gconv directory") $ headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs let linkerparams = ["--library-path", intercalate ":" libdirs ]@@ -75,5 +74,5 @@ createLink f dest `catchIO` (const copy) where copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]- destdir = inTop top $ parentDir f+ destdir = inTop top $ takeDirectory f dest = inTop top f
src/Propellor/Spin.hs view
@@ -14,6 +14,9 @@ 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 @@ 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 @@ , "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 ]@@ -83,6 +89,40 @@ cmd = if viarelay 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+ -- If we're being asked to run on the local host,+ -- ignore DNS.+ s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]+ if s == target+ then return target+ else 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
src/Propellor/Types.hs view
@@ -37,6 +37,7 @@ 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 @@ | Serialized CmdLine | Continue CmdLine | Update (Maybe HostName)+ | Relay HostName | DockerInit HostName | DockerChain HostName String | ChrootChain HostName FilePath Bool Bool@@ -175,7 +177,7 @@ 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 @@ 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
src/Propellor/Types/Dns.hs view
@@ -62,6 +62,8 @@ | NS BindDomain | TXT String | SRV Word16 Word16 Word16 BindDomain+ | SSHFP Int Int String+ | INCLUDE FilePath deriving (Read, Show, Eq, Ord) getIPAddr :: Record -> Maybe IPAddr
src/Propellor/Types/PrivData.hs view
@@ -2,18 +2,19 @@ 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- | SshPrivKey SshKeyType UserName+ | SshPrivKey SshKeyType UserName -- ^ For host key, use empty 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 @@ -- 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 @@ 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 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)
src/Utility/Applicative.hs view
@@ -1,6 +1,6 @@ {- applicative stuff -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Data.hs view
@@ -1,6 +1,6 @@ {- utilities for simple data types -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Env.hs view
@@ -1,6 +1,6 @@ {- portable environment variables -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -14,6 +14,7 @@ import Control.Applicative import Data.Maybe import qualified System.Environment as E+import qualified System.SetEnv #else import qualified System.Posix.Env as PE #endif@@ -39,27 +40,27 @@ getEnvironment = E.getEnvironment #endif -{- Returns True if it could successfully set the environment variable.+{- Sets an environment variable. To overwrite an existing variable,+ - overwrite must be True. -- - There is, apparently, no way to do this in Windows. Instead,- - environment varuables must be provided when running a new process. -}-setEnv :: String -> String -> Bool -> IO Bool+ - On Windows, setting a variable to "" unsets it. -}+setEnv :: String -> String -> Bool -> IO () #ifndef mingw32_HOST_OS-setEnv var val overwrite = do- PE.setEnv var val overwrite- return True+setEnv var val overwrite = PE.setEnv var val overwrite #else-setEnv _ _ _ = return False+setEnv var val True = System.SetEnv.setEnv var val+setEnv var val False = do+ r <- getEnv var+ case r of+ Nothing -> setEnv var val True+ Just _ -> return () #endif -{- Returns True if it could successfully unset the environment variable. -}-unsetEnv :: String -> IO Bool+unsetEnv :: String -> IO () #ifndef mingw32_HOST_OS-unsetEnv var = do- PE.unsetEnv var- return True+unsetEnv = PE.unsetEnv #else-unsetEnv _ = return False+unsetEnv = System.SetEnv.unsetEnv #endif {- Adds the environment variable to the input environment. If already
src/Utility/FileSystemEncoding.hs view
@@ -1,6 +1,6 @@ {- GHC File system encoding handling. -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -111,7 +111,7 @@ #ifndef mingw32_HOST_OS truncateFilePath n = go . reverse where- go f =+ go f = let bytes = decodeW8 f in if length bytes <= n then reverse f
src/Utility/LinuxMkLibs.hs view
@@ -1,6 +1,6 @@ {- Linux library copier and binary shimmer -- - Copyright 2013 Joey Hess <id@joeyh.name>+ - Copyright 2013 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -10,6 +10,7 @@ import Control.Applicative import Data.Maybe import System.Directory+import System.FilePath import Data.List.Utils import System.Posix.Files import Data.Char@@ -28,14 +29,14 @@ ( do installfile top lib checksymlink lib- return $ Just $ parentDir lib+ return $ Just $ takeDirectory lib , return Nothing ) where checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do l <- readSymbolicLink (inTop top f)- let absl = absPathFrom (parentDir f) l- let target = relPathDirToFile (parentDir f) absl+ let absl = absPathFrom (takeDirectory f) l+ let target = relPathDirToFile (takeDirectory f) absl installfile top absl nukeFile (top ++ f) createSymbolicLink target (inTop top f)
src/Utility/Misc.hs view
@@ -1,6 +1,6 @@ {- misc utility functions -- - Copyright 2010-2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Monad.hs view
@@ -1,6 +1,6 @@ {- monadic stuff -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Path.hs view
@@ -1,6 +1,6 @@ {- path manipulation -- - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -21,6 +21,7 @@ import qualified System.FilePath.Posix as Posix #else import System.Posix.Files+import Utility.Exception #endif import qualified "MissingH" System.Path as MissingH@@ -76,14 +77,12 @@ todos = replace "/" "\\" #endif -{- Returns the parent directory of a path.- -- - To allow this to be easily used in loops, which terminate upon reaching the- - top, the parent of / is "" -}-parentDir :: FilePath -> FilePath+{- Just the parent directory of a path, or Nothing if the path has no+ - parent (ie for "/") -}+parentDir :: FilePath -> Maybe FilePath parentDir dir- | null dirs = ""- | otherwise = joinDrive drive (join s $ init dirs)+ | null dirs = Nothing+ | otherwise = Just $ joinDrive drive (join s $ init dirs) where -- on Unix, the drive will be "/" when the dir is absolute, otherwise "" (drive, path) = splitDrive dir@@ -93,8 +92,8 @@ prop_parentDir_basics :: FilePath -> Bool prop_parentDir_basics dir | null dir = True- | dir == "/" = parentDir dir == ""- | otherwise = p /= dir+ | dir == "/" = parentDir dir == Nothing+ | otherwise = p /= Just dir where p = parentDir dir @@ -235,11 +234,11 @@ | null drive = recombine parts | otherwise = recombine $ "/cygdrive" : driveletter drive : parts where- (drive, p') = splitDrive p+ (drive, p') = splitDrive p parts = splitDirectories p'- driveletter = map toLower . takeWhile (/= ':')+ driveletter = map toLower . takeWhile (/= ':') recombine = fixtrailing . Posix.joinPath- fixtrailing s+ fixtrailing s | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s | otherwise = s #endif@@ -255,7 +254,9 @@ fileNameLengthLimit _ = return 255 #else fileNameLengthLimit dir = do- l <- fromIntegral <$> getPathVar dir FileNameLimit+ -- getPathVar can fail due to statfs(2) overflow+ l <- catchDefaultIO 0 $+ fromIntegral <$> getPathVar dir FileNameLimit if l <= 0 then return 255 else return $ minimum [l, 255]@@ -267,12 +268,13 @@ - sane FilePath. - - All spaces and punctuation and other wacky stuff are replaced- - with '_', except for '.' "../" will thus turn into ".._", which is safe.+ - with '_', except for '.'+ - "../" will thus turn into ".._", which is safe. -} sanitizeFilePath :: String -> FilePath sanitizeFilePath = map sanitize where- sanitize c+ sanitize c | c == '.' = c | isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_' | otherwise = c
src/Utility/PosixFiles.hs view
@@ -2,7 +2,7 @@ - - This is like System.PosixCompat.Files, except with a fixed rename. -- - Copyright 2014 Joey Hess <id@joeyh.name>+ - Copyright 2014 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Process.hs view
@@ -38,7 +38,7 @@ ) 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 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 @@ #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
src/Utility/QuickCheck.hs view
@@ -1,6 +1,6 @@ {- QuickCheck with additional instances -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/SafeCommand.hs view
@@ -1,6 +1,6 @@ {- safely running shell commands -- - Copyright 2010-2013 Joey Hess <id@joeyh.name>+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}
src/Utility/Scheduled.hs view
@@ -1,6 +1,6 @@ {- scheduled activities - - - Copyright 2013-2014 Joey Hess <id@joeyh.name>+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -44,7 +44,7 @@ {- Some sort of scheduled event. -} data Schedule = Schedule Recurrance ScheduledTime- deriving (Eq, Read, Show, Ord)+ deriving (Eq, Read, Show, Ord) data Recurrance = Daily@@ -54,7 +54,7 @@ | Divisible Int Recurrance -- ^ Days, Weeks, or Months of the year evenly divisible by a number. -- (Divisible Year is years evenly divisible by a number.)- deriving (Eq, Read, Show, Ord)+ deriving (Eq, Read, Show, Ord) type WeekDay = Int type MonthDay = Int@@ -63,7 +63,7 @@ data ScheduledTime = AnyTime | SpecificTime Hour Minute- deriving (Eq, Read, Show, Ord)+ deriving (Eq, Read, Show, Ord) type Hour = Int type Minute = Int@@ -73,7 +73,7 @@ data NextTime = NextTimeExactly LocalTime | NextTimeWindow LocalTime LocalTime- deriving (Eq, Read, Show)+ deriving (Eq, Read, Show) startTime :: NextTime -> LocalTime startTime (NextTimeExactly t) = t@@ -96,9 +96,9 @@ NextTimeExactly t -> window (localDay t) (localDay t) | otherwise = NextTimeExactly . startTime <$> findfromtoday False where- findfromtoday anytime = findfrom recurrance afterday today+ findfromtoday anytime = findfrom recurrance afterday today where- today = localDay currenttime+ today = localDay currenttime afterday = sameaslastrun || toolatetoday toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime sameaslastrun = lastrun == Just today@@ -163,8 +163,8 @@ Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing Divisible _ r'@(Divisible _ _) -> findfrom r' afterday candidate where- skip n = findfrom r False (addDays n candidate)- handlediv n r' getval mmax+ skip n = findfrom r False (addDays n candidate)+ handlediv n r' getval mmax | n > 0 && maybe True (n <=) mmax = findfromwhere r' (divisible n . getval) afterday candidate | otherwise = Nothing@@ -267,7 +267,7 @@ constructor u | "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u | otherwise = Nothing- withday sd u = do+ withday sd u = do c <- constructor u d <- readish sd Just $ c (Just d)@@ -285,7 +285,7 @@ fromScheduledTime (SpecificTime h m) = show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm where- pad n s = take (n - length s) (repeat '0') ++ s+ pad n s = take (n - length s) (repeat '0') ++ s (h', ampm) | h == 0 = (12, "AM") | h < 12 = (h, "AM")@@ -304,10 +304,10 @@ (s:[]) -> go s id _ -> Nothing where- h0 h+ h0 h | h == 12 = 0 | otherwise = h- go :: String -> (Int -> Int) -> Maybe ScheduledTime+ go :: String -> (Int -> Int) -> Maybe ScheduledTime go s adjust = let (h, m) = separate (== ':') s in SpecificTime@@ -363,7 +363,7 @@ ] ] where- arbday = oneof+ arbday = oneof [ Just <$> nonNegative arbitrary , pure Nothing ]
src/Utility/ThreadScheduler.hs view
@@ -1,6 +1,6 @@ {- thread scheduling -- - Copyright 2012, 2013 Joey Hess <id@joeyh.name>+ - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - Copyright 2011 Bas van Dijk & Roel van Dijk - - License: BSD-2-clause@@ -57,8 +57,7 @@ waitForTermination :: IO () waitForTermination = do #ifdef mingw32_HOST_OS- runEvery (Seconds 600) $- void getLine+ forever $ threadDelaySeconds (Seconds 6000) #else lock <- newEmptyMVar let check sig = void $
src/Utility/UserInfo.hs view
@@ -1,6 +1,6 @@ {- user info -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012 Joey Hess <joey@kitenet.net> - - License: BSD-2-clause -}@@ -13,8 +13,10 @@ myUserGecos, ) where -import Control.Applicative import System.PosixCompat+#ifndef mingw32_HOST_OS+import Control.Applicative+#endif import Utility.Env @@ -40,16 +42,20 @@ env = ["USERNAME", "USER", "LOGNAME"] #endif -myUserGecos :: IO String-#ifdef __ANDROID__-myUserGecos = return "" -- userGecos crashes on Android+myUserGecos :: IO (Maybe String)+-- userGecos crashes on Android and is not available on Windows.+#if defined(__ANDROID__) || defined(mingw32_HOST_OS)+myUserGecos = return Nothing #else-myUserGecos = myVal [] userGecos+myUserGecos = Just <$> myVal [] userGecos #endif myVal :: [String] -> (UserEntry -> String) -> IO String-myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars+myVal envvars extract = go envvars where- check [] = return Nothing- check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v- getpwent = getUserEntryForID =<< getEffectiveUserID+#ifndef mingw32_HOST_OS+ go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID)+#else+ go [] = error $ "environment not set: " ++ show envvars+#endif+ go (v:vs) = maybe (go vs) return =<< getEnv v