propellor 2.16.0 → 2.17.0
raw patch · 47 files changed
+1857/−952 lines, 47 files
Files
- CHANGELOG +33/−0
- Makefile +1/−1
- README.md +2/−0
- config-freebsd.hs +67/−0
- config-joey.hs +0/−629
- contrib/post-merge-hook +44/−0
- debian/changelog +33/−0
- doc/README.mdwn +2/−0
- joeyconfig.hs +627/−0
- propellor.cabal +18/−6
- src/Propellor.hs +1/−0
- src/Propellor/Bootstrap.hs +55/−15
- src/Propellor/CmdLine.hs +53/−35
- src/Propellor/Git/Config.hs +1/−1
- src/Propellor/Git/VerifiedBranch.hs +2/−1
- src/Propellor/Gpg.hs +33/−33
- src/Propellor/PrivData.hs +6/−8
- src/Propellor/PrivData/Paths.hs +18/−2
- src/Propellor/Property.hs +10/−1
- src/Propellor/Property/Apache.hs +11/−11
- src/Propellor/Property/Apt.hs +31/−14
- src/Propellor/Property/Chroot.hs +8/−7
- src/Propellor/Property/Cron.hs +6/−4
- src/Propellor/Property/Debootstrap.hs +10/−9
- src/Propellor/Property/Docker.hs +13/−13
- src/Propellor/Property/Firewall.hs +81/−70
- src/Propellor/Property/FreeBSD.hs +13/−0
- src/Propellor/Property/FreeBSD/Pkg.hs +85/−0
- src/Propellor/Property/FreeBSD/Poudriere.hs +141/−0
- src/Propellor/Property/Locale.hs +2/−3
- src/Propellor/Property/Network.hs +9/−2
- src/Propellor/Property/OS.hs +1/−1
- src/Propellor/Property/OpenId.hs +4/−4
- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +38/−2
- src/Propellor/Property/Ssh.hs +14/−14
- src/Propellor/Property/Systemd.hs +13/−15
- src/Propellor/Property/Tor.hs +18/−4
- src/Propellor/Property/ZFS.hs +11/−0
- src/Propellor/Property/ZFS/Process.hs +32/−0
- src/Propellor/Property/ZFS/Properties.hs +36/−0
- src/Propellor/Spin.hs +35/−23
- src/Propellor/Types.hs +10/−8
- src/Propellor/Types/OS.hs +26/−0
- src/Propellor/Types/ZFS.hs +133/−0
- src/System/Console/Concurrent/Internal.hs +28/−11
- src/Utility/Process.hs +7/−5
- src/Utility/Process/NonConcurrent.hs +35/−0
CHANGELOG view
@@ -1,3 +1,36 @@+propellor (2.17.0) unstable; urgency=medium++ * Added initial support for FreeBSD.+ Thanks, Evan Cofsky.+ * Added Propellor.Property.ZFS.+ Thanks, Evan Cofsky.+ * Firewall: Reorganized Chain data type. (API change)+ Thanks, Félix Sipma.+ * Firewall: Separated Table and Target (API change)+ Thanks, Félix Sipma.+ * Ssh: change type of listenPort from Int to Port (API change)+ Thanks, Félix Sipma.+ * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch, NatDestination+ Thanks, Félix Sipma.+ * Network: Filter out characters not allowed in interfaces.d files.+ Thanks, Félix Sipma.+ * Apt.upgrade: Run dpkg --configure -a first, to recover from+ interrupted upgrades.+ * Apt: Add safeupgrade.+ * Force ssh, scp, and git commands to be run in the foreground.+ Should fix intermittent hangs of propellor --spin.+ * Avoid repeated re-building on systems such as FreeBSD where building+ re-links the binary even when there are no changes.+ * Locale.available: Run locale-gen, instead of dpkg-reconfigure locales,+ which modified the locale.gen file and sometimes caused the property to+ need to make changes every time.+ * Speed up propellor's build of itself, by asking cabal to only build+ the propellor-config binary and not all the libraries.+ * Tor.named: Fix bug that sometimes caused the property to fail the first+ time, though retrying succeeded.++ -- Joey Hess <id@joeyh.name> Thu, 24 Mar 2016 14:53:31 -0400+ propellor (2.16.0) unstable; urgency=medium * Obnam: Only let one backup job run at a time when a host has multiple
Makefile view
@@ -1,5 +1,5 @@ CABAL?=cabal-DATE := $(shell dpkg-parsechangelog | grep Date | cut -d " " -f2-)+DATE := $(shell dpkg-parsechangelog 2>/dev/null | grep Date | cut -d " " -f2-) # this target is provided (and is first) to keep old versions of the # propellor cron job working, and will eventually be removed
README.md view
@@ -2,6 +2,8 @@ configuration management system using Haskell and Git. Each system has a list of properties, which Propellor ensures are satisfied.+[Linux](http://propellor.branchable.com/Linux/) and+[FreeBSD](http://propellor.branchable.com/FreeBSD/) are supported. Propellor is configured via a git repository, which typically lives in `~/.propellor/` on your development machine. Propellor clones the
+ config-freebsd.hs view
@@ -0,0 +1,67 @@+-- This is the main configuration file for Propellor, and is used to build+-- the propellor program.+--+-- This shows how to set up a FreeBSD host (and a Linux host too).++import Propellor+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Network as Network+import qualified Propellor.Property.Cron as Cron+import Propellor.Property.Scheduled+import qualified Propellor.Property.User as User+import qualified Propellor.Property.Docker as Docker+import qualified Propellor.Property.FreeBSD.Pkg as Pkg+import qualified Propellor.Property.ZFS as ZFS+import qualified Propellor.Property.FreeBSD.Poudriere as Poudriere++main :: IO ()+main = defaultMain hosts++-- The hosts propellor knows about.+hosts :: [Host]+hosts =+ [ freebsdbox+ , linuxbox+ ]++-- An example freebsd host.+freebsdbox :: Host+freebsdbox = host "freebsdbox.example.com"+ & os (System (FreeBSD (FBSDProduction FBSD102)) "amd64")+ & Pkg.update+ & Pkg.upgrade+ & Poudriere.poudriere poudriereZFS+ & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromString "amd64"))++poudriereZFS :: Poudriere.Poudriere+poudriereZFS = Poudriere.defaultConfig+ { Poudriere._zfs = Just $ Poudriere.PoudriereZFS+ (ZFS.ZFS (fromString "zroot") (fromString "poudriere"))+ (ZFS.fromList [ZFS.Mountpoint (fromString "/poudriere"), ZFS.ACLInherit ZFS.AIPassthrough])+ }++-- An example linux host.+linuxbox :: Host+linuxbox = host "linuxbox.example.com"+ & os (System (Debian Unstable) "amd64")+ & Apt.stdSourcesList+ & Apt.unattendedUpgrades+ & Apt.installed ["etckeeper"]+ & Apt.installed ["ssh"]+ & User.hasSomePassword (User "root")+ & Network.ipv6to4+ & File.dirExists "/var/www"+ & Docker.docked webserverContainer+ & Docker.garbageCollected `period` Daily+ & Cron.runPropellor (Cron.Times "30 * * * *")++-- A generic webserver in a Docker container.+webserverContainer :: Docker.Container+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian")+ & os (System (Debian (Stable "jessie")) "amd64")+ & Apt.stdSourcesList+ & Docker.publish "80:80"+ & Docker.volume "/var/www:/var/www"+ & Apt.serviceInstalledRunning "apache2"+
− config-joey.hs
@@ -1,629 +0,0 @@--- This is the live config file used by propellor's author.--- https://propellor.branchable.com/-module Main where--import Propellor-import Propellor.Property.Scheduled-import qualified Propellor.Property.File as File-import qualified Propellor.Property.Apt as Apt-import qualified Propellor.Property.Network as Network-import qualified Propellor.Property.Service as Service-import qualified Propellor.Property.Ssh as Ssh-import qualified Propellor.Property.Cron as Cron-import qualified Propellor.Property.Sudo as Sudo-import qualified Propellor.Property.User as User-import qualified Propellor.Property.Hostname as Hostname-import qualified Propellor.Property.Tor as Tor-import qualified Propellor.Property.Dns as Dns-import qualified Propellor.Property.OpenId as OpenId-import qualified Propellor.Property.Git as Git-import qualified Propellor.Property.Postfix as Postfix-import qualified Propellor.Property.Apache as Apache-import qualified Propellor.Property.LetsEncrypt as LetsEncrypt-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.Journald as Journald-import qualified Propellor.Property.Chroot as Chroot-import qualified Propellor.Property.Fail2Ban as Fail2Ban-import qualified Propellor.Property.Aiccu as Aiccu-import qualified Propellor.Property.OS as OS-import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost-import qualified Propellor.Property.HostingProvider.Linode as Linode-import qualified Propellor.Property.SiteSpecific.GitHome as GitHome-import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder-import qualified Propellor.Property.SiteSpecific.IABak as IABak-import qualified Propellor.Property.SiteSpecific.Branchable as Branchable-import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites-import Propellor.Property.DiskImage--main :: IO () -- _ ______`| ,-.__ -main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'- {- Propellor -- \ / | / ) _.-"-._- Deployed -} -- `/-==__ _/__|/__=-| ( \_-hosts :: [Host] -- * \ | | '--------'-hosts = -- (o) `- [ darkstar- , gnu- , clam- , mayfly- , oyster- , orca- , honeybee- , kite- , elephant- , beaver- , pell- , iabak- ] ++ monsters--testvm :: Host-testvm = host "testvm.kitenet.net"- & os (System (Debian Unstable) "amd64")- & OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")- `onChange` propertyList "fixing up after clean install"- [ OS.preserveRootSshAuthorized- , OS.preserveResolvConf- , Apt.update- , Grub.boots "/dev/sda"- `requires` Grub.installed Grub.PC- ]- & Hostname.sane- & Hostname.searchDomain- & Apt.installed ["linux-image-amd64"]- & Apt.installed ["ssh"]- & User.hasPassword (User "root")--darkstar :: Host-darkstar = host "darkstar.kitenet.net"- & ipv6 "2001:4830:1600:187::2"- & Aiccu.hasConfig "T18376" "JHZ2-SIXXS"-- & Apt.buildDep ["git-annex"] `period` Daily-- & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")- & JoeySites.dkimMilter- & JoeySites.alarmClock "*-*-* 7:30" (User "joey")- "/usr/bin/timeout 45m /home/joey/bin/goodmorning"-- & imageBuilt "/tmp/img" c MSDOS (grubBooted PC)- [ partition EXT2 `mountedAt` "/boot"- `setFlag` BootFlag- , partition EXT4 `mountedAt` "/"- `mountOpt` errorReadonly- , swapPartition (MegaBytes 256)- ]- where- c d = Chroot.debootstrapped mempty d- & os (System (Debian Unstable) "amd64")- & Hostname.setTo "demo"- & Apt.installed ["linux-image-amd64"]- & User "root" `User.hasInsecurePassword` "root"--gnu :: Host-gnu = host "gnu.kitenet.net"- & Apt.buildDep ["git-annex"] `period` Daily-- & JoeySites.postfixClientRelay (Context "gnu.kitenet.net")- & JoeySites.dkimMilter--clam :: Host-clam = standardSystem "clam.kitenet.net" Unstable "amd64"- [ "Unreliable server. Anything here may be lost at any time!" ]- & ipv4 "167.88.41.194"-- & CloudAtCost.decruft- & Ssh.hostKeys hostContext- [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAI3WUq0RaigLlcUivgNG4sXpso2ORZkMvfqKz6zkc60L6dpxvWDNmZVEH8hEjxRSYG07NehcuOgQqeyFnS++xw1hdeGjf37JqCUH49i02lra3Zxv8oPpRxyeqe5MmuzUJhlWvBdlc3O/nqZ4bTUfnxMzSYWyy6++s/BpSHttZplNAAAAFQC1DE0vzgVeNAv9smHLObQWZFe2VQAAAIBECtpJry3GC8NVTFsTHDGWksluoFPIbKiZUFFztZGdM0AO2VwAbiJ6Au6M3VddGFANgTlni6d2/9yS919zO90TaFoIjywZeXhxE2CSuRfU7sx2hqDBk73jlycem/ER0sanFhzpHVpwmLfWneTXImWyq37vhAxatJANOtbj81vQ3AAAAIBV3lcyTT9xWg1Q4vERJbvyF8mCliwZmnIPa7ohveKkxlcgUk5d6dnaqFfjVaiXBPN3Qd08WXoQ/a9k3chBPT9nW2vWgzzM8l36j2MbHLmaxGwevAc9+vx4MXqvnGHzd2ex950mC33ct3j0fzMZlO6vqEsgD4CYmiASxhfefj+JCQ==")- , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJybAjUPUWIhvVMmer8K5ZgdfI54DM6vc8Mzw+5KmVKL0TwkvzbR1HAB4heyMGtN1F8YzkWhsI3/Txh+MQUJ+i4u8SvSYc6D1q3j3ZyCi06wZ3DJS25tZrOM/thOOA1DFA4Hhb0uI/1Kg8PguNNNSMXn8F7q3F6cFQizYgszs6z6ktiST/BTC+IXWovhcnn2vQXXU8FTcTsqBFqA5dEjZbp1WDzqp3km84ZyXGmoVlpqzXeMvlkWTIshYiQjXIwPOkALzlGYjp1lw1OaxPVI1IGFcgCbIWQQWoCReb+genX2VaR+odAYXjaOdRx0lQj7UCPTBCpqMyzBMLtT5Yiaqh")- , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=")- ]- & Apt.unattendedUpgrades- & Network.ipv6to4- & Systemd.persistentJournal- & Journald.systemMaxUse "500MiB"-- & Tor.isRelay- & Tor.named "kite1"- & Tor.bandwidthRate (Tor.PerMonth "400 GB")-- & Systemd.nspawned webserver- & File.dirExists "/var/www/html"- & File.notPresent "/var/www/index.html"- & "/var/www/html/index.html" `File.hasContent` ["hello, world"]- & alias "helloworld.kitenet.net"- - & Systemd.nspawned oldusenetShellBox-- & JoeySites.scrollBox- & alias "scroll.joeyh.name"- & alias "us.scroll.joeyh.name"--mayfly :: Host-mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"- [ "Scratch VM. Contents can change at any time!" ]- & ipv4 "104.167.118.15"-- & CloudAtCost.decruft- & Apt.unattendedUpgrades- & Network.ipv6to4- & Systemd.persistentJournal- & Journald.systemMaxUse "500MiB"- - & Tor.isRelay- & Tor.named "kite3"- & Tor.bandwidthRate (Tor.PerMonth "400 GB")--oyster :: Host-oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"- [ "Unreliable server. Anything here may be lost at any time!" ]- & ipv4 "104.167.117.109"-- & CloudAtCost.decruft- & Ssh.hostKeys hostContext- [ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBP0ws/IxQegVU0RhqnIm5A/vRSPTO70wD4o2Bd1jL970dTetNyXzvWGe1spEbLjIYSLIO7WvOBSE5RhplBKFMUU=")- ]- & Apt.unattendedUpgrades- & Network.ipv6to4- & Systemd.persistentJournal- & Journald.systemMaxUse "500MiB"-- & Tor.isRelay- & Tor.named "kite2"- & Tor.bandwidthRate (Tor.PerMonth "400 GB")- - -- Nothing is using http port 80, so listen on- -- that port for ssh, for traveling on bad networks that- -- block 22.- & Ssh.listenPort 80--orca :: Host-orca = standardSystem "orca.kitenet.net" Unstable "amd64"- [ "Main git-annex build box." ]- & ipv4 "138.38.108.179"-- & Apt.unattendedUpgrades- & Postfix.satellite- & Apt.serviceInstalledRunning "ntp"- & Systemd.persistentJournal-- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer- GitAnnexBuilder.standardAutoBuilder- (System (Debian Unstable) "amd64") Nothing fifteenpast "2h")- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer- GitAnnexBuilder.standardAutoBuilder- (System (Debian Unstable) "i386") Nothing fifteenpast "2h")- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer- GitAnnexBuilder.standardAutoBuilder- (System (Debian (Stable "jessie")) "i386") (Just "ancient") fifteenpast "2h")- & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer- (Cron.Times "1 1 * * *") "3h")- where- fifteenpast = Cron.Times "15 * * * *"--honeybee :: Host-honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"- [ "Arm git-annex build box." ]- - -- I have to travel to get console access, so no automatic- -- upgrades, and try to be robust.- & "/etc/default/rcS" `File.containsLine` "FSCKFIX=yes"-- & Apt.installed ["flash-kernel"]- & "/etc/flash-kernel/machine" `File.hasContent` ["Cubietech Cubietruck"]- & Apt.installed ["linux-image-armmp"]- & Network.dhcp "eth0" `requires` Network.cleanInterfacesFile- & Postfix.satellite- - -- ipv6 used for remote access thru firewalls- & Apt.serviceInstalledRunning "aiccu"- & ipv6 "2001:4830:1600:187::2"- -- restart to deal with failure to connect, tunnel issues, etc- & Cron.job "aiccu restart daily" Cron.Daily (User "root") "/"- "service aiccu stop; service aiccu start"-- -- In case compiler needs more than available ram- & Apt.serviceInstalledRunning "swapspace"-- -- No hardware clock.- & Apt.serviceInstalledRunning "ntp"-- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer- GitAnnexBuilder.armAutoBuilder- (System (Debian Unstable) "armel") Nothing Cron.Daily "22h")---- 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 kite!" ]- & 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")- ]-- & Network.static "eth0" `requires` Network.cleanInterfacesFile- & Apt.installed ["linux-image-amd64"]- & Linode.chainPVGrub 5- & Linode.mlocateEnabled- & Apt.unattendedUpgrades- & Systemd.installed- & Systemd.persistentJournal- & Journald.systemMaxUse "500MiB"- & Ssh.passwordAuthentication True- -- Since ssh password authentication is allowed:- & Fail2Ban.installed- & Apt.serviceInstalledRunning "ntp"- & "/etc/timezone" `File.hasContent` ["US/Eastern"]-- & Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *")- [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam"- , "--client-name=kitenet.net"- , "--exclude=/home"- , "--exclude=/var/cache"- , "--exclude=/var/tmp"- , "--exclude=/srv/git"- , "--exclude=/var/spool/oldusenet"- , "--exclude=.*/tmp/"- , "--one-file-system"- , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]- ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")- `requires` rootsshkey- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")- & Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *")- [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam"- , "--client-name=kitenet.net"- , "--exclude=/home/joey/lib"- , "--one-file-system"- , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]- ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")- `requires` rootsshkey- `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")-- & alias "smtp.kitenet.net"- & alias "imap.kitenet.net"- & alias "pop.kitenet.net"- & alias "mail.kitenet.net"- & JoeySites.kiteMailServer- - & JoeySites.kitenetHttps- & JoeySites.legacyWebSites- & File.ownerGroup "/srv/web" (User "joey") (Group "joey")- & Apt.installed ["analog"]- - & alias "git.kitenet.net"- & alias "git.joeyh.name"- & JoeySites.gitServer hosts-- & JoeySites.downloads hosts- & JoeySites.gitAnnexDistributor- & JoeySites.tmp-- & alias "bitlbee.kitenet.net"- & Apt.serviceInstalledRunning "bitlbee"- & "/etc/bitlbee/bitlbee.conf" `File.hasContent`- [ "[settings]"- , "User = bitlbee"- , "AuthMode = Registered"- , "[defaults]"- ] - `onChange` Service.restarted "bitlbee"- & "/etc/default/bitlbee" `File.containsLine` "BITLBEE_PORT=\"6767\""- `onChange` Service.restarted "bitlbee"-- & Apt.installed- [ "git-annex", "myrepos"- , "build-essential", "make"- , "rss2email", "archivemail"- , "devscripts"- -- Some users have zsh as their login shell.- , "zsh"- ]- - & alias "nntp.olduse.net"- & JoeySites.oldUseNetServer hosts- - & alias "ns4.kitenet.net"- & myDnsPrimary True "kitenet.net" []- & myDnsPrimary True "joeyh.name" []- & myDnsPrimary True "ikiwiki.info" []- & myDnsPrimary True "olduse.net"- [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk")- ]- & alias "ns4.branchable.com"- & branchableSecondary- & Dns.secondaryFor ["animx"] hosts "animx.eu.org"-- -- testing- & Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html"- (LetsEncrypt.AgreeTOS (Just "id@joeyh.name"))- & alias "letsencrypt.joeyh.name"- where- rootsshkey = Ssh.userKeys (User "root")- (Context "kite.kitenet.net")- [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")- ]--elephant :: Host-elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"- [ "Storage, big data, and backups, omnomnom!"- , "(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.userKeys (User "joey") hostContext- [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4wJuQEGno+nJvtE75IKL6JQ08sJHZ9Bzs9Dvu0zuxSEZE30MWK98/twNwCH9PVf2N9m4apfN7f9GHgHTUongfo8xnLAk4PuBSTV74YgKyOCvNYqANuKKa+76PsS/vFf/or3ct++uTEWsRyYD29cQndufwKA4rthAqHG+fifbLDC53AjcldI0zI1RckpPzT+AMazlnSBFMlpKvGD2uzSXALVRXa3vSqWkWd0z7qmIkpmpq0AAgbDLwrGBcUGV/h0rOa2s8zSeirA0tLmHNROl4cZsX0T/6VBGfBRkrHSxL67xJziATw4WPq6spYlxg84pC/5qJVr9SC5HosppbDqgj joey@elephant")- ] - & Apt.serviceInstalledRunning "swapspace"-- & alias "eubackup.kitenet.net"- & Apt.installed ["obnam", "sshfs", "rsync"]- & JoeySites.obnamRepos ["pell", "kite"]- & JoeySites.githubBackup- & JoeySites.rsyncNetBackup hosts-- & alias "podcatcher.kitenet.net"- & JoeySites.podcatcher- - & alias "znc.kitenet.net"- & JoeySites.ircBouncer- & alias "kgb.kitenet.net"- & JoeySites.kgbServer- - & alias "mumble.kitenet.net"- & JoeySites.mumbleServer hosts- - & alias "ns3.kitenet.net"- & myDnsSecondary- - & Systemd.nspawned oldusenetShellBox- & Systemd.nspawned ancientKitenet- & Systemd.nspawned openidProvider- `requires` Apt.serviceInstalledRunning "ntp"- - & JoeySites.scrollBox- & alias "scroll.joeyh.name"- & alias "eu.scroll.joeyh.name"- - -- For https port 443, shellinabox with ssh login to- -- kitenet.net- & alias "shell.kitenet.net"- & Systemd.nspawned kiteShellBox- -- Nothing is using http port 80, so listen on- -- that port for ssh, for traveling on bad networks that- -- block 22.- & Ssh.listenPort 80--beaver :: Host-beaver = host "beaver.kitenet.net"- & ipv6 "2001:4830:1600:195::2"- & Apt.serviceInstalledRunning "aiccu"- & Apt.installed ["ssh"]- & Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw=="- & alias "usbackup.kitenet.net"- & JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup"- & Apt.serviceInstalledRunning "anacron"- & Cron.niceJob "system disk backed up" Cron.Weekly (User "root") "/"- "rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/"---- Branchable is not completely deployed with propellor yet.-pell :: Host-pell = host "pell.branchable.com"- & alias "branchable.com"- & ipv4 "66.228.46.55"- & ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"- - -- All the websites I host at branchable that don't use- -- branchable.com dns.- & alias "olduse.net"- & alias "www.olduse.net"- & alias "www.kitenet.net"- & alias "joeyh.name"- & alias "campaign.joeyh.name"- & alias "ikiwiki.info"- & alias "git.ikiwiki.info"- & alias "l10n.ikiwiki.info"- & alias "dist-bugs.kitenet.net"- & alias "family.kitenet.net"-- & Apt.installed ["linux-image-amd64"]- & Linode.chainPVGrub 5- & Apt.unattendedUpgrades- & Branchable.server hosts--iabak :: Host-iabak = host "iabak.archiveteam.org"- & ipv4 "124.6.40.227"- & Hostname.sane- & os (System (Debian Testing) "amd64")- & Systemd.persistentJournal- & Cron.runPropellor (Cron.Times "30 * * * *")- & Apt.stdSourcesList `onChange` Apt.upgrade- & Apt.installed ["git", "ssh"]- & Ssh.hostKeys (Context "iabak.archiveteam.org")- [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAMhuYTshLxavWCpfyJxg3j/GWyIRlL3VTharsfUTzMOqyMSWantZjflfJX21z2KzFDtPEA711GYztsgMVXMrsPQInaOKNISe/R9cfgnEktKTxeppWTfw0GTNcpCeeecddU0FCPVW3a6yDoT6+Rv0jPvkQoDGmhQ40MhauMrO0mJ9AAAAFQDpCbXG8o/3Sg7wrsp5abizJoQ0yQAAAIEAxxyHo/ZhDPP+EWtDS05s5dwiDMUsxIllk1NeleAOQIyLtFkaifOeskDJybIPWYPGX1trjcPoGuXJ5GBYrRaPiu6FBvYdYMFRLr4uNBsaSHHqlHhBPkP3RzCrdUyau4XyjdE4iA0EQlO+u11A+o3f7aTuJSveM0YRfbqvaatG89EAAACAWd0h0SkRLnGjBzkou0SQfYujFY9ilhWXPWV/oOs+bieDSpvfmnaEfLSinVFRrJPvQp/dtpxPLEm+StrK3w6dmwTZVUM5JEoB1mRjBkVs6gPC9PVVg9qLpzC2/x+r5cTfrffjyRrlPdkwLKpO6oiPxTIxAyCW8ixjafkxe2hAeJo=")- , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDP13oPRLRY0V9ZDWojb8TgHbUdE30Nq3b541TwPmlLMbYPAhldxGHkuXGlX8g9/FYP/1AgkPcxs2Uc61ZV+1Ss7q7t52f4R0bO4WHqxfdXHd9FlLzMLWxMU3aMr693pGlhnUp3/xH6O6/+bNEIo3VGGgv9XDr2cAxypS9J7X9ibHZcZ3BGvoCR+nnFJ00ERG2tREKZBPDWKk76lhCiM21fG/CSmcApXaA45FHDaM9/2Clj1sXvoS72f0hEKpl1m08sUx+F0GPzQESnKqNFl+xXdYPPbfhdrgCnDmx9tL5NnXsJU2beFiuxpICOeB1HV6DJsdlO18WqwXYhOg/2A1H3")- , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHb0kXcrF5ThwS8wB0Hez404Zp9bz78ZxEGSqnwuF4d/N3+bymg7/HAj7l/SzRoEXKHsJ7P5320oMxBHeM16Y+k=")- ]- & Apt.installed ["etckeeper", "sudo"]- & Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]- & User.hasSomePassword (User "root")- & propertyList "admin accounts"- (map User.accountFor admins ++ map Sudo.enabledFor admins)- & User.hasSomePassword (User "joey")- & GitHome.installedFor (User "joey")- & Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"- & Apt.installed ["sudo"]- & Ssh.noPasswords- & IABak.gitServer monsters- & IABak.registrationServer monsters- & IABak.graphiteServer- & IABak.publicFace- where- admins = map User ["joey", "db48x"]-- --' __|II| ,.- ---- __|II|II|__ ( \_,/\---'-------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-.-'---------------------------- | [Containers] / ----------------------------------------------------- : / ------------------------------------------------------- \____, o ,' --------------------------------------------------------- '--,___________,' --------------------------------- Simple web server, publishing the outside host's /var/www-webserver :: Systemd.Container-webserver = standardStableContainer "webserver"- & Systemd.bind "/var/www"- & Apache.installed---- My own openid provider. Uses php, so containerized for security--- and administrative sanity.-openidProvider :: Systemd.Container-openidProvider = standardStableContainer "openid-provider"- & alias hn- & OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))- where- hn = "openid.kitenet.net"---- Exhibit: kite's 90's website on port 1994.-ancientKitenet :: Systemd.Container-ancientKitenet = standardStableContainer "ancient-kitenet"- & alias hn- & Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"- (Just "remotes/origin/old-kitenet.net")- & Apache.installed- & Apache.listenPorts [p]- & Apache.virtualHost hn p "/var/www/html"- & Apache.siteDisabled "000-default"- where- p = Port 1994- hn = "ancient.kitenet.net"--oldusenetShellBox :: Systemd.Container-oldusenetShellBox = standardStableContainer "oldusenet-shellbox"- & alias "shell.olduse.net"- & JoeySites.oldUseNetShellBox--kiteShellBox :: Systemd.Container-kiteShellBox = standardStableContainer "kiteshellbox"- & JoeySites.kiteShellBox--type Motd = [String]---- This is my standard system setup.-standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host-standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd- & Ssh.noPasswords--standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host-standardSystemUnhardened hn suite arch motd = host hn- & os (System (Debian suite) arch)- & Hostname.sane- & Hostname.searchDomain- & File.hasContent "/etc/motd" ("":motd++[""])- & Apt.stdSourcesList `onChange` Apt.upgrade- & Apt.cacheCleaned- & Apt.installed ["etckeeper"]- & Apt.installed ["ssh", "mosh"]- & GitHome.installedFor (User "root")- & User.hasSomePassword (User "root")- & User.accountFor (User "joey")- & User.hasSomePassword (User "joey")- & Sudo.enabledFor (User "joey")- & GitHome.installedFor (User "joey")- & Apt.installed ["vim", "screen", "less"]- & Cron.runPropellor (Cron.Times "30 * * * *")- -- I use postfix, or no MTA.- & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]- `onChange` Apt.autoRemove---- This is my standard container setup, Featuring automatic upgrades.-standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container-standardContainer name suite arch =- Systemd.container name system (Chroot.debootstrapped mempty)- & Apt.stdSourcesList `onChange` Apt.upgrade- & Apt.unattendedUpgrades- & Apt.cacheCleaned- where- system = System (Debian suite) arch--standardStableContainer :: Systemd.MachineName -> Systemd.Container-standardStableContainer name = standardContainer name (Stable "jessie") "amd64"--myDnsSecondary :: Property HasInfo-myDnsSecondary = propertyList "dns secondary for all my domains" $ props- & Dns.secondary hosts "kitenet.net"- & Dns.secondary hosts "joeyh.name"- & Dns.secondary hosts "ikiwiki.info"- & Dns.secondary hosts "olduse.net"--branchableSecondary :: RevertableProperty HasInfo-branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"---- Currently using kite (ns4) as primary with secondaries--- elephant (ns3) and gandi.--- kite handles all mail.-myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty HasInfo-myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain- (Dns.mkSOA "ns4.kitenet.net" 100) $- [ (RootDomain, NS $ AbsDomain "ns4.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 a:kitenet.net ~all")- , JoeySites.domainKey- ] ++ extras---monsters :: [Host] -- Systems I don't manage with propellor,-monsters = -- but do want to track their public keys etc.- [ host "usw-s002.rsync.net"- & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd"- , host "github.com" - & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="- , host "gitlab.com"- & Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="- , host "ns6.gandi.net"- & ipv4 "217.70.177.40"- , host "turtle.kitenet.net"- & ipv4 "67.223.19.96"- & ipv6 "2001:4978:f:2d9::2"- , host "mouse.kitenet.net"- & ipv6 "2001:4830:1600:492::2"- , host "animx"- & ipv4 "76.7.162.101"- & ipv4 "76.7.162.186"- ]---- -- o- -- ___ o o- {-----\ / o \ ___o o- { \ __ \ / _ (X___>-- __o- _____________________{ ______\___ \__/ | \__/ \____ |X__>- < \___//|\\___/\ \____________ _- \ ___/ | \___ # # \ (-)- \ O O O # | \ # >=)- \______________________________# # / #__________________/ (-}--
+ contrib/post-merge-hook view
@@ -0,0 +1,44 @@+#!/bin/sh+#+# git post-merge hook, used by propellor's author to maintain a+# joeyconfig branch with some changes while being able to merge+# between it and branches without the changes.+#+# Each time this hook is run, it checks if it's on a branch with+# name ending in "config". If so, config.hs is pointed at $branch.hs+# and privdata/relocate is written to make files in privdata/.$branch/ be+# used.+# +# Otherwise, config.hs is pointed at config-simple.hs, and+# privdata/relocate is removed.++set -e++commit () {+ if [ -n "$(git status --short privdata/relocate config.hs)" ]; then+ git commit privdata/relocate config.hs -m "$1"+ fi+}++branch="$(git symbolic-ref --short HEAD)"+case "$branch" in+ "")+ true+ ;;+ *config)+ ln -sf "$branch".hs config.hs+ git add config.hs+ echo ".$branch" > privdata/relocate+ git add privdata/relocate+ commit "setting up $branch after merge"+ ;;+ *)+ ln -sf config-simple.hs config.hs+ git add config.hs+ if [ -e privdata/relocate ]; then+ rm -f privdata/relocate+ git rm --quiet privdata/relocate+ fi+ commit "clean up after merge"+ ;;+esac
debian/changelog view
@@ -1,3 +1,36 @@+propellor (2.17.0) unstable; urgency=medium++ * Added initial support for FreeBSD.+ Thanks, Evan Cofsky.+ * Added Propellor.Property.ZFS.+ Thanks, Evan Cofsky.+ * Firewall: Reorganized Chain data type. (API change)+ Thanks, Félix Sipma.+ * Firewall: Separated Table and Target (API change)+ Thanks, Félix Sipma.+ * Ssh: change type of listenPort from Int to Port (API change)+ Thanks, Félix Sipma.+ * Firewall: add TCPFlag, Frequency, TCPSyn, ICMPTypeMatch, NatDestination+ Thanks, Félix Sipma.+ * Network: Filter out characters not allowed in interfaces.d files.+ Thanks, Félix Sipma.+ * Apt.upgrade: Run dpkg --configure -a first, to recover from+ interrupted upgrades.+ * Apt: Add safeupgrade.+ * Force ssh, scp, and git commands to be run in the foreground.+ Should fix intermittent hangs of propellor --spin.+ * Avoid repeated re-building on systems such as FreeBSD where building+ re-links the binary even when there are no changes.+ * Locale.available: Run locale-gen, instead of dpkg-reconfigure locales,+ which modified the locale.gen file and sometimes caused the property to+ need to make changes every time.+ * Speed up propellor's build of itself, by asking cabal to only build+ the propellor-config binary and not all the libraries.+ * Tor.named: Fix bug that sometimes caused the property to fail the first+ time, though retrying succeeded.++ -- Joey Hess <id@joeyh.name> Thu, 24 Mar 2016 14:53:31 -0400+ propellor (2.16.0) unstable; urgency=medium * Obnam: Only let one backup job run at a time when a host has multiple
doc/README.mdwn view
@@ -2,6 +2,8 @@ configuration management system using Haskell and Git. Each system has a list of properties, which Propellor ensures are satisfied.+[Linux](http://propellor.branchable.com/Linux/) and+[FreeBSD](http://propellor.branchable.com/FreeBSD/) are supported. Propellor is configured via a git repository, which typically lives in `~/.propellor/` on your development machine. Propellor clones the
+ joeyconfig.hs view
@@ -0,0 +1,627 @@+-- This is the live config file used by propellor's author.+-- https://propellor.branchable.com/+module Main where++import Propellor+import Propellor.Property.Scheduled+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Network as Network+import qualified Propellor.Property.Service as Service+import qualified Propellor.Property.Ssh as Ssh+import qualified Propellor.Property.Cron as Cron+import qualified Propellor.Property.Sudo as Sudo+import qualified Propellor.Property.User as User+import qualified Propellor.Property.Hostname as Hostname+import qualified Propellor.Property.Tor as Tor+import qualified Propellor.Property.Dns as Dns+import qualified Propellor.Property.OpenId as OpenId+import qualified Propellor.Property.Git as Git+import qualified Propellor.Property.Postfix as Postfix+import qualified Propellor.Property.Apache as Apache+import qualified Propellor.Property.LetsEncrypt as LetsEncrypt+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.Journald as Journald+import qualified Propellor.Property.Chroot as Chroot+import qualified Propellor.Property.Fail2Ban as Fail2Ban+import qualified Propellor.Property.Aiccu as Aiccu+import qualified Propellor.Property.OS as OS+import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost+import qualified Propellor.Property.HostingProvider.Linode as Linode+import qualified Propellor.Property.SiteSpecific.GitHome as GitHome+import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder+import qualified Propellor.Property.SiteSpecific.IABak as IABak+import qualified Propellor.Property.SiteSpecific.Branchable as Branchable+import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites+import Propellor.Property.DiskImage++main :: IO () -- _ ______`| ,-.__+main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'+ {- Propellor -- \ / | / ) _.-"-._+ Deployed -} -- `/-==__ _/__|/__=-| ( \_+hosts :: [Host] -- * \ | | '--------'+hosts = -- (o) `+ [ darkstar+ , gnu + , clam+ , mayfly+ , oyster+ , orca+ , honeybee+ , kite+ , elephant+ , beaver+ , pell+ , iabak+ ] ++ monsters++testvm :: Host+testvm = host "testvm.kitenet.net"+ & os (System (Debian Unstable) "amd64")+ & OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")+ `onChange` propertyList "fixing up after clean install"+ [ OS.preserveRootSshAuthorized+ , OS.preserveResolvConf+ , Apt.update+ , Grub.boots "/dev/sda"+ `requires` Grub.installed Grub.PC+ ]+ & Hostname.sane+ & Hostname.searchDomain+ & Apt.installed ["linux-image-amd64"]+ & Apt.installed ["ssh"]+ & User.hasPassword (User "root")++darkstar :: Host+darkstar = host "darkstar.kitenet.net"+ & ipv6 "2001:4830:1600:187::2"+ & Aiccu.hasConfig "T18376" "JHZ2-SIXXS"++ & Apt.buildDep ["git-annex"] `period` Daily++ & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net")+ & JoeySites.dkimMilter+ & JoeySites.alarmClock "*-*-* 7:30" (User "joey")+ "/usr/bin/timeout 45m /home/joey/bin/goodmorning"++ ! imageBuilt "/tmp/img" c MSDOS (grubBooted PC)+ [ partition EXT2 `mountedAt` "/boot"+ `setFlag` BootFlag+ , partition EXT4 `mountedAt` "/"+ `mountOpt` errorReadonly+ , swapPartition (MegaBytes 256)+ ]+ where+ c d = Chroot.debootstrapped mempty d+ & os (System (Debian Unstable) "amd64")+ & Hostname.setTo "demo"+ & Apt.installed ["linux-image-amd64"]+ & User "root" `User.hasInsecurePassword` "root"++gnu :: Host+gnu = host "gnu.kitenet.net"+ & Apt.buildDep ["git-annex"] `period` Daily++ & JoeySites.postfixClientRelay (Context "gnu.kitenet.net")+ & JoeySites.dkimMilter++clam :: Host+clam = standardSystem "clam.kitenet.net" Unstable "amd64"+ [ "Unreliable server. Anything here may be lost at any time!" ]+ & ipv4 "167.88.41.194"++ & CloudAtCost.decruft+ & Ssh.hostKeys hostContext+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAI3WUq0RaigLlcUivgNG4sXpso2ORZkMvfqKz6zkc60L6dpxvWDNmZVEH8hEjxRSYG07NehcuOgQqeyFnS++xw1hdeGjf37JqCUH49i02lra3Zxv8oPpRxyeqe5MmuzUJhlWvBdlc3O/nqZ4bTUfnxMzSYWyy6++s/BpSHttZplNAAAAFQC1DE0vzgVeNAv9smHLObQWZFe2VQAAAIBECtpJry3GC8NVTFsTHDGWksluoFPIbKiZUFFztZGdM0AO2VwAbiJ6Au6M3VddGFANgTlni6d2/9yS919zO90TaFoIjywZeXhxE2CSuRfU7sx2hqDBk73jlycem/ER0sanFhzpHVpwmLfWneTXImWyq37vhAxatJANOtbj81vQ3AAAAIBV3lcyTT9xWg1Q4vERJbvyF8mCliwZmnIPa7ohveKkxlcgUk5d6dnaqFfjVaiXBPN3Qd08WXoQ/a9k3chBPT9nW2vWgzzM8l36j2MbHLmaxGwevAc9+vx4MXqvnGHzd2ex950mC33ct3j0fzMZlO6vqEsgD4CYmiASxhfefj+JCQ==")+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJybAjUPUWIhvVMmer8K5ZgdfI54DM6vc8Mzw+5KmVKL0TwkvzbR1HAB4heyMGtN1F8YzkWhsI3/Txh+MQUJ+i4u8SvSYc6D1q3j3ZyCi06wZ3DJS25tZrOM/thOOA1DFA4Hhb0uI/1Kg8PguNNNSMXn8F7q3F6cFQizYgszs6z6ktiST/BTC+IXWovhcnn2vQXXU8FTcTsqBFqA5dEjZbp1WDzqp3km84ZyXGmoVlpqzXeMvlkWTIshYiQjXIwPOkALzlGYjp1lw1OaxPVI1IGFcgCbIWQQWoCReb+genX2VaR+odAYXjaOdRx0lQj7UCPTBCpqMyzBMLtT5Yiaqh")+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=")+ ]+ & Apt.unattendedUpgrades+ & Network.ipv6to4+ & Systemd.persistentJournal+ & Journald.systemMaxUse "500MiB"++ & Tor.isRelay+ & Tor.named "kite1"+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")++ & Systemd.nspawned webserver+ & File.dirExists "/var/www/html"+ & File.notPresent "/var/www/index.html"+ & "/var/www/html/index.html" `File.hasContent` ["hello, world"]+ & alias "helloworld.kitenet.net"++ & Systemd.nspawned oldusenetShellBox++ & JoeySites.scrollBox+ & alias "scroll.joeyh.name"+ & alias "us.scroll.joeyh.name"++mayfly :: Host+mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"+ [ "Scratch VM. Contents can change at any time!" ]+ & ipv4 "167.88.36.193"++ & CloudAtCost.decruft+ & Apt.unattendedUpgrades+ & Network.ipv6to4+ & Systemd.persistentJournal+ & Journald.systemMaxUse "500MiB"++ & Tor.isRelay+ & Tor.named "kite3"+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")++oyster :: Host+oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"+ [ "Unreliable server. Anything here may be lost at any time!" ]+ & ipv4 "104.167.117.109"++ & CloudAtCost.decruft+ & Ssh.hostKeys hostContext+ [ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBP0ws/IxQegVU0RhqnIm5A/vRSPTO70wD4o2Bd1jL970dTetNyXzvWGe1spEbLjIYSLIO7WvOBSE5RhplBKFMUU=")+ ]+ & Apt.unattendedUpgrades+ & Network.ipv6to4+ & Systemd.persistentJournal+ & Journald.systemMaxUse "500MiB"++ & Tor.isRelay+ & Tor.named "kite2"+ & Tor.bandwidthRate (Tor.PerMonth "400 GB")++ -- Nothing is using http port 80, so listen on+ -- that port for ssh, for traveling on bad networks that+ -- block 22.+ & Ssh.listenPort (Port 80)++orca :: Host+orca = standardSystem "orca.kitenet.net" Unstable "amd64"+ [ "Main git-annex build box." ]+ & ipv4 "138.38.108.179"++ & Apt.unattendedUpgrades+ & Postfix.satellite+ & Apt.serviceInstalledRunning "ntp"+ & Systemd.persistentJournal++ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer+ GitAnnexBuilder.standardAutoBuilder+ (System (Debian Unstable) "amd64") Nothing (Cron.Times "15 * * * *") "2h")+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer+ GitAnnexBuilder.standardAutoBuilder+ (System (Debian Unstable) "i386") Nothing (Cron.Times "30 * * * *") "2h")+ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer+ GitAnnexBuilder.stackAutoBuilder+ (System (Debian (Stable "jessie")) "i386") (Just "ancient") (Cron.Times "45 * * * *") "2h")+ & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer+ (Cron.Times "1 1 * * *") "3h")++honeybee :: Host+honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf"+ [ "Arm git-annex build box." ]++ -- I have to travel to get console access, so no automatic+ -- upgrades, and try to be robust.+ & "/etc/default/rcS" `File.containsLine` "FSCKFIX=yes"++ & Apt.installed ["flash-kernel"]+ & "/etc/flash-kernel/machine" `File.hasContent` ["Cubietech Cubietruck"]+ & Apt.installed ["linux-image-armmp"]+ & Network.dhcp "eth0" `requires` Network.cleanInterfacesFile+ & Postfix.satellite++ -- ipv6 used for remote access thru firewalls+ & Apt.serviceInstalledRunning "aiccu"+ & ipv6 "2001:4830:1600:187::2"+ -- restart to deal with failure to connect, tunnel issues, etc+ & Cron.job "aiccu restart daily" Cron.Daily (User "root") "/"+ "service aiccu stop; service aiccu start"++ -- In case compiler needs more than available ram+ & Apt.serviceInstalledRunning "swapspace"++ -- No hardware clock.+ & Apt.serviceInstalledRunning "ntp"++ & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer+ GitAnnexBuilder.armAutoBuilder+ (System (Debian Unstable) "armel") Nothing Cron.Daily "22h")++-- 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 kite!" ]+ & 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")+ ]++ & Network.static "eth0" `requires` Network.cleanInterfacesFile+ & Apt.installed ["linux-image-amd64"]+ & Linode.chainPVGrub 5+ & Linode.mlocateEnabled+ & Apt.unattendedUpgrades+ & Systemd.installed+ & Systemd.persistentJournal+ & Journald.systemMaxUse "500MiB"+ & Ssh.passwordAuthentication True+ -- Since ssh password authentication is allowed:+ & Fail2Ban.installed+ & Apt.serviceInstalledRunning "ntp"+ & "/etc/timezone" `File.hasContent` ["US/Eastern"]++ & Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *")+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam"+ , "--client-name=kitenet.net"+ , "--exclude=/home"+ , "--exclude=/var/cache"+ , "--exclude=/var/tmp"+ , "--exclude=/srv/git"+ , "--exclude=/var/spool/oldusenet"+ , "--exclude=.*/tmp/"+ , "--one-file-system"+ , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]+ ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")+ `requires` rootsshkey+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")+ & Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *")+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam"+ , "--client-name=kitenet.net"+ , "--exclude=/home/joey/lib"+ , "--one-file-system"+ , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]+ ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")+ `requires` rootsshkey+ `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")++ & alias "smtp.kitenet.net"+ & alias "imap.kitenet.net"+ & alias "pop.kitenet.net"+ & alias "mail.kitenet.net"+ & JoeySites.kiteMailServer++ & JoeySites.kitenetHttps+ & JoeySites.legacyWebSites+ & File.ownerGroup "/srv/web" (User "joey") (Group "joey")+ & Apt.installed ["analog"]++ & alias "git.kitenet.net"+ & alias "git.joeyh.name"+ & JoeySites.gitServer hosts++ & JoeySites.downloads hosts+ & JoeySites.gitAnnexDistributor+ & JoeySites.tmp++ & alias "bitlbee.kitenet.net"+ & Apt.serviceInstalledRunning "bitlbee"+ & "/etc/bitlbee/bitlbee.conf" `File.hasContent`+ [ "[settings]"+ , "User = bitlbee"+ , "AuthMode = Registered"+ , "[defaults]"+ ]+ `onChange` Service.restarted "bitlbee"+ & "/etc/default/bitlbee" `File.containsLine` "BITLBEE_PORT=\"6767\""+ `onChange` Service.restarted "bitlbee"++ & Apt.installed+ [ "git-annex", "myrepos"+ , "build-essential", "make"+ , "rss2email", "archivemail"+ , "devscripts"+ -- Some users have zsh as their login shell.+ , "zsh"+ ]++ & alias "nntp.olduse.net"+ & JoeySites.oldUseNetServer hosts++ & alias "ns4.kitenet.net"+ & myDnsPrimary True "kitenet.net" []+ & myDnsPrimary True "joeyh.name" []+ & myDnsPrimary True "ikiwiki.info" []+ & myDnsPrimary True "olduse.net"+ [ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk")+ ]+ & alias "ns4.branchable.com"+ & branchableSecondary+ & Dns.secondaryFor ["animx"] hosts "animx.eu.org"++ -- testing+ & Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html"+ (LetsEncrypt.AgreeTOS (Just "id@joeyh.name"))+ & alias "letsencrypt.joeyh.name"+ where+ rootsshkey = Ssh.userKeys (User "root")+ (Context "kite.kitenet.net")+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")+ ]++elephant :: Host+elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"+ [ "Storage, big data, and backups, omnomnom!"+ , "(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.userKeys (User "joey") hostContext+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4wJuQEGno+nJvtE75IKL6JQ08sJHZ9Bzs9Dvu0zuxSEZE30MWK98/twNwCH9PVf2N9m4apfN7f9GHgHTUongfo8xnLAk4PuBSTV74YgKyOCvNYqANuKKa+76PsS/vFf/or3ct++uTEWsRyYD29cQndufwKA4rthAqHG+fifbLDC53AjcldI0zI1RckpPzT+AMazlnSBFMlpKvGD2uzSXALVRXa3vSqWkWd0z7qmIkpmpq0AAgbDLwrGBcUGV/h0rOa2s8zSeirA0tLmHNROl4cZsX0T/6VBGfBRkrHSxL67xJziATw4WPq6spYlxg84pC/5qJVr9SC5HosppbDqgj joey@elephant")+ ]+ & Apt.serviceInstalledRunning "swapspace"++ & alias "eubackup.kitenet.net"+ & Apt.installed ["obnam", "sshfs", "rsync"]+ & JoeySites.obnamRepos ["pell", "kite"]+ & JoeySites.githubBackup+ & JoeySites.rsyncNetBackup hosts++ & alias "podcatcher.kitenet.net"+ & JoeySites.podcatcher++ & alias "znc.kitenet.net"+ & JoeySites.ircBouncer+ & alias "kgb.kitenet.net"+ & JoeySites.kgbServer++ & alias "mumble.kitenet.net"+ & JoeySites.mumbleServer hosts++ & alias "ns3.kitenet.net"+ & myDnsSecondary++ & Systemd.nspawned oldusenetShellBox+ & Systemd.nspawned ancientKitenet+ & Systemd.nspawned openidProvider+ `requires` Apt.serviceInstalledRunning "ntp"++ & JoeySites.scrollBox+ & alias "scroll.joeyh.name"+ & alias "eu.scroll.joeyh.name"++ -- For https port 443, shellinabox with ssh login to+ -- kitenet.net+ & alias "shell.kitenet.net"+ & Systemd.nspawned kiteShellBox+ -- Nothing is using http port 80, so listen on+ -- that port for ssh, for traveling on bad networks that+ -- block 22.+ & Ssh.listenPort (Port 80)++beaver :: Host+beaver = host "beaver.kitenet.net"+ & ipv6 "2001:4830:1600:195::2"+ & Apt.serviceInstalledRunning "aiccu"+ & Apt.installed ["ssh"]+ & Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw=="+ & alias "usbackup.kitenet.net"+ & JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup"+ & Apt.serviceInstalledRunning "anacron"+ & Cron.niceJob "system disk backed up" Cron.Weekly (User "root") "/"+ "rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/"++-- Branchable is not completely deployed with propellor yet.+pell :: Host+pell = host "pell.branchable.com"+ & alias "branchable.com"+ & ipv4 "66.228.46.55"+ & ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"++ -- All the websites I host at branchable that don't use+ -- branchable.com dns.+ & alias "olduse.net"+ & alias "www.olduse.net"+ & alias "www.kitenet.net"+ & alias "joeyh.name"+ & alias "campaign.joeyh.name"+ & alias "ikiwiki.info"+ & alias "git.ikiwiki.info"+ & alias "l10n.ikiwiki.info"+ & alias "dist-bugs.kitenet.net"+ & alias "family.kitenet.net"++ & Apt.installed ["linux-image-amd64"]+ & Linode.chainPVGrub 5+ & Apt.unattendedUpgrades+ & Branchable.server hosts++iabak :: Host+iabak = host "iabak.archiveteam.org"+ & ipv4 "124.6.40.227"+ & Hostname.sane+ & os (System (Debian Testing) "amd64")+ & Systemd.persistentJournal+ & Cron.runPropellor (Cron.Times "30 * * * *")+ & Apt.stdSourcesList `onChange` Apt.upgrade+ & Apt.installed ["git", "ssh"]+ & Ssh.hostKeys (Context "iabak.archiveteam.org")+ [ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAMhuYTshLxavWCpfyJxg3j/GWyIRlL3VTharsfUTzMOqyMSWantZjflfJX21z2KzFDtPEA711GYztsgMVXMrsPQInaOKNISe/R9cfgnEktKTxeppWTfw0GTNcpCeeecddU0FCPVW3a6yDoT6+Rv0jPvkQoDGmhQ40MhauMrO0mJ9AAAAFQDpCbXG8o/3Sg7wrsp5abizJoQ0yQAAAIEAxxyHo/ZhDPP+EWtDS05s5dwiDMUsxIllk1NeleAOQIyLtFkaifOeskDJybIPWYPGX1trjcPoGuXJ5GBYrRaPiu6FBvYdYMFRLr4uNBsaSHHqlHhBPkP3RzCrdUyau4XyjdE4iA0EQlO+u11A+o3f7aTuJSveM0YRfbqvaatG89EAAACAWd0h0SkRLnGjBzkou0SQfYujFY9ilhWXPWV/oOs+bieDSpvfmnaEfLSinVFRrJPvQp/dtpxPLEm+StrK3w6dmwTZVUM5JEoB1mRjBkVs6gPC9PVVg9qLpzC2/x+r5cTfrffjyRrlPdkwLKpO6oiPxTIxAyCW8ixjafkxe2hAeJo=")+ , (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDP13oPRLRY0V9ZDWojb8TgHbUdE30Nq3b541TwPmlLMbYPAhldxGHkuXGlX8g9/FYP/1AgkPcxs2Uc61ZV+1Ss7q7t52f4R0bO4WHqxfdXHd9FlLzMLWxMU3aMr693pGlhnUp3/xH6O6/+bNEIo3VGGgv9XDr2cAxypS9J7X9ibHZcZ3BGvoCR+nnFJ00ERG2tREKZBPDWKk76lhCiM21fG/CSmcApXaA45FHDaM9/2Clj1sXvoS72f0hEKpl1m08sUx+F0GPzQESnKqNFl+xXdYPPbfhdrgCnDmx9tL5NnXsJU2beFiuxpICOeB1HV6DJsdlO18WqwXYhOg/2A1H3")+ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHb0kXcrF5ThwS8wB0Hez404Zp9bz78ZxEGSqnwuF4d/N3+bymg7/HAj7l/SzRoEXKHsJ7P5320oMxBHeM16Y+k=")+ ]+ & Apt.installed ["etckeeper", "sudo"]+ & Apt.installed ["vim", "screen", "tmux", "less", "emax-nox", "netcat"]+ & User.hasSomePassword (User "root")+ & propertyList "admin accounts"+ (map User.accountFor admins ++ map Sudo.enabledFor admins)+ & User.hasSomePassword (User "joey")+ & GitHome.installedFor (User "joey")+ & Ssh.authorizedKey (User "db48x") "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAIAQDQ6urXcMDeyuFf4Ga7CuGezTShKnEMPHKJm7RQUtw3yXCPX5wnbvPS2+UFnHMzJvWOX5S5b/XpBpOusP0jLpxwOCEg4nA5b7uvWJ2VIChlMqopYMo+tDOYzK/Q74MZiNWi2hvf1tn3N9SnqOa7muBMKMENIX5KJdH8cJ/BaPqAP883gF8r2SwSZFvaB0xYCT/CIylC593n/+0+Lm07NUJIO8jil3n2SwXdVg6ib65FxZoO86M46wTghnB29GXqrzraOg+5DY1zzCWpIUtFwGr4DP0HqLVtmAkC7NI14l1M0oHE0UEbhoLx/a+mOIMD2DuzW3Rs3ZmHtGLj4PL/eBU8D33AqSeM0uR/0pEcoq6A3a8ixibj9MBYD2lMh+Doa2audxS1OLM//FeNccbm1zlvvde82PZtiO11P98uN+ja4A+CfgQU5s0z0wikc4gXNhWpgvz8DrOEJrjstwOoqkLg2PpIdHRw7dhpp3K1Pc+CGAptDwbKkxs4rzUgMbO9DKI7fPcXXgKHLLShMpmSA2vsQUMfuCp2cVrQJ+Vkbwo29N0Js5yU7L4NL4H854Nbk5uwWJCs/mjXtvTimN2va23HEecTpk44HDUjJ9NyevAfPcO9q1ZtgXFTQSMcdv1m10Fvmnaiy8biHnopL6MBo1VRITh5UFiJYfK4kpTTg2vSspii/FYkkYOAnnZtXZqMehP7OZjJ6HWJpsCVR2hxP3sKOoQu+kcADWa/4obdp+z7gY8iMMjd6kwuIWsNV8KsX+eVJ4UFpAi/L00ZjI2B9QLVCsOg6D1fT0698wEchwUROy5vZZJq0078BdAGnwC0WGLt+7OUgn3O2gUAkb9ffD0odbZSqq96NCelM6RaHA+AaIE4tjGL3lFkyOtb+IGPNACQ73/lmaRQd6Cgasq9cEo0g22Ew5NQi0CBuu1aLDk7ezu3SbU09eB9lcZ+8lFnl5K2eQFeVJStFJbJNfOvgKyOb7ePsrUFF5GJ2J/o1F60fRnG64HizZHxyFWkEOh+k3i8qO+whPa5MTQeYLYb6ysaTPrUwNRcSNNCcPEN8uYOh1dOFAtIYDcYA56BZ321yz0b5umj+pLsrFU+4wMjWxZi0inJzDS4dVegBVcRm0NP5u8VRosJQE9xdbt5K1I0khzhrEW1kowoTbhsZCaDHhL9LZo73Z1WIHvulvlF3RLZip5hhtQu3ZVkbdV5uts8AWaEWVnIu9z0GtQeeOuseZpT0u1/1xjVAOKIzuY3sB7FKOaipe8TDvmdiQf/ICySqqYaYhN6GOhiYccSleoX6yzhYuCvzTgAyWHIfW0t25ff1CM7Vn+Vo9cVplIer1pbwhZZy4QkROWTOE+3yuRlQ+o6op4hTGdAZhjKh9zkDW7rzqQECFrZrX/9mJhxYKjhpkk0X3dSipPt9SUHagc4igya+NgCygQkWBOQfr4uia0LcwDxy4Kchw7ZuypHuGVZkGhNHXS+9JdAHopnSqYwDMG/z1ys1vQihgER0b9g3TchvGF+nmHe2kbM1iuIYMNNlaZD1yGZ5qR7wr/8dw8r0NBEwzsUfak3BUPX7H6X0tGS96llwUxmvQD85WNNoef0uryuAtDEwWlfN1RmWysZDc57Rn4gZi0M5jXmQD23ZiYXYBcG849OeqNzlxONEFsForXO/29Ud4x/Hqa9tf+kJbqMRsaLFO+PXhHzgl6ZHLAljQDxrJ6keNnkqaYfqQ8wyRi1mKv4Ab57kde7mUsZhe7w93GaE9Lxfvu7d3pB+lXfI9NJCSITHreUP4JfmFW+p/eVg+r/1wbElNylGna4I4+qYObOUncGwFKYdFPdtU1XLDKXmywTEgbEh7iI9zX0xD3bPHQLMg+TTtXiU9dQm1x/0zRf9trwDsRDJCbG4/P4iQYkcVvYx2CCfi0JSHv8tWsLi3GJKJLXUxZyzfvY2lThPeYnnY/HFrPJCyJUN55QuRmfzbu8rHgWlcyOlVpKtz+7kn823kEQykiIYKIKrb0G6VBzuMtAk9XzJPv+Wu7suOGXHlVfCqPLk6RjHDm4kTYciW9VgxDts5Y+zwcAbrUeA4UuN/6KisWpivMrfDSIHUCeH/lHBtNkqKohdrUKJMEOx5X6r2dJbmoTFBDi5XtYu/5cBtiDMmupNB0S+pZ2JD5/RKtj6kgzTeE1q/OG4q/eq1O1rjf0vIS31luy27K/YHFIGE0D/CmuXE74Uyaxm27RnrKUxEBl84V70GaIF4F5On8pSThxxizigXTRTKiczc+A5Zi29mid+1EFeUAJOa/DuHJfpVNY4pYEmhPl/Bk66L8kzlbJz6Hg/LIiJIRcy3UKrbSxPFIDpXn33drBHgklMDlrIVDZDXF6cn0Ml71SabB4A3TM6TK+oWZoyvftPIhcWhVwAWQj7nFNAiMEl1z/29ovHrRooqQFozf7GDW8Mjiu7ChZP9zx2H8JB/AAEFuWMwGV4AHICYdS9lOl/v+cDhgsnXdeuKEuxHhYlRxuRxJk/f17Sm/5H85UIzlu85wi3q/DW2FTZnlw4iJLnL6FArUIMzuBOZyoEhh0SPR41Xc4kkucDhnENybTZSR/yDzb0P1B7qjZ4GqcSEFja/hm/LH1oKJzZg8MEqeUoKYCUdVv9ek4IUGUONtVs53V5SOwFWR/nVuDk2BENr7NadYYVtu6MjBwgjso7NuhoNxVwIEP3BW67OQ8bxfNBtJJQNJejAhgZiqJItI9ucAfjQ== db48x@anglachel"+ & Apt.installed ["sudo"]+ & Ssh.noPasswords+ & IABak.gitServer monsters+ & IABak.registrationServer monsters+ & IABak.graphiteServer+ & IABak.publicFace+ where+ admins = map User ["joey", "db48x"]++ --' __|II| ,.+ ---- __|II|II|__ ( \_,/\+--'-------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-.-'-+-------------------------- | [Containers] / --------------------------+-------------------------- : / ---------------------------+--------------------------- \____, o ,' ----------------------------+---------------------------- '--,___________,' -----------------------------++-- Simple web server, publishing the outside host's /var/www+webserver :: Systemd.Container+webserver = standardStableContainer "webserver"+ & Systemd.bind "/var/www"+ & Apache.installed++-- My own openid provider. Uses php, so containerized for security+-- and administrative sanity.+openidProvider :: Systemd.Container+openidProvider = standardStableContainer "openid-provider"+ & alias hn+ & OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))+ where+ hn = "openid.kitenet.net"++-- Exhibit: kite's 90's website on port 1994.+ancientKitenet :: Systemd.Container+ancientKitenet = standardStableContainer "ancient-kitenet"+ & alias hn+ & Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html"+ (Just "remotes/origin/old-kitenet.net")+ & Apache.installed+ & Apache.listenPorts [p]+ & Apache.virtualHost hn p "/var/www/html"+ & Apache.siteDisabled "000-default"+ where+ p = Port 1994+ hn = "ancient.kitenet.net"++oldusenetShellBox :: Systemd.Container+oldusenetShellBox = standardStableContainer "oldusenet-shellbox"+ & alias "shell.olduse.net"+ & JoeySites.oldUseNetShellBox++kiteShellBox :: Systemd.Container+kiteShellBox = standardStableContainer "kiteshellbox"+ & JoeySites.kiteShellBox++type Motd = [String]++-- This is my standard system setup.+standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host+standardSystem hn suite arch motd = standardSystemUnhardened hn suite arch motd+ & Ssh.noPasswords++standardSystemUnhardened :: HostName -> DebianSuite -> Architecture -> Motd -> Host+standardSystemUnhardened hn suite arch motd = host hn+ & os (System (Debian suite) arch)+ & Hostname.sane+ & Hostname.searchDomain+ & File.hasContent "/etc/motd" ("":motd++[""])+ & Apt.stdSourcesList `onChange` Apt.upgrade+ & Apt.cacheCleaned+ & Apt.installed ["etckeeper"]+ & Apt.installed ["ssh", "mosh"]+ & GitHome.installedFor (User "root")+ & User.hasSomePassword (User "root")+ & User.accountFor (User "joey")+ & User.hasSomePassword (User "joey")+ & Sudo.enabledFor (User "joey")+ & GitHome.installedFor (User "joey")+ & Apt.installed ["vim", "screen", "less"]+ & Cron.runPropellor (Cron.Times "30 * * * *")+ -- I use postfix, or no MTA.+ & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]+ `onChange` Apt.autoRemove++-- This is my standard container setup, Featuring automatic upgrades.+standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container+standardContainer name suite arch =+ Systemd.container name system (Chroot.debootstrapped mempty)+ & Apt.stdSourcesList `onChange` Apt.upgrade+ & Apt.unattendedUpgrades+ & Apt.cacheCleaned+ where+ system = System (Debian suite) arch++standardStableContainer :: Systemd.MachineName -> Systemd.Container+standardStableContainer name = standardContainer name (Stable "jessie") "amd64"++myDnsSecondary :: Property HasInfo+myDnsSecondary = propertyList "dns secondary for all my domains" $ props+ & Dns.secondary hosts "kitenet.net"+ & Dns.secondary hosts "joeyh.name"+ & Dns.secondary hosts "ikiwiki.info"+ & Dns.secondary hosts "olduse.net"++branchableSecondary :: RevertableProperty HasInfo+branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"++-- Currently using kite (ns4) as primary with secondaries+-- elephant (ns3) and gandi.+-- kite handles all mail.+myDnsPrimary :: Bool -> Domain -> [(BindDomain, Record)] -> RevertableProperty HasInfo+myDnsPrimary dnssec domain extras = (if dnssec then Dns.signedPrimary (Weekly Nothing) else Dns.primary) hosts domain+ (Dns.mkSOA "ns4.kitenet.net" 100) $+ [ (RootDomain, NS $ AbsDomain "ns4.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 a:kitenet.net ~all")+ , JoeySites.domainKey+ ] ++ extras+++monsters :: [Host] -- Systems I don't manage with propellor,+monsters = -- but do want to track their public keys etc.+ [ host "usw-s002.rsync.net"+ & Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd"+ , host "github.com"+ & Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="+ , host "gitlab.com"+ & Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="+ , host "ns6.gandi.net"+ & ipv4 "217.70.177.40"+ , host "turtle.kitenet.net"+ & ipv4 "67.223.19.96"+ & ipv6 "2001:4978:f:2d9::2"+ , host "mouse.kitenet.net"+ & ipv6 "2001:4830:1600:492::2"+ , host "animx"+ & ipv4 "76.7.162.101"+ & ipv4 "76.7.162.186"+ ]++++ -- o+ -- ___ o o+ {-----\ / o \ ___o o+ { \ __ \ / _ (X___>-- __o+ _____________________{ ______\___ \__/ | \__/ \____ |X__>+ < \___//|\\___/\ \____________ _+ \ ___/ | \___ # # \ (-)+ \ O O O # | \ # >=)+ \______________________________# # / #__________________/ (-}++
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 2.16.0+Version: 2.17.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -16,8 +16,10 @@ CHANGELOG Makefile config-simple.hs- config-joey.hs+ config-freebsd.hs+ joeyconfig.hs config.hs+ contrib/post-merge-hook debian/changelog debian/README.Debian debian/compat@@ -36,10 +38,12 @@ Main-Is: wrapper.hs GHC-Options: -threaded -Wall -fno-warn-tabs Hs-Source-Dirs: src- Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,- IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,- containers (>= 0.5), network, async, time, mtl, transformers,- exceptions (>= 0.6), stm, text, unix+ Build-Depends: + -- propellor needs to support the ghc shipped in Debian stable+ base >= 4.5, base < 5,+ MissingH, directory, filepath, IfElse, process, bytestring, hslogger,+ unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,+ time, mtl, transformers, exceptions (>= 0.6), stm, text Executable propellor-config Main-Is: config.hs@@ -83,6 +87,9 @@ Propellor.Property.Fail2Ban Propellor.Property.File Propellor.Property.Firewall+ Propellor.Property.FreeBSD+ Propellor.Property.FreeBSD.Pkg+ Propellor.Property.FreeBSD.Poudriere Propellor.Property.Git Propellor.Property.Gpg Propellor.Property.Group@@ -117,6 +124,9 @@ Propellor.Property.Unbound Propellor.Property.User Propellor.Property.Uwsgi+ Propellor.Property.ZFS+ Propellor.Property.ZFS.Process+ Propellor.Property.ZFS.Properties Propellor.Property.HostingProvider.CloudAtCost Propellor.Property.HostingProvider.DigitalOcean Propellor.Property.HostingProvider.Linode@@ -146,6 +156,7 @@ Propellor.Types.Result Propellor.Types.ResultCheck Propellor.Types.CmdLine+ Propellor.Types.ZFS Other-Modules: Propellor.Bootstrap Propellor.Git@@ -175,6 +186,7 @@ Utility.PosixFiles Utility.Process Utility.Process.Shim+ Utility.Process.NonConcurrent Utility.SafeCommand Utility.Scheduled Utility.Table
src/Propellor.hs view
@@ -72,3 +72,4 @@ import Propellor.PropAccum import Data.Monoid as X+import Data.String as X (fromString)
src/Propellor/Bootstrap.hs view
@@ -15,16 +15,16 @@ -- Shell command line to ensure propellor is bootstrapped and ready to run. -- Should be run inside the propellor config dir, and will install -- all necessary build dependencies and build propellor.-bootstrapPropellorCommand :: ShellCommand-bootstrapPropellorCommand = checkDepsCommand ++ - "&& if ! test -x ./propellor; then " - ++ buildCommand ++ +bootstrapPropellorCommand :: Maybe System -> ShellCommand+bootstrapPropellorCommand msys = checkDepsCommand msys +++ "&& if ! test -x ./propellor; then "+ ++ buildCommand ++ "; fi;" ++ checkBinaryCommand -- Use propellor --check to detect if the local propellor binary has -- stopped working (eg due to library changes), and must be rebuilt. checkBinaryCommand :: ShellCommand-checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check 2>/dev/null; then " ++ go ++ "; fi"+checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi" where go = intercalate " && " [ "cabal clean"@@ -34,14 +34,14 @@ buildCommand :: ShellCommand buildCommand = intercalate " && " [ "cabal configure"- , "cabal build"+ , "cabal build propellor-config" , "ln -sf dist/build/propellor-config/propellor-config propellor" ] -- Run cabal configure to check if all dependencies are installed; -- if not, run the depsCommand.-checkDepsCommand :: ShellCommand-checkDepsCommand = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand ++ "; fi"+checkDepsCommand :: Maybe System -> ShellCommand+checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi" -- Install build dependencies of propellor. --@@ -53,17 +53,25 @@ -- So, as a second step, cabal is used to install all dependencies. -- -- Note: May succeed and leave some deps not installed.-depsCommand :: ShellCommand-depsCommand = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true"+depsCommand :: Maybe System -> ShellCommand+depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true" where- osinstall = "apt-get update" : map aptinstall debdeps+ osinstall = case msys of+ Just (System (FreeBSD _) _) -> map pkginstall fbsddeps+ Just (System (Debian _) _) -> useapt+ Just (System (Buntish _) _) -> useapt+ -- assume a debian derived system when not specified+ Nothing -> useapt - cabalinstall = + useapt = "apt-get update" : map aptinstall debdeps++ cabalinstall = [ "cabal update" , "cabal install --only-dependencies" ] aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install " ++ p+ pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p -- This is the same deps listed in debian/control. debdeps =@@ -84,9 +92,41 @@ , "libghc-text-dev" , "make" ]+ fbsddeps =+ [ "gnupg"+ , "ghc"+ , "hs-cabal-install"+ , "hs-async"+ , "hs-MissingH"+ , "hs-hslogger"+ , "hs-unix-compat"+ , "hs-ansi-terminal"+ , "hs-IfElse"+ , "hs-network"+ , "hs-mtl"+ , "hs-transformers-base"+ , "hs-exceptions"+ , "hs-stm"+ , "hs-text"+ , "gmake"+ ] -installGitCommand :: ShellCommand-installGitCommand = "if ! git --version >/dev/null; then apt-get update && DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git; fi"+installGitCommand :: Maybe System -> ShellCommand+installGitCommand msys = case msys of+ (Just (System (Debian _) _)) -> use apt+ (Just (System (Buntish _) _)) -> use apt+ (Just (System (FreeBSD _) _)) -> use+ [ "ASSUME_ALWAYS_YES=yes pkg update"+ , "ASSUME_ALWAYS_YES=yes pkg install git"+ ]+ -- assume a debian derived system when not specified+ Nothing -> use apt+ where+ use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"+ apt = + [ "apt-get update"+ , "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git"+ ] buildPropellor :: IO () buildPropellor = unlessM (actionMessage "Propellor build" build) $@@ -101,7 +141,7 @@ build = catchBoolIO $ do make "dist/setup-config" ["propellor.cabal"] $ cabal ["configure"]- unlessM (cabal ["build"]) $ do+ unlessM (cabal ["build", "propellor-config"]) $ do void $ cabal ["configure"] unlessM (cabal ["build"]) $ error "cabal build failed"
src/Propellor/CmdLine.hs view
@@ -21,7 +21,7 @@ import qualified Propellor.Shim as Shim usage :: Handle -> IO ()-usage h = hPutStrLn h $ unlines +usage h = hPutStrLn h $ unlines [ "Usage:" , " propellor" , " propellor hostname"@@ -47,10 +47,10 @@ processCmdLine :: IO CmdLine processCmdLine = go =<< getArgs where- go ("--check":_) = return Check+ go ("--check":_) = return Check go ("--spin":ps) = case reverse ps of- (r:"--via":hs) -> Spin - <$> mapM hostname (reverse hs) + (r:"--via":hs) -> Spin+ <$> mapM hostname (reverse hs) <*> pure (Just r) _ -> Spin <$> mapM hostname ps <*> pure Nothing go ("--add-key":k:[]) = return $ AddKey k@@ -62,7 +62,7 @@ go ("--edit":f:c:[]) = withprivfield f c Edit go ("--list-fields":[]) = return ListFields go ("--merge":[]) = return Merge- go ("--help":_) = do + go ("--help":_) = do usage stdout exitFailure go ("--boot":_:[]) = return $ Update Nothing -- for back-compat@@ -88,6 +88,8 @@ Just cmdline -> return $ mk cmdline Nothing -> errorMessage $ "serialization failure (" ++ s ++ ")" +data CanRebuild = CanRebuild | NoRebuild+ -- | Runs propellor on hosts, as controlled by command-line options. defaultMain :: [Host] -> IO () defaultMain hostlist = withConcurrentOutput $ do@@ -95,10 +97,9 @@ checkDebugMode cmdline <- processCmdLine debug ["command line: ", show cmdline]- go True cmdline+ go CanRebuild cmdline where- go _ (Serialized cmdline) = go True cmdline- go _ (Continue cmdline) = go False cmdline+ go cr (Serialized cmdline) = go cr cmdline go _ Check = return () go _ (Set field context) = setPrivData field context go _ (Unset field context) = unsetPrivData field context@@ -112,26 +113,29 @@ 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 cr (Relay h) = forceConsole >>+ updateFirst cr (Update (Just h)) (update (Just h))+ go _ (Update Nothing) = forceConsole >>+ fetchFirst (onlyprocess (update Nothing)) 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- go False (Spin hs mrelay) = do+ go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do unless (isJust mrelay) commitSpin forM_ hs $ \hn -> withhost hn $ spin mrelay hn- go False cmdline@(SimpleRun hn) = do- forceConsole- buildFirst cmdline $ go False (Run hn)- go False (Run hn) = ifM ((==) 0 <$> getRealUserID)- ( onlyprocess $ withhost hn mainProperties- , go True (Spin [hn] Nothing)+ go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID)+ ( updateFirst cr cmdline $ runhost hn+ , fetchFirst $ go cr (Spin [hn] Nothing) )+ go cr cmdline@(SimpleRun hn) = forceConsole >>+ fetchFirst (buildFirst cr cmdline (runhost hn))+ -- When continuing after a rebuild, don't want to rebuild again.+ go _ (Continue cmdline) = go NoRebuild cmdline withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)- ++ runhost hn = onlyprocess $ withhost hn mainProperties+ onlyprocess = onlyProcess (localdir </> ".lock") unknownhost :: HostName -> [Host] -> IO a@@ -142,39 +146,53 @@ , "Known hosts: " ++ unwords (map hostName hosts) ] -buildFirst :: CmdLine -> IO () -> IO ()-buildFirst cmdline next = do+-- Builds propellor (when allowed) and if it looks like a new binary,+-- re-execs it to continue.+-- Otherwise, runs the IO action to continue.+buildFirst :: CanRebuild -> CmdLine -> IO () -> IO ()+buildFirst CanRebuild cmdline next = do oldtime <- getmtime buildPropellor newtime <- getmtime if newtime == oldtime then next- else void $ boolSystem "./propellor"- [ Param "--continue"- , Param (show cmdline)- ]+ else continueAfterBuild cmdline where getmtime = catchMaybeIO $ getModificationTime "propellor"+buildFirst NoRebuild _ next = next +continueAfterBuild :: CmdLine -> IO a+continueAfterBuild cmdline = go =<< boolSystem "./propellor"+ [ Param "--continue"+ , Param (show cmdline)+ ]+ where+ go True = exitSuccess+ go False = exitWith (ExitFailure 1)+ fetchFirst :: IO () -> IO () fetchFirst next = do whenM hasOrigin $ void fetchOrigin next -updateFirst :: CmdLine -> IO () -> IO ()-updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next)+updateFirst :: CanRebuild -> CmdLine -> IO () -> IO ()+updateFirst canrebuild cmdline next = ifM hasOrigin+ ( updateFirst' canrebuild cmdline next+ , next+ ) -updateFirst' :: CmdLine -> IO () -> IO ()-updateFirst' cmdline next = ifM fetchOrigin+-- If changes can be fetched from origin, Builds propellor (when allowed)+-- and re-execs the updated propellor binary to continue.+-- Otherwise, runs the IO action to continue.+updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO ()+updateFirst' CanRebuild cmdline next = ifM fetchOrigin ( do buildPropellor- void $ boolSystem "./propellor"- [ Param "--continue"- , Param (show cmdline)- ]+ continueAfterBuild cmdline , next )+updateFirst' NoRebuild _ next = next -- Gets the fully qualified domain name, given a string that might be -- a short name to look up in the DNS.@@ -186,5 +204,5 @@ go (AddrInfo { addrCanonName = Just v } : _) = pure v go _ | "." `isInfixOf` s = pure s -- assume it's a fqdn- | otherwise = + | otherwise = error $ "cannot find host " ++ s ++ " in the DNS"
src/Propellor/Git/Config.hs view
@@ -14,7 +14,7 @@ getGitConfigValue key = do value <- catchMaybeIO $ takeWhile (/= '\n')- <$> readProcess "git" ["config", key]+ <$> readProcess"git" ["config", key] return $ case value of Just v | not (null v) -> Just v _ -> Nothing
src/Propellor/Git/VerifiedBranch.hs view
@@ -2,7 +2,6 @@ import Propellor.Base import Propellor.Git-import Propellor.Gpg import Propellor.PrivData.Paths import Utility.FileMode @@ -14,6 +13,7 @@ verifyOriginBranch :: String -> IO Bool verifyOriginBranch originbranch = do let gpgconf = privDataDir </> "gpg.conf"+ keyring <- privDataKeyring writeFile gpgconf $ unlines [ " keyring " ++ keyring , "no-auto-check-trustdb"@@ -38,6 +38,7 @@ oldsha <- getCurrentGitSha1 branchref + keyring <- privDataKeyring whenM (doesFileExist keyring) $ ifM (verifyOriginBranch originbranch) ( do
src/Propellor/Gpg.hs view
@@ -1,13 +1,10 @@ module Propellor.Gpg where import System.IO-import System.FilePath import System.Directory import Data.Maybe import Data.List.Utils import Control.Monad-import System.Console.Concurrent-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..)) import Control.Applicative import Prelude @@ -16,6 +13,7 @@ import Propellor.Git.Config import Utility.SafeCommand import Utility.Process+import Utility.Process.NonConcurrent import Utility.Monad import Utility.Misc import Utility.Tmp@@ -31,22 +29,21 @@ Nothing -> getEnvDefault "GNUPGBIN" "gpg" Just b -> return b -keyring :: FilePath-keyring = privDataDir </> "keyring.gpg"- -- Lists the keys in propellor's keyring. listPubKeys :: IO [KeyId] listPubKeys = do gpgbin <- getGpgBin- parse . lines <$> readProcess gpgbin listopts+ keyring <- privDataKeyring+ parse . lines <$> readProcess gpgbin (listopts keyring) where- listopts = useKeyringOpts ++ ["--with-colons", "--list-public-keys"]+ listopts keyring = useKeyringOpts keyring +++ ["--with-colons", "--list-public-keys"] parse = mapMaybe (keyIdField . split ":") keyIdField ("pub":_:_:_:f:_) = Just f keyIdField _ = Nothing -useKeyringOpts :: [String]-useKeyringOpts =+useKeyringOpts :: FilePath -> [String]+useKeyringOpts keyring = [ "--options" , "/dev/null" , "--no-default-keyring"@@ -56,20 +53,21 @@ addKey :: KeyId -> IO () addKey keyid = do gpgbin <- getGpgBin+ keyring <- privDataKeyring exitBool =<< allM (uncurry actionMessage)- [ ("adding key to propellor's keyring", addkeyring gpgbin)+ [ ("adding key to propellor's keyring", addkeyring keyring gpgbin) , ("staging propellor's keyring", gitAdd keyring) , ("updating encryption of any privdata", reencryptPrivData) , ("configuring git commit signing to use key", gitconfig gpgbin) , ("committing changes", gitCommitKeyRing "add-key") ] where- addkeyring gpgbin' = do+ addkeyring keyring' gpgbin' = do createDirectoryIfMissing True privDataDir boolSystem "sh" [ Param "-c" , Param $ gpgbin' ++ " --export " ++ keyid ++ " | gpg " ++- unwords (useKeyringOpts ++ ["--import"])+ unwords (useKeyringOpts keyring' ++ ["--import"]) ] gitconfig gpgbin' = ifM (snd <$> processTranscript gpgbin' ["--list-secret-keys", keyid] Nothing)@@ -86,16 +84,17 @@ rmKey :: KeyId -> IO () rmKey keyid = do gpgbin <- getGpgBin+ keyring <- privDataKeyring exitBool =<< allM (uncurry actionMessage)- [ ("removing key from propellor's keyring", rmkeyring gpgbin)+ [ ("removing key from propellor's keyring", rmkeyring keyring gpgbin) , ("staging propellor's keyring", gitAdd keyring) , ("updating encryption of any privdata", reencryptPrivData) , ("configuring git commit signing to not use key", gitconfig) , ("committing changes", gitCommitKeyRing "rm-key") ] where- rmkeyring gpgbin' = boolSystem gpgbin' $- (map Param useKeyringOpts) +++ rmkeyring keyring' gpgbin' = boolSystem gpgbin' $+ (map Param (useKeyringOpts keyring')) ++ [ Param "--batch" , Param "--yes" , Param "--delete-key", Param keyid@@ -111,12 +110,14 @@ ) reencryptPrivData :: IO Bool-reencryptPrivData = ifM (doesFileExist privDataFile)- ( do- gpgEncrypt privDataFile =<< gpgDecrypt privDataFile- gitAdd privDataFile- , return True- )+reencryptPrivData = do+ f <- privDataFile+ ifM (doesFileExist f)+ ( do+ gpgEncrypt f =<< gpgDecrypt f+ gitAdd f+ , return True+ ) gitAdd :: FilePath -> IO Bool gitAdd f = boolSystem "git"@@ -126,17 +127,21 @@ gitCommitKeyRing :: String -> IO Bool gitCommitKeyRing action = do+ keyring <- privDataKeyring+ privdata <- privDataFile -- Commit explicitly the keyring and privdata files, as other -- changes may be staged by the user and shouldn't be committed.- tocommit <- filterM doesFileExist [ privDataFile, keyring]+ tocommit <- filterM doesFileExist [ privdata, keyring] gitCommit (Just ("propellor " ++ action)) (map File tocommit) -- Adds --gpg-sign if there's a keyring. gpgSignParams :: [CommandParam] -> IO [CommandParam]-gpgSignParams ps = ifM (doesFileExist keyring)- ( return (ps ++ [Param "--gpg-sign"])- , return ps- )+gpgSignParams ps = do+ keyring <- privDataKeyring+ ifM (doesFileExist keyring)+ ( return (ps ++ [Param "--gpg-sign"])+ , return ps+ ) -- Automatically sign the commit if there'a a keyring. gitCommit :: Maybe String -> [CommandParam] -> IO Bool@@ -144,12 +149,7 @@ let ps' = Param "commit" : ps ++ maybe [] (\m -> [Param "-m", Param m]) msg ps'' <- gpgSignParams ps'- if isNothing msg- then do- (_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $- proc "git" (toCommand ps'')- checkSuccessProcess p- else boolSystem "git" ps''+ boolSystemNonConcurrent "git" ps'' gpgDecrypt :: FilePath -> IO String gpgDecrypt f = do
src/Propellor/PrivData.hs view
@@ -34,8 +34,6 @@ import qualified Data.Map as M import qualified Data.Set as S import qualified Data.ByteString.Lazy as L-import System.Console.Concurrent-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..)) import Control.Applicative import Data.Monoid import Prelude@@ -52,12 +50,12 @@ import Utility.Exception import Utility.Tmp import Utility.SafeCommand+import Utility.Process.NonConcurrent import Utility.Misc import Utility.FileMode import Utility.Env import Utility.Table import Utility.FileSystemEncoding-import Utility.Process -- | Allows a Property to access the value of a specific PrivDataField, -- for use in a specific Context or HostContext.@@ -196,8 +194,7 @@ hClose th maybe noop (\p -> writeFileProtected' f (`L.hPut` privDataByteString p)) v editor <- getEnvDefault "EDITOR" "vi"- (_, _, _, ConcurrentProcessHandle p) <- createProcessForeground $ proc editor [f]- unlessM (checkSuccessProcess p) $+ unlessM (boolSystemNonConcurrent editor [File f]) $ error "Editor failed; aborting." PrivData <$> readFile f setPrivDataTo field context v'@@ -254,12 +251,13 @@ makePrivDataDir m <- decryptPrivData let (m', r) = f m- gpgEncrypt privDataFile (show m')- void $ boolSystem "git" [Param "add", File privDataFile]+ privdata <- privDataFile+ gpgEncrypt privdata (show m')+ void $ boolSystem "git" [Param "add", File privdata] return r decryptPrivData :: IO PrivMap-decryptPrivData = readPrivData <$> gpgDecrypt privDataFile+decryptPrivData = readPrivData <$> (gpgDecrypt =<< privDataFile) readPrivData :: String -> PrivMap readPrivData = fromMaybe M.empty . readish
src/Propellor/PrivData/Paths.hs view
@@ -1,15 +1,31 @@ module Propellor.PrivData.Paths where +import Utility.Exception import System.FilePath+import Control.Applicative+import Prelude privDataDir :: FilePath privDataDir = "privdata" -privDataFile :: FilePath-privDataFile = privDataDir </> "privdata.gpg"+privDataFile :: IO FilePath+privDataFile = allowRelocate $ privDataDir </> "privdata.gpg" +privDataKeyring :: IO FilePath+privDataKeyring = allowRelocate $ privDataDir </> "keyring.gpg"+ privDataLocal :: FilePath privDataLocal = privDataDir </> "local" privDataRelay :: String -> FilePath privDataRelay host = privDataDir </> "relay" </> host++-- Allow relocating files in privdata, by checking for a file+-- privdata/relocate, which contains the path to a subdirectory that+-- contains the files.+allowRelocate :: FilePath -> IO FilePath+allowRelocate f = reloc . lines+ <$> catchDefaultIO "" (readFile (privDataDir </> "relocate"))+ where+ reloc (p:_) | not (null p) = privDataDir </> p </> takeFileName f+ reloc _ = f
src/Propellor/Property.hs view
@@ -20,6 +20,7 @@ , property , ensureProperty , withOS+ , unsupportedOS , makeChange , noChange , doNothing@@ -256,9 +257,17 @@ -- > myproperty = withOS "foo installed" $ \o -> case o of -- > (Just (System (Debian suite) arch)) -> ... -- > (Just (System (Buntish release) arch)) -> ...--- > Nothing -> ...+-- > Nothing -> unsupportedOS withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo withOS desc a = property desc $ a =<< getOS++-- | Throws an error, for use in `withOS` when a property is lacking+-- support for an OS.+unsupportedOS :: Propellor a+unsupportedOS = go =<< getOS+ where+ go Nothing = error "Unknown host OS is not supported by this property."+ go (Just o) = error $ "This property is not implemented for " ++ show o -- | Undoes the effect of a RevertableProperty. revert :: RevertableProperty i -> RevertableProperty i
src/Propellor/Property/Apache.hs view
@@ -27,7 +27,7 @@ [ siteAvailable domain cf `requires` installed `onChange` reloaded- , check (not <$> isenabled) + , check (not <$> isenabled) (cmdProperty "a2ensite" ["--quiet", domain]) `requires` installed `onChange` reloaded@@ -37,7 +37,7 @@ siteDisabled :: Domain -> Property NoInfo siteDisabled domain = combineProperties- ("apache site disabled " ++ domain) + ("apache site disabled " ++ domain) (map File.notPresent (siteCfg domain)) `onChange` (cmdProperty "a2dissite" ["--quiet", domain] `assume` MadeChange) `requires` installed@@ -72,7 +72,7 @@ listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps `onChange` restarted where- portline (Port n) = "Listen " ++ show n+ portline port = "Listen " ++ fromPort port -- This is a list of config files because different versions of apache -- use different filenames. Propellor simply writes them all.@@ -82,7 +82,7 @@ [ "/etc/apache2/sites-available/" ++ domain -- Debian 2.4+ , "/etc/apache2/sites-available/" ++ domain ++ ".conf"- ] + ] -- | Configure apache to use SNI to differentiate between -- https hosts.@@ -130,13 +130,13 @@ -- | A basic virtual host, publishing a directory, and logging to -- the combined apache log file. Not https capable. virtualHost :: Domain -> Port -> WebRoot -> RevertableProperty NoInfo-virtualHost domain (Port p) docroot = virtualHost' domain (Port p) docroot []+virtualHost domain port docroot = virtualHost' domain port docroot [] -- | Like `virtualHost` but with additional config lines added. virtualHost' :: Domain -> Port -> WebRoot -> [ConfigLine] -> RevertableProperty NoInfo-virtualHost' domain (Port p) docroot addedcfg = siteEnabled domain $- [ "<VirtualHost *:"++show p++">"- , "ServerName "++domain++":"++show p+virtualHost' domain port docroot addedcfg = siteEnabled domain $+ [ "<VirtualHost *:" ++ fromPort port ++ ">"+ , "ServerName " ++ domain ++ ":" ++ fromPort port , "DocumentRoot " ++ docroot , "ErrorLog /var/log/apache2/error.log" , "LogLevel warn"@@ -201,9 +201,9 @@ , "SSLCertificateChainFile " ++ LetsEncrypt.chainFile domain ] sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf"- vhost (Port p) ls = - [ "<VirtualHost *:"++show p++">"- , "ServerName "++domain++":"++show p+ vhost p ls =+ [ "<VirtualHost *:" ++ fromPort p ++">"+ , "ServerName " ++ domain ++ ":" ++ fromPort p , "DocumentRoot " ++ docroot , "ErrorLog /var/log/apache2/error.log" , "LogLevel warn"
src/Propellor/Property/Apt.hs view
@@ -123,10 +123,29 @@ `assume` MadeChange `describe` "apt update" +-- | Have apt upgrade packages, adding new packages and removing old as+-- necessary. upgrade :: Property NoInfo-upgrade = runApt ["-y", "dist-upgrade"]+upgrade = upgrade' "dist-upgrade"++upgrade' :: String -> Property NoInfo+upgrade' p = combineProperties ("apt " ++ p)+ [ pendingConfigured+ , runApt ["-y", p]+ `assume` MadeChange+ ]++-- | Have apt upgrade packages, but never add new packages or remove+-- old packages. Not suitable for upgrading acrocess major versions+-- of the distribution.+safeUpgrade :: Property NoInfo+safeUpgrade = upgrade' "upgrade"++-- | Have dpkg try to configure any packages that are not fully configured.+pendingConfigured :: Property NoInfo+pendingConfigured = cmdPropertyEnv "dpkg" ["--configure", "--pending"] noninteractiveEnv `assume` MadeChange- `describe` "apt dist-upgrade"+ `describe` "dpkg configured pending" type Package = String @@ -135,22 +154,20 @@ installed' :: [String] -> [Package] -> Property NoInfo installed' params ps = robustly $ check (isInstallable ps) go- `describe` (unwords $ "apt installed":ps)+ `describe` unwords ("apt installed":ps) where go = runApt (params ++ ["install"] ++ ps) installedBackport :: [Package] -> Property NoInfo installedBackport ps = withOS desc $ \o -> case o of- Nothing -> error "cannot install backports; os not declared" (Just (System (Debian suite) _)) -> case backportSuite suite of- Nothing -> notsupported o- Just bs -> ensureProperty $ + Nothing -> unsupportedOS+ Just bs -> ensureProperty $ runApt (["install", "-t", bs, "-y"] ++ ps) `changesFile` dpkgStatus- _ -> notsupported o+ _ -> unsupportedOS where- desc = (unwords $ "apt installed backport":ps)- notsupported o = error $ "backports not supported on " ++ show o+ desc = unwords ("apt installed backport":ps) -- | Minimal install of package, without recommends. installedMin :: [Package] -> Property NoInfo@@ -158,12 +175,12 @@ removed :: [Package] -> Property NoInfo removed ps = check (or <$> isInstalled' ps) (runApt (["-y", "remove"] ++ ps))- `describe` (unwords $ "apt removed":ps)+ `describe` unwords ("apt removed":ps) buildDep :: [Package] -> Property NoInfo buildDep ps = robustly $ go `changesFile` dpkgStatus- `describe` (unwords $ "apt build-dep":ps)+ `describe` unwords ("apt build-dep":ps) where go = runApt $ ["-y", "build-dep"] ++ ps @@ -256,8 +273,8 @@ reConfigure package vals = reconfigure `requires` setselections `describe` ("reconfigure " ++ package) where- setselections = property "preseed" $ - if null vals + setselections = property "preseed" $+ if null vals then noChange else makeChange $ withHandle StdinHandle createProcessSuccess@@ -312,7 +329,7 @@ hasForeignArch arch = check notAdded (add `before` update) `describe` ("dpkg has foreign architecture " ++ arch) where- notAdded = (not . elem arch . lines) <$> readProcess "dpkg" ["--print-foreign-architectures"]+ notAdded = (notElem arch . lines) <$> readProcess "dpkg" ["--print-foreign-architectures"] add = cmdProperty "dpkg" ["--add-architecture", arch] `assume` MadeChange
src/Propellor/Property/Chroot.hs view
@@ -55,7 +55,7 @@ -- System in a chroot. class ChrootBootstrapper b where -- | Do initial bootstrapping of an operating system in a chroot.- -- If the operating System is not supported, return + -- If the operating System is not supported, return -- Left error message. buildchroot :: b -> Maybe System -> FilePath -> Either String (Property HasInfo) @@ -91,6 +91,7 @@ buildchroot (Debootstrapped cf) system loc = case system of (Just s@(System (Debian _) _)) -> Right $ debootstrap s (Just s@(System (Buntish _) _)) -> Right $ debootstrap s+ (Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap." Nothing -> Left "Cannot debootstrap; `os` property not specified" where debootstrap s = Debootstrap.built loc s cf@@ -102,8 +103,8 @@ -- -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" -- > & os (System (Debian Unstable) "amd64")--- > & Apt.installed ["ghc", "haskell-platform"]--- > & ...+-- > & Apt.installed ["ghc", "haskell-platform"]+-- > & ... debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Chroot debootstrapped conf = bootstrapped (Debootstrapped conf) @@ -131,7 +132,7 @@ where setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly `requires` toProp built- + built = case buildchroot bootstrapper (chrootSystem c) loc of Right p -> p Left e -> cantbuild e@@ -152,7 +153,7 @@ (propertyChildren p) chrootInfo :: Chroot -> Info-chrootInfo (Chroot loc _ h) = mempty `addInfo` +chrootInfo (Chroot loc _ h) = mempty `addInfo` mempty { _chroots = M.singleton loc h } -- | Propellor is run inside the chroot to provision it.@@ -201,7 +202,7 @@ return $ ChrootChain parenthost loc systemdonly onconsole chain :: [Host] -> CmdLine -> IO ()-chain hostlist (ChrootChain hn loc systemdonly onconsole) = +chain hostlist (ChrootChain hn loc systemdonly onconsole) = case findHostNoAlias hostlist hn of Nothing -> errorMessage ("cannot find host " ++ hn) Just parenthost -> case M.lookup loc (_chroots $ getInfo $ hostInfo parenthost) of@@ -230,7 +231,7 @@ -- /proc/self/exe which is necessary for some commands to work mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ void $ mount "proc" "proc" procloc mempty- + procloc = loc </> "proc" cleanup
src/Propellor/Property/Cron.hs view
@@ -21,7 +21,7 @@ -- | Installs a cron job, that will run as a specified user in a particular -- directory. Note that the Desc must be unique, as it is used for the -- cron job filename.--- +-- -- Only one instance of the cron job is allowed to run at a time, no matter -- how long it runs. This is accomplished using flock locking of the cron -- job file.@@ -47,7 +47,7 @@ , case times of Times _ -> doNothing _ -> cronjobfile `File.mode` combineModes (readModes ++ executeModes)- -- Use a separate script because it makes the cron job name + -- Use a separate script because it makes the cron job name -- prettier in emails, and also allows running the job manually. , scriptfile `File.hasContent` [ "#!/bin/sh"@@ -81,5 +81,7 @@ -- | Installs a cron job to run propellor. runPropellor :: Times -> Property NoInfo-runPropellor times = niceJob "propellor" times (User "root") localdir- (bootstrapPropellorCommand ++ "; ./propellor")+runPropellor times = withOS "propellor cron job" $ \o -> + ensureProperty $+ niceJob "propellor" times (User "root") localdir+ (bootstrapPropellorCommand o ++ "; ./propellor")
src/Propellor/Property/Debootstrap.hs view
@@ -23,7 +23,7 @@ type Url = String --- | A monoid for debootstrap configuration. +-- | A monoid for debootstrap configuration. -- mempty is a default debootstrapped system. data DebootstrapConfig = DefaultConfig@@ -34,8 +34,8 @@ deriving (Show) instance Monoid DebootstrapConfig where- mempty = DefaultConfig- mappend = (:+)+ mempty = DefaultConfig+ mappend = (:+) toParams :: DebootstrapConfig -> [CommandParam] toParams DefaultConfig = []@@ -52,7 +52,7 @@ built target system config = built' (toProp installed) target system config built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i)-built' installprop target system@(System _ arch) config = +built' installprop target system@(System _ arch) config = check (unpopulated target <||> ispartial) setupprop `requires` installprop where@@ -88,10 +88,11 @@ return True , return False )- + extractSuite :: System -> Maybe String extractSuite (System (Debian s) _) = Just $ Apt.showSuite s extractSuite (System (Buntish r) _) = Just r+extractSuite (System (FreeBSD _) _) = Nothing -- | Ensures debootstrap is installed. --@@ -101,7 +102,7 @@ installed :: RevertableProperty NoInfo installed = install <!> remove where- install = withOS "debootstrap installed" $ \o -> + install = withOS "debootstrap installed" $ \o -> ifM (liftIO $ isJust <$> programPath) ( return NoChange , ensureProperty (installon o)@@ -115,7 +116,7 @@ removefrom (Just (System (Debian _) _)) = aptremove removefrom (Just (System (Buntish _) _)) = aptremove removefrom _ = sourceRemove- + aptinstall = Apt.installed ["debootstrap"] aptremove = Apt.removed ["debootstrap"] @@ -273,9 +274,9 @@ _ -> findend l r collect l (_:cs) = collect l cs - findend l s = + findend l s = let (u, r) = break (== '"') s u' = if "http" `isPrefixOf` u- then u+ then u else base </> u in collect (u':l) r
src/Propellor/Property/Docker.hs view
@@ -75,7 +75,7 @@ configured = prop `requires` installed where prop = withPrivData src anyContext $ \getcfg ->- property "docker configured" $ getcfg $ \cfg -> ensureProperty $ + property "docker configured" $ getcfg $ \cfg -> ensureProperty $ "/root/.dockercfg" `File.hasContent` privDataLines cfg src = PrivDataSourceFileFromCommand DockerAuthentication "/root/.dockercfg" "docker login"@@ -115,7 +115,7 @@ info = dockerInfo mempty -- | Ensures that a docker container is set up and running.--- +-- -- The container has its own Properties which are handled by running -- propellor inside the container. --@@ -186,7 +186,7 @@ cn = hostName h mkContainerInfo :: ContainerId -> Container -> ContainerInfo-mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = +mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = ContainerInfo img runparams where runparams = map (\(DockerRunParam mkparam) -> mkparam hn)@@ -233,7 +233,7 @@ `assume` NoChange `describe` "tweaked for docker" --- | Configures the kernel to respect docker memory limits. +-- | Configures the kernel to respect docker memory limits. -- -- This assumes the system boots using grub 2. And that you don't need any -- other GRUB_CMDLINE_LINUX_DEFAULT settings.@@ -241,7 +241,7 @@ -- Only takes effect after reboot. (Not automated.) memoryLimited :: Property NoInfo memoryLimited = "/etc/default/grub" `File.containsLine` cfg- `describe` "docker memory limited" + `describe` "docker memory limited" `onChange` (cmdProperty "update-grub" [] `assume` MadeChange) where cmdline = "cgroup_enable=memory swapaccount=1"@@ -315,7 +315,7 @@ toPublish :: p -> String instance Publishable (Bound Port) where- toPublish p = show (hostSide p) ++ ":" ++ show (containerSide p)+ toPublish p = fromPort (hostSide p) ++ ":" ++ fromPort (containerSide p) -- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort instance Publishable String where@@ -355,7 +355,7 @@ volumes_from cn = genProp "volumes-from" $ \hn -> fromContainerId (ContainerId hn cn) --- | Work dir inside the container. +-- | Work dir inside the container. workdir :: String -> Property HasInfo workdir = runProp "workdir" @@ -409,7 +409,7 @@ -- | A container is identified by its name, and the host -- on which it's deployed.-data ContainerId = ContainerId +data ContainerId = ContainerId { containerHostName :: HostName , containerName :: ContainerName }@@ -503,7 +503,7 @@ v <- a case v of Right Nothing -> do- threadDelaySeconds (Seconds 1) + threadDelaySeconds (Seconds 1) retry (n-1) a _ -> return v @@ -569,7 +569,7 @@ r <- withHandle StdoutHandle createProcessSuccess p $ processChainOutput when (r /= FailedChange) $- setProvisionedFlag cid + setProvisionedFlag cid return r toChain :: ContainerId -> CmdLine@@ -600,9 +600,9 @@ startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ] stoppedContainer :: ContainerId -> Property NoInfo-stoppedContainer cid = containerDesc cid $ property desc $ +stoppedContainer cid = containerDesc cid $ property desc $ ifM (liftIO $ elem cid <$> listContainers RunningContainers)- ( liftIO cleanup `after` ensureProperty + ( liftIO cleanup `after` ensureProperty (property desc $ liftIO $ toResult <$> stopContainer cid) , return NoChange )@@ -638,7 +638,7 @@ -- | Only lists propellor managed containers. listContainers :: ContainerFilter -> IO [ContainerId]-listContainers status = +listContainers status = mapMaybe toContainerId . concatMap (split ",") . mapMaybe (lastMaybe . words) . lines <$> readProcess dockercmd ps
src/Propellor/Property/Firewall.hs view
@@ -7,14 +7,13 @@ installed, Chain(..), Table(..),- TargetFilter(..),- TargetNat(..),- TargetMangle(..),- TargetRaw(..),- TargetSecurity(..),+ Target(..), Proto(..), Rules(..), ConnectionState(..),+ ICMPTypeMatch(..),+ TCPFlag(..),+ Frequency(..), IPWithMask(..), fromIPWithMask ) where@@ -30,10 +29,10 @@ installed :: Property NoInfo installed = Apt.installed ["iptables"] -rule :: Chain -> Table -> Rules -> Property NoInfo-rule c t rs = property ("firewall rule: " <> show r) addIpTable+rule :: Chain -> Table -> Target -> Rules -> Property NoInfo+rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable where- r = Rule c t rs+ r = Rule c tb tg rs addIpTable = liftIO $ do let args = toIpTable r exist <- boolSystem "iptables" (chk args)@@ -45,15 +44,16 @@ toIpTable :: Rule -> [CommandParam] toIpTable r = map Param $- show (ruleChain r) :- toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)+ fromChain (ruleChain r) :+ toIpTableArg (ruleRules r) +++ ["-t", fromTable (ruleTable r), "-j", fromTarget (ruleTarget r)] toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]-toIpTableArg (DPort (Port port)) = ["--dport", show port]-toIpTableArg (DPortRange (Port f, Port t)) =- ["--dport", show f ++ ":" ++ show t]+toIpTableArg (DPort port) = ["--dport", fromPort port]+toIpTableArg (DPortRange (portf, portt)) =+ ["--dport", fromPort portf ++ ":" ++ fromPort portt] toIpTableArg (InIFace iface) = ["-i", iface] toIpTableArg (OutIFace iface) = ["-o", iface] toIpTableArg (Ctstate states) =@@ -61,6 +61,24 @@ , "conntrack" , "--ctstate", intercalate "," (map show states) ]+toIpTableArg (ICMPType i) =+ [ "-m"+ , "icmp"+ , "--icmp-type", fromICMPTypeMatch i+ ]+toIpTableArg (RateLimit f) =+ [ "-m"+ , "limit"+ , "--limit", fromFrequency f+ ]+toIpTableArg (TCPFlags m c) =+ [ "-m"+ , "tcp"+ , "--tcp-flags"+ , intercalate "," (map show m)+ , intercalate "," (map show c)+ ]+toIpTableArg TCPSyn = ["--syn"] toIpTableArg (Source ipwm) = [ "-s" , intercalate "," (map fromIPWithMask ipwm)@@ -69,6 +87,10 @@ [ "-d" , intercalate "," (map fromIPWithMask ipwm) ]+toIpTableArg (NatDestination ip mport) =+ [ "--to-destination"+ , fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport+ ] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int@@ -80,83 +102,67 @@ fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m data Rule = Rule- { ruleChain :: Chain- , ruleTable :: Table- , ruleRules :: Rules+ { ruleChain :: Chain+ , ruleTable :: Table+ , ruleTarget :: Target+ , ruleRules :: Rules } deriving (Eq, Show) -data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity+data Table = Filter | Nat | Mangle | Raw | Security deriving (Eq, Show) -toIpTableTable :: Table -> [String]-toIpTableTable f = ["-t", table, "-j", target]- where- (table, target) = toIpTableTable' f--toIpTableTable' :: Table -> (String, String)-toIpTableTable' (Filter target) = ("filter", fromTarget target)-toIpTableTable' (Nat target) = ("nat", fromTarget target)-toIpTableTable' (Mangle target) = ("mangle", fromTarget target)-toIpTableTable' (Raw target) = ("raw", fromTarget target)-toIpTableTable' (Security target) = ("security", fromTarget target)--data Chain = INPUT | OUTPUT | FORWARD- deriving (Eq, Show)+fromTable :: Table -> String+fromTable Filter = "filter"+fromTable Nat = "nat"+fromTable Mangle = "mangle"+fromTable Raw = "raw"+fromTable Security = "security" -data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String+data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String deriving (Eq, Show) -class FromTarget a where- fromTarget :: a -> String--instance FromTarget TargetFilter where- fromTarget ACCEPT = "ACCEPT"- fromTarget REJECT = "REJECT"- fromTarget DROP = "DROP"- fromTarget LOG = "LOG"- fromTarget (FilterCustom f) = f+fromTarget :: Target -> String+fromTarget ACCEPT = "ACCEPT"+fromTarget REJECT = "REJECT"+fromTarget DROP = "DROP"+fromTarget LOG = "LOG"+fromTarget (TargetCustom t) = t -data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String+data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String deriving (Eq, Show) -instance FromTarget TargetNat where- fromTarget NatPREROUTING = "PREROUTING"- fromTarget NatOUTPUT = "OUTPUT"- fromTarget NatPOSTROUTING = "POSTROUTING"- fromTarget (NatCustom f) = f+fromChain :: Chain -> String+fromChain INPUT = "INPUT"+fromChain OUTPUT = "OUTPUT"+fromChain FORWARD = "FORWARD"+fromChain PREROUTING = "PREROUTING"+fromChain POSTROUTING = "POSTROUTING"+fromChain (ChainCustom c) = c -data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String+data Proto = TCP | UDP | ICMP deriving (Eq, Show) -instance FromTarget TargetMangle where- fromTarget ManglePREROUTING = "PREROUTING"- fromTarget MangleOUTPUT = "OUTPUT"- fromTarget MangleINPUT = "INPUT"- fromTarget MangleFORWARD = "FORWARD"- fromTarget ManglePOSTROUTING = "POSTROUTING"- fromTarget (MangleCustom f) = f+data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID+ deriving (Eq, Show) -data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String+data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int deriving (Eq, Show) -instance FromTarget TargetRaw where- fromTarget RawPREROUTING = "PREROUTING"- fromTarget RawOUTPUT = "OUTPUT"- fromTarget (RawCustom f) = f+fromICMPTypeMatch :: ICMPTypeMatch -> String+fromICMPTypeMatch (ICMPTypeName t) = t+fromICMPTypeMatch (ICMPTypeCode c) = show c -data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String+data Frequency = NumBySecond Int deriving (Eq, Show) -instance FromTarget TargetSecurity where- fromTarget SecurityINPUT = "INPUT"- fromTarget SecurityOUTPUT = "OUTPUT"- fromTarget SecurityFORWARD = "FORWARD"- fromTarget (SecurityCustom f) = f+fromFrequency :: Frequency -> String+fromFrequency (NumBySecond n) = show n ++ "/second" -data Proto = TCP | UDP | ICMP- deriving (Eq, Show)+type TCPFlagMask = [TCPFlag] -data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID+type TCPFlagComp = [TCPFlag]++data TCPFlag = SYN | ACK | FIN | RST | URG | PSH | ALL | NONE deriving (Eq, Show) data Rules@@ -165,12 +171,17 @@ -- ^There is actually some order dependency between proto and port so this should be a specific -- data type with proto + ports | DPort Port- | DPortRange (Port,Port)+ | DPortRange (Port, Port) | InIFace Network.Interface | OutIFace Network.Interface | Ctstate [ ConnectionState ]+ | ICMPType ICMPTypeMatch+ | RateLimit Frequency+ | TCPFlags TCPFlagMask TCPFlagComp+ | TCPSyn | Source [ IPWithMask ] | Destination [ IPWithMask ]+ | NatDestination IPAddr (Maybe Port) | Rules :- Rules -- ^Combine two rules deriving (Eq, Show)
+ src/Propellor/Property/FreeBSD.hs view
@@ -0,0 +1,13 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+-- +-- FreeBSD Properties+--+-- This module is designed to be imported unqualified.++module Propellor.Property.FreeBSD (+ module Propellor.Property.FreeBSD.Pkg,+ module Propellor.Property.FreeBSD.Poudriere+) where++import Propellor.Property.FreeBSD.Pkg+import Propellor.Property.FreeBSD.Poudriere
+ src/Propellor/Property/FreeBSD/Pkg.hs view
@@ -0,0 +1,85 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+-- +-- FreeBSD pkgng properties++{-# Language ScopedTypeVariables, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Propellor.Property.FreeBSD.Pkg where++import Propellor.Base+import Propellor.Types.Info++noninteractiveEnv :: [([Char], [Char])]+noninteractiveEnv = [("ASSUME_ALWAYS_YES", "yes")]++pkgCommand :: String -> [String] -> (String, [String])+pkgCommand cmd args = ("pkg", (cmd:args))++runPkg :: String -> [String] -> IO [String]+runPkg cmd args =+ let+ (p, a) = pkgCommand cmd args+ in+ lines <$> readProcess p a++pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo+pkgCmdProperty cmd args =+ let+ (p, a) = pkgCommand cmd args+ in+ cmdPropertyEnv p a noninteractiveEnv++pkgCmd :: String -> [String] -> IO [String]+pkgCmd cmd args =+ let+ (p, a) = pkgCommand cmd args+ in+ lines <$> readProcessEnv p a (Just noninteractiveEnv)++newtype PkgUpdate = PkgUpdate String+ deriving (Typeable, Monoid, Show)+instance IsInfo PkgUpdate where+ propagateInfo _ = False++pkgUpdated :: PkgUpdate -> Bool+pkgUpdated (PkgUpdate _) = True++update :: Property HasInfo+update =+ let+ upd = pkgCmd "update" []+ go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))+ in+ infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) []++newtype PkgUpgrade = PkgUpgrade String+ deriving (Typeable, Monoid, Show)+instance IsInfo PkgUpgrade where+ propagateInfo _ = False++pkgUpgraded :: PkgUpgrade -> Bool+pkgUpgraded (PkgUpgrade _) = True++upgrade :: Property HasInfo+upgrade =+ let+ upd = pkgCmd "upgrade" []+ go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange))+ in+ infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update++type Package = String++installed :: Package -> Property NoInfo+installed pkg = check (isInstallable pkg) $ pkgCmdProperty "install" [pkg]++isInstallable :: Package -> IO Bool+isInstallable p = (not <$> isInstalled p) <&&> exists p++isInstalled :: Package -> IO Bool+isInstalled p = (runPkg "info" [p] >> return True)+ `catchIO` (\_ -> return False)++exists :: Package -> IO Bool+exists p = (runPkg "search" ["--search", "name", "--exact", p] >> return True)+ `catchIO` (\_ -> return False)
+ src/Propellor/Property/FreeBSD/Poudriere.hs view
@@ -0,0 +1,141 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+--+-- FreeBSD Poudriere properties++{-# Language GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Propellor.Property.FreeBSD.Poudriere where++import Propellor.Base+import Propellor.Types.Info+import Data.List+import Data.String (IsString(..))++import qualified Propellor.Property.FreeBSD.Pkg as Pkg+import qualified Propellor.Property.ZFS as ZFS+import qualified Propellor.Property.File as File++poudriereConfigPath :: FilePath+poudriereConfigPath = "/usr/local/etc/poudriere.conf"++newtype PoudriereConfigured = PoudriereConfigured String+ deriving (Typeable, Monoid, Show)+instance IsInfo PoudriereConfigured where+ propagateInfo _ = False++poudriereConfigured :: PoudriereConfigured -> Bool+poudriereConfigured (PoudriereConfigured _) = True++setConfigured :: Property HasInfo+setConfigured = pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")++poudriere :: Poudriere -> Property HasInfo+poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = prop+ `requires` Pkg.installed "poudriere"+ `before` setConfigured+ where+ confProp = File.containsLines poudriereConfigPath (toLines conf)+ setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS"+ prop :: CombinedType (Property NoInfo) (Property NoInfo)+ prop+ | isJust zfs = ((setZfs $ fromJust zfs) `before` confProp)+ | otherwise = propertyList "Configuring Poudriere without ZFS" [confProp]++poudriereCommand :: String -> [String] -> (String, [String])+poudriereCommand cmd args = ("poudriere", cmd:args)++runPoudriere :: String -> [String] -> IO [String]+runPoudriere cmd args =+ let+ (p, a) = poudriereCommand cmd args+ in+ lines <$> readProcess p a++listJails :: IO [String]+listJails = mapMaybe (headMaybe . take 1 . words)+ <$> runPoudriere "jail" ["-l", "-q"]++jailExists :: Jail -> IO Bool+jailExists (Jail name _ _) = isInfixOf [name] <$> listJails++jail :: Jail -> Property NoInfo+jail j@(Jail name version arch) =+ let+ chk = do+ c <- poudriereConfigured <$> askInfo+ nx <- liftIO $ not <$> jailExists j+ return $ c && nx++ (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", show arch, "-v", show version]+ createJail = cmdProperty cmd args+ in+ check chk createJail+ `describe` unwords ["Create poudriere jail", name]++data JailInfo = JailInfo String++data Poudriere = Poudriere+ { _resolvConf :: String+ , _freebsdHost :: String+ , _baseFs :: String+ , _usePortLint :: Bool+ , _distFilesCache :: FilePath+ , _svnHost :: String+ , _zfs :: Maybe PoudriereZFS+ }++defaultConfig :: Poudriere+defaultConfig = Poudriere+ "/etc/resolv.conf"+ "ftp://ftp5.us.FreeBSD.org"+ "/usr/local/poudriere"+ True+ "/usr/ports/distfiles"+ "svn.freebsd.org"+ Nothing++data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties++data Jail = Jail String FBSDVersion PoudriereArch++data PoudriereArch = I386 | AMD64 deriving (Eq)+instance Show PoudriereArch where+ show I386 = "i386"+ show AMD64 = "amd64"++instance IsString PoudriereArch where+ fromString "i386" = I386+ fromString "amd64" = AMD64+ fromString _ = error "Not a valid Poudriere architecture."++yesNoProp :: Bool -> String+yesNoProp b = if b then "yes" else "no"++instance ToShellConfigLines Poudriere where+ toAssoc c = map (\(k, f) -> (k, f c))+ [ ("RESOLV_CONF", _resolvConf)+ , ("FREEBSD_HOST", _freebsdHost)+ , ("BASEFS", _baseFs)+ , ("USE_PORTLINT", yesNoProp . _usePortLint)+ , ("DISTFILES_CACHE", _distFilesCache)+ , ("SVN_HOST", _svnHost)+ ] ++ maybe [ ("NO_ZFS", "yes") ] toAssoc (_zfs c)++instance ToShellConfigLines PoudriereZFS where+ toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) =+ [ ("NO_ZFS", "no")+ , ("ZPOOL", pool)+ , ("ZROOTFS", show dataset)+ ]++type ConfigLine = String+type ConfigFile = [ConfigLine]++class ToShellConfigLines a where+ toAssoc :: a -> [(String, String)]++ toLines :: a -> [ConfigLine]+ toLines c = map (\(k, v) -> intercalate "=" [k, v]) (toAssoc c)++confFile :: FilePath+confFile = "/usr/local/etc/poudriere.conf"
src/Propellor/Property/Locale.hs view
@@ -57,7 +57,7 @@ if locale `presentIn` locales then ensureProperty $ fileProperty desc (foldr uncomment []) f- `onChange` regenerate+ `onChange` regenerate else return FailedChange -- locale unavailable for generation ensureUnavailable = fileProperty (locale ++ " locale not generated") (foldr comment []) f@@ -75,6 +75,5 @@ l `presentIn` ls = any (l `isPrefix`) ls l `isPrefix` x = (l `isPrefixOf` x) || (("# " ++ l) `isPrefixOf` x) - regenerate = cmdProperty "dpkg-reconfigure"- ["-f", "noninteractive", "locales"]+ regenerate = cmdProperty "locale-gen" [] `assume` MadeChange
src/Propellor/Property/Network.hs view
@@ -3,6 +3,8 @@ import Propellor.Base import Propellor.Property.File +import Data.Char+ type Interface = String ifUp :: Interface -> Property NoInfo@@ -45,7 +47,7 @@ -- -- If the interface file already exists, this property does nothing, -- no matter its content.--- +-- -- (ipv6 addresses are not included because it's assumed they come up -- automatically in most situations.) static :: Interface -> Property NoInfo@@ -97,7 +99,12 @@ -- | A file in the interfaces.d directory. interfaceDFile :: Interface -> FilePath-interfaceDFile iface = "/etc/network/interfaces.d" </> iface+interfaceDFile i = "/etc/network/interfaces.d" </> escapeInterfaceDName i++-- | /etc/network/interfaces.d/ files have to match -- ^[a-zA-Z0-9_-]+$+-- see "man 5 interfaces"+escapeInterfaceDName :: Interface -> FilePath+escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-")) -- | Ensures that files in the the interfaces.d directory are used. interfacesDEnabled :: Property NoInfo
src/Propellor/Property/OS.hs view
@@ -86,7 +86,7 @@ osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of (Just d@(System (Debian _) _)) -> debootstrap d (Just u@(System (Buntish _) _)) -> debootstrap u- _ -> error "os is not declared to be Debian or *buntu"+ _ -> unsupportedOS debootstrap targetos = ensureProperty $ -- Ignore the os setting, and install debootstrap from
src/Propellor/Property/OpenId.hs view
@@ -28,21 +28,21 @@ where baseurl = hn ++ case mp of Nothing -> ""- Just (Port p) -> ':' : show p+ Just p -> ':' : fromPort p url = "http://"++baseurl++"/simpleid" desc = "openid provider " ++ url setbaseurl l- | "SIMPLEID_BASE_URL" `isInfixOf` l = + | "SIMPLEID_BASE_URL" `isInfixOf` l = "define('SIMPLEID_BASE_URL', '"++url++"');" | otherwise = l- + apacheconfigured = case mp of Nothing -> toProp $ Apache.virtualHost hn (Port 80) "/var/www/html" Just p -> propertyList desc $ props & Apache.listenPorts [p] & Apache.virtualHost hn p "/var/www/html"- + -- the identities directory controls access, so open up -- file mode identfile (User u) = File.hasPrivContentExposed
src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs view
@@ -80,7 +80,7 @@ "liblockfile-simple-perl", "cabal-install", "vim", "less", -- needed by haskell libs "libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls28-dev",- "alex", "happy", "c2hs"+ "libmagic-dev", "alex", "happy", "c2hs" ] haskellPkgsInstalled :: String -> Property NoInfo@@ -105,7 +105,6 @@ autoBuilderContainer mkprop osver@(System _ arch) flavor crontime timeout = Systemd.container name osver (Chroot.debootstrapped mempty) & mkprop osver flavor- & buildDepsApt & autobuilder arch crontime timeout where name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"@@ -116,11 +115,48 @@ standardAutoBuilder osver@(System _ arch) flavor = propertyList "standard git-annex autobuilder" $ props & os osver+ & buildDepsApt & Apt.stdSourcesList & Apt.unattendedUpgrades & Apt.cacheCleaned & User.accountFor (User builduser) & tree arch flavor++stackAutoBuilder :: System -> Flavor -> Property HasInfo+stackAutoBuilder osver@(System _ arch) flavor =+ propertyList "git-annex autobuilder using stack" $ props+ & os osver+ & buildDepsNoHaskellLibs+ & Apt.stdSourcesList+ & Apt.unattendedUpgrades+ & Apt.cacheCleaned+ & User.accountFor (User builduser)+ & tree arch flavor+ & stackInstalled++stackInstalled :: Property NoInfo+stackInstalled = withOS "stack installed" $ \o ->+ case o of+ (Just (System (Debian (Stable "jessie")) "i386")) ->+ ensureProperty $ manualinstall "i386"+ _ -> ensureProperty $ Apt.installed ["haskell-stack"]+ where+ -- Warning: Using a binary downloaded w/o validation.+ manualinstall arch = check (not <$> doesFileExist binstack) $+ propertyList "stack installed from upstream tarball"+ [ cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]+ `assume` MadeChange+ , File.dirExists tmpdir+ , cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]+ `assume` MadeChange+ , cmdProperty "mv" [tmpdir </> "stack", binstack]+ `assume` MadeChange+ , cmdProperty "rm" ["-rf", tmpdir, tmptar]+ `assume` MadeChange+ ]+ binstack = "/usr/bin/stack"+ tmptar = "/root/stack.tar.gz"+ tmpdir = "/root/stack" armAutoBuilder :: System -> Flavor -> Property HasInfo armAutoBuilder osver flavor =
src/Propellor/Property/Ssh.hs view
@@ -75,7 +75,7 @@ | s == cfgline = True | (setting ++ " ") `isPrefixOf` s = False | otherwise = True- f ls + f ls | cfgline `elem` ls = filter wantedline ls | otherwise = filter wantedline ls ++ [cfgline] @@ -94,7 +94,7 @@ -- | Configure ssh to not allow password logins. ----- To prevent lock-out, this is done only once root's +-- To prevent lock-out, this is done only once root's -- authorized_keys is in place. noPasswords :: Property NoInfo noPasswords = check (hasAuthorizedKeys (User "root")) $@@ -114,10 +114,10 @@ -- ports it is configured to listen on. -- -- Revert to prevent it listening on a particular port.-listenPort :: Int -> RevertableProperty NoInfo+listenPort :: Port -> RevertableProperty NoInfo listenPort port = enable <!> disable where- portline = "Port " ++ show port+ portline = "Port " ++ fromPort port enable = sshdConfig `File.containsLine` portline `describe` ("ssh listening on " ++ portline) `onChange` restarted@@ -173,7 +173,7 @@ -- | 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; +-- the private key comes from the privdata; hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo hostKey context keytype pub = combineProperties desc [ hostPubKey keytype pub@@ -210,7 +210,7 @@ getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText) getHostPubKey = fromHostKeyInfo <$> askInfo -newtype HostKeyInfo = HostKeyInfo +newtype HostKeyInfo = HostKeyInfo { fromHostKeyInfo :: M.Map SshKeyType PubKeyText } deriving (Eq, Ord, Typeable, Show) @@ -219,7 +219,7 @@ instance Monoid HostKeyInfo where mempty = HostKeyInfo M.empty- mappend (HostKeyInfo old) (HostKeyInfo new) = + mappend (HostKeyInfo old) (HostKeyInfo new) = -- new first because union prefers values from the first -- parameter when there is a duplicate key HostKeyInfo (new `M.union` old)@@ -240,12 +240,12 @@ instance Monoid UserKeyInfo where mempty = UserKeyInfo M.empty- mappend (UserKeyInfo old) (UserKeyInfo new) = + mappend (UserKeyInfo old) (UserKeyInfo new) = UserKeyInfo (M.unionWith S.union old new) -- | Sets up a user with the specified public keys, and the corresponding -- private keys from the privdata.--- +-- -- The public keys are added to the Info, so other properties like -- `authorizedKeysFrom` can use them. userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo@@ -277,7 +277,7 @@ , Just $ "(" ++ fromKeyType keytype ++ ")" ] pubkey = property desc $ install File.hasContent ".pub" [pubkeytext]- privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> + privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> property desc $ getkey $ install File.hasContentProtected "" . privDataLines install writer ext key = do@@ -349,7 +349,7 @@ -- -- Any other lines in the authorized_keys file are preserved as-is. authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo-localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = +localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = property desc (go =<< authorizedKeyLines remoteuser remotehost) where remote = rn ++ "@" ++ hostName remotehost@@ -372,9 +372,9 @@ go [] = return NoChange go ls = ensureProperty $ combineProperties desc $ map (revert . authorizedKey localuser) ls- + authorizedKeyLines :: User -> Host -> Propellor [File.Line]-authorizedKeyLines remoteuser remotehost = +authorizedKeyLines remoteuser remotehost = map snd <$> fromHost' remotehost (getUserPubKeys remoteuser) -- | Makes a user have authorized_keys from the PrivData@@ -404,7 +404,7 @@ `requires` File.dirExists (takeDirectory f) remove = property (u ++ " lacks authorized_keys") $ do f <- liftIO $ dotFile "authorized_keys" user- ifM (liftIO $ doesFileExist f) + ifM (liftIO $ doesFileExist f) ( modAuthorizedKey f user $ f `File.lacksLine` l , return NoChange )
src/Propellor/Property/Systemd.hs view
@@ -127,7 +127,7 @@ -- | Enables persistent storage of the journal. persistentJournal :: Property NoInfo-persistentJournal = check (not <$> doesDirectoryExist dir) $ +persistentJournal = check (not <$> doesDirectoryExist dir) $ combineProperties "persistent systemd journal" [ cmdProperty "install" ["-d", "-g", "systemd-journal", dir] `assume` MadeChange@@ -145,7 +145,7 @@ -- Does not ensure that the relevant daemon notices the change immediately. -- -- This assumes that there is only one [Header] per file, which is--- currently the case for files like journald.conf and system.conf. +-- currently the case for files like journald.conf and system.conf. -- And it assumes the file already exists with -- the right [Header], so new lines can just be appended to the end. configured :: FilePath -> Option -> String -> Property NoInfo@@ -174,15 +174,13 @@ -- | Ensures machined and machinectl are installed machined :: Property NoInfo-machined = go `describe` "machined installed"- where- go = withOS ("standard sources.list") $ \o ->- case o of- -- Split into separate debian package since systemd 225.- (Just (System (Debian suite) _))- | not (isStable suite) -> ensureProperty $- Apt.installed ["systemd-container"]- _ -> noChange+machined = withOS "machined installed" $ \o ->+ case o of+ -- Split into separate debian package since systemd 225.+ (Just (System (Debian suite) _))+ | not (isStable suite) -> ensureProperty $+ Apt.installed ["systemd-container"]+ _ -> noChange -- | Defines a container with a given machine name, and operating system, -- and how to create its chroot if not already present.@@ -232,7 +230,7 @@ -- Use nsenter to enter container and and run propellor to -- finish provisioning.- containerprovisioned = + containerprovisioned = Chroot.propellChroot chroot (enterContainerProcess c) False <!> doNothing@@ -261,7 +259,7 @@ , "--machine=%i" ] ++ nspawnServiceParams cfg | otherwise = l- + goodservicefile = (==) <$> servicefilecontent <*> catchDefaultIO "" (readFile servicefile)@@ -368,7 +366,7 @@ toPublish :: a -> String instance Publishable Port where- toPublish (Port n) = show n+ toPublish port = fromPort port instance Publishable (Bound Port) where toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v)@@ -380,7 +378,7 @@ toPublish (UDP, fp) = "udp:" ++ toPublish fp -- | Publish a port from the container to the host.--- +-- -- This feature was first added in systemd version 220. -- -- This property is only needed (and will only work) if the container
src/Propellor/Property/Tor.hs view
@@ -54,17 +54,31 @@ torPrivKey :: Context -> Property HasInfo torPrivKey context = f `File.hasPrivContent` context `onChange` File.ownerGroup f user (userGroup user)- -- install tor first, so the directory exists with right perms- `requires` Apt.installed ["tor"]+ `requires` torPrivKeyDirExists where- f = "/var/lib/tor/keys/secret_id_key"+ f = torPrivKeyDir </> "secret_id_key" +torPrivKeyDirExists :: Property NoInfo+torPrivKeyDirExists = File.dirExists torPrivKeyDir+ `onChange` setperms+ `requires` installed+ where+ setperms = File.ownerGroup torPrivKeyDir user (userGroup user)+ `before` File.mode torPrivKeyDir 0O2700++torPrivKeyDir :: FilePath+torPrivKeyDir = "/var/lib/tor/keys"+ -- | A tor server (bridge, relay, or exit) -- Don't use if you just want to run tor for personal use. server :: Property NoInfo server = configured [("SocksPort", "0")]- `requires` Apt.installed ["tor", "ntp"]+ `requires` installed+ `requires` Apt.installed ["ntp"] `describe` "tor server"++installed :: Property NoInfo+installed = Apt.installed ["tor"] -- | Specifies configuration settings. Any lines in the config file -- that set other values for the specified settings will be removed,
+ src/Propellor/Property/ZFS.hs view
@@ -0,0 +1,11 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+-- +-- ZFS properties++module Propellor.Property.ZFS (+ module Propellor.Property.ZFS.Properties,+ module Propellor.Types.ZFS+) where++import Propellor.Property.ZFS.Properties+import Propellor.Types.ZFS
+ src/Propellor/Property/ZFS/Process.hs view
@@ -0,0 +1,32 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+-- +-- Functions running zfs processes.++module Propellor.Property.ZFS.Process where++import Propellor.Base+import Data.String.Utils (split)+import Data.List++-- | Gets the properties of a ZFS volume.+zfsGetProperties :: ZFS -> IO ZFSProperties+zfsGetProperties z =+ let plist = fromPropertyList . map (\(_:k:v:_) -> (k, v)) . (map (split "\t"))+ in plist <$> runZfs "get" [Just "-H", Just "-p", Just "all"] z++zfsExists :: ZFS -> IO Bool+zfsExists z = any id . map (isInfixOf (zfsName z))+ <$> runZfs "list" [Just "-H"] z++-- | Runs the zfs command with the arguments.+--+-- Runs the command with -H which will skip the header line and+-- separate all fields with tabs.+--+-- Replaces Nothing in the argument list with the ZFS pool/dataset.+runZfs :: String -> [Maybe String] -> ZFS -> IO [String]+runZfs cmd args z = lines <$> uncurry readProcess (zfsCommand cmd args z)++-- | Return the ZFS command line suitable for readProcess or cmdProperty.+zfsCommand :: String -> [Maybe String] -> ZFS -> (String, [String])+zfsCommand cmd args z = ("zfs", cmd:(map (maybe (zfsName z) id) args))
+ src/Propellor/Property/ZFS/Properties.hs view
@@ -0,0 +1,36 @@+-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>+-- +-- Functions defining zfs Properties.++module Propellor.Property.ZFS.Properties (+ zfsExists,+ zfsSetProperties+) where++import Propellor.Base+import Data.List (intercalate)+import qualified Propellor.Property.ZFS.Process as ZP++-- | Will ensure that a ZFS volume exists with the specified mount point.+-- This requires the pool to exist as well, but we don't create pools yet.+zfsExists :: ZFS -> Property NoInfo+zfsExists z = check (not <$> ZP.zfsExists z) create+ `describe` unwords ["Creating", zfsName z]+ where+ (p, a) = ZP.zfsCommand "create" [Nothing] z+ create = cmdProperty p a++-- | Sets the given properties. Returns True if all were successfully changed, False if not.+zfsSetProperties :: ZFS -> ZFSProperties -> Property NoInfo+zfsSetProperties z setProperties = setall+ `requires` zfsExists z+ where+ spcmd :: String -> String -> (String, [String])+ spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z++ setprop :: (String, String) -> Property NoInfo+ setprop (p, v) = check (ZP.zfsExists z) $+ cmdProperty (fst (spcmd p v)) (snd (spcmd p v))++ setall = combineProperties (unwords ["Setting properties on", zfsName z]) $+ map setprop $ toPropertyList setProperties
src/Propellor/Spin.hs view
@@ -1,3 +1,5 @@+{-# Language ScopedTypeVariables #-}+ module Propellor.Spin ( commitSpin, spin,@@ -30,6 +32,7 @@ import qualified Propellor.Shim as Shim import Utility.FileMode import Utility.SafeCommand+import Utility.Process.NonConcurrent commitSpin :: IO () commitSpin = do@@ -41,7 +44,7 @@ currentBranch <- getCurrentBranch when (b /= currentBranch) $ error ("spin aborted: check out "- ++ b ++ " branch first")+ ++ b ++ " branch first") -- safety check #2: check we can commit with a dirty tree noDirtySpin <- getGitConfigBool "propellor.forbid-dirty-spin"@@ -52,14 +55,14 @@ error "spin aborted: commit changes first" void $ actionMessage "Git commit" $- gitCommit (Just spinCommitMessage) + gitCommit (Just spinCommitMessage) [Param "--allow-empty", Param "-a"] -- Push to central origin repo first, if possible. -- The remote propellor will pull from there, which avoids -- us needing to send stuff directly to the remote host. whenM hasOrigin $ void $ actionMessage "Push to central git repository" $- boolSystem "git" [Param "push"]+ boolSystemNonConcurrent "git" [Param "push"] spin :: Maybe HostName -> HostName -> Host -> IO () spin = spin' Nothing@@ -83,27 +86,30 @@ =<< getprivdata -- And now we can run it.- unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $+ unlessM (boolSystemNonConcurrent "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $ error "remote propellor failed" where hn = fromMaybe target relay+ sys = case getInfo (hostInfo hst) of+ InfoVal o -> Just o+ NoInfoVal -> Nothing relaying = relay == Just target viarelay = isJust relay && not relaying probecmd = intercalate " ; "- [ "if [ ! -d " ++ localdir ++ "/.git ]"+ ["if [ ! -d " ++ localdir ++ "/.git ]" , "then (" ++ intercalate " && "- [ installGitCommand+ [ installGitCommand sys , "echo " ++ toMarked statusMarker (show NeedGitClone) ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled) , "else " ++ updatecmd , "fi" ]- + updatecmd = intercalate " && " [ "cd " ++ localdir- , bootstrapPropellorCommand+ , bootstrapPropellorCommand sys , if viarelay then "./propellor --continue " ++ shellEscape (show (Relay target))@@ -112,10 +118,11 @@ ] runcmd = "cd " ++ localdir ++ " && ./propellor " ++ cmd- cmd = if viarelay- then "--serialized " ++ shellEscape (show (Spin [target] (Just target)))- else "--continue " ++ shellEscape (show (SimpleRun target))- + cmd = "--serialized " ++ shellEscape (show cmdline)+ cmdline+ | viarelay = Spin [target] (Just target)+ | otherwise = SimpleRun target+ getprivdata = case mprivdata of Nothing | relaying -> do@@ -123,12 +130,12 @@ d <- readPrivDataFile f nukeFile f return d- | otherwise -> + | otherwise -> filterPrivData hst <$> decryptPrivData Just pd -> pure pd -- 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, +-- 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@@ -186,9 +193,9 @@ hClose stdout -- Not using git pull because git 2.5.0 badly -- broke its option parser.- unlessM (boolSystem "git" (pullparams hin hout)) $+ unlessM (boolSystemNonConcurrent "git" (pullparams hin hout)) $ errorMessage "git fetch from client failed"- unlessM (boolSystem "git" [Param "merge", Param "FETCH_HEAD"]) $+ unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ errorMessage "git merge from client failed" where pullparams hin hout =@@ -198,7 +205,7 @@ , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout , Param "." ]- + -- When --spin --relay is run, get a privdata file -- to be relayed to the target host. privfile = maybe privDataLocal privDataRelay forhost@@ -211,8 +218,13 @@ -> CreateProcess -> PrivMap -> IO ()-updateServer target relay hst connect haveprecompiled privdata =- withIOHandles createProcessSuccess connect go+updateServer target relay hst connect haveprecompiled privdata = do+ (Just toh, Just fromh, _, pid) <- createProcessNonConcurrent $ connect+ { std_in = CreatePipe+ , std_out = CreatePipe+ }+ go (toh, fromh)+ forceSuccessProcess' connect =<< waitForProcessNonConcurrent pid where hn = fromMaybe target relay @@ -275,8 +287,8 @@ cacheparams <- sshCachingParams hn withTmpFile "propellor.git" $ \tmp _ -> allM id [ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]- , boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]- , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]+ , boolSystemNonConcurrent "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]+ , boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch] ] where remotebundle = "/usr/local/propellor.git"@@ -312,8 +324,8 @@ withTmpFile "propellor.tar." $ \tarball _ -> allM id [ boolSystem "strip" [File me] , boolSystem "tar" [Param "czf", File tarball, File shimdir]- , boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]- , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]+ , boolSystemNonConcurrent "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)]+ , boolSystemNonConcurrent "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd] ] remotetarball = "/usr/local/propellor.tar"
src/Propellor/Types.hs view
@@ -34,6 +34,7 @@ , module Propellor.Types.OS , module Propellor.Types.Dns , module Propellor.Types.Result+ , module Propellor.Types.ZFS , propertySatisfy , ignoreInfo ) where@@ -49,6 +50,7 @@ import Propellor.Types.OS import Propellor.Types.Dns import Propellor.Types.Result+import Propellor.Types.ZFS -- | Everything Propellor knows about a system: Its hostname, -- properties and their collected info.@@ -126,7 +128,7 @@ type instance CInfo NoInfo NoInfo = NoInfo -- | Constructs a Property with associated Info.-infoProperty +infoProperty :: Desc -- ^ description of the property -> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly) -> Info -- ^ info associated with the property@@ -158,7 +160,7 @@ propertySatisfy (IProperty _ a _ _) = a propertySatisfy (SProperty _ a _) = a --- | Changes the action that is performed to satisfy a property. +-- | Changes the action that is performed to satisfy a property. adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs@@ -172,7 +174,7 @@ propertyDesc (SProperty d _ _) = d instance Show (Property i) where- show p = "property " ++ show (propertyDesc p)+ show p = "property " ++ show (propertyDesc p) -- | A Property can include a list of child properties that it also -- satisfies. This allows them to be introspected to collect their info, etc.@@ -188,7 +190,7 @@ } instance Show (RevertableProperty i) where- show (RevertableProperty p _) = show p+ show (RevertableProperty p _) = show p class MkRevertableProperty i1 i2 where -- | Shorthand to construct a revertable property.@@ -216,7 +218,7 @@ setDesc (IProperty _ a i cs) d = IProperty d a i cs toProp = id getDesc = propertyDesc- getInfoRecursive (IProperty _ _ i cs) = + getInfoRecursive (IProperty _ _ i cs) = i <> mconcat (map getInfoRecursive cs) instance IsProp (Property NoInfo) where setDesc (SProperty _ a cs) d = SProperty d a cs@@ -256,8 +258,8 @@ class Combines x y where -- | Combines together two properties, yielding a property that -- has the description and info of the first, and that has the second- -- property as a child. - combineWith + -- property as a child.+ combineWith :: ResultCombiner -- ^ How to combine the actions to satisfy the properties. -> ResultCombiner@@ -308,7 +310,7 @@ instance Combines (Property NoInfo) (RevertableProperty HasInfo) where combineWith = combineWithPR -combineWithRR +combineWithRR :: Combines (Property x) (Property y) => ResultCombiner -> ResultCombiner
src/Propellor/Types/OS.hs view
@@ -4,6 +4,8 @@ System(..), Distribution(..), DebianSuite(..),+ FreeBSDRelease(..),+ FBSDVersion(..), isStable, Release, Architecture,@@ -13,10 +15,12 @@ Group(..), userGroup, Port(..),+ fromPort, ) where import Network.BSD (HostName) import Data.Typeable+import Data.String -- | High level description of a operating system. data System = System Distribution Architecture@@ -25,6 +29,7 @@ data Distribution = Debian DebianSuite | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)+ | FreeBSD FreeBSDRelease deriving (Show, Eq) -- | Debian has several rolling suites, and a number of stable releases,@@ -32,6 +37,24 @@ data DebianSuite = Experimental | Unstable | Testing | Stable Release deriving (Show, Eq) +-- | FreeBSD breaks their releases into "Production" and "Legacy".+data FreeBSDRelease = FBSDProduction FBSDVersion | FBSDLegacy FBSDVersion+ deriving (Show, Eq)++data FBSDVersion = FBSD101 | FBSD102 | FBSD093+ deriving (Eq)++instance IsString FBSDVersion where+ fromString "10.1-RELEASE" = FBSD101+ fromString "10.2-RELEASE" = FBSD102+ fromString "9.3-RELEASE" = FBSD093+ fromString _ = error "Invalid FreeBSD release"++instance Show FBSDVersion where+ show FBSD101 = "10.1-RELEASE"+ show FBSD102 = "10.2-RELEASE"+ show FBSD093 = "9.3-RELEASE"+ isStable :: DebianSuite -> Bool isStable (Stable _) = True isStable _ = False@@ -53,3 +76,6 @@ newtype Port = Port Int deriving (Eq, Show)++fromPort :: Port -> String+fromPort (Port p) = show p
+ src/Propellor/Types/ZFS.hs view
@@ -0,0 +1,133 @@+-- | Types for ZFS Properties.+--+-- Copyright 2016 Evan Cofsky <evan@theunixman.com>+-- License: BSD 2-clause++module Propellor.Types.ZFS where++import Data.String+import qualified Data.Set as Set+import qualified Data.String.Utils as SU+import Data.List++-- | A single ZFS filesystem.+data ZFS = ZFS ZPool ZDataset deriving (Show, Eq, Ord)++-- | Represents a zpool.+data ZPool = ZPool String deriving (Show, Eq, Ord)++-- | Represents a dataset in a zpool.+--+-- Can be constructed from a / separated string.+data ZDataset = ZDataset [String] deriving (Eq, Ord)++type ZFSProperties = Set.Set ZFSProperty++fromList :: [ZFSProperty] -> ZFSProperties+fromList = Set.fromList++toPropertyList :: ZFSProperties -> [(String, String)]+toPropertyList = Set.foldr (\p l -> l ++ [toPair p]) []++fromPropertyList :: [(String, String)] -> ZFSProperties+fromPropertyList props =+ Set.fromList $ map fromPair props++zfsName :: ZFS -> String+zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]++instance Show ZDataset where+ show (ZDataset paths) = intercalate "/" paths++instance IsString ZDataset where+ fromString s = ZDataset $ SU.split "/" s++instance IsString ZPool where+ fromString p = ZPool p++class Value a where+ toValue :: a -> String+ fromValue :: (IsString a) => String -> a+ fromValue = fromString++data ZFSYesNo = ZFSYesNo Bool deriving (Show, Eq, Ord)+data ZFSOnOff = ZFSOnOff Bool deriving (Show, Eq, Ord)+data ZFSSize = ZFSSize Integer deriving (Show, Eq, Ord)+data ZFSString = ZFSString String deriving (Show, Eq, Ord)++instance Value ZFSYesNo where+ toValue (ZFSYesNo True) = "yes"+ toValue (ZFSYesNo False) = "no"++instance Value ZFSOnOff where+ toValue (ZFSOnOff True) = "on"+ toValue (ZFSOnOff False) = "off"++instance Value ZFSSize where+ toValue (ZFSSize s) = show s++instance Value ZFSString where+ toValue (ZFSString s) = s++instance IsString ZFSString where+ fromString = ZFSString++instance IsString ZFSYesNo where+ fromString "yes" = ZFSYesNo True+ fromString "no" = ZFSYesNo False+ fromString _ = error "Not yes or no"++instance IsString ZFSOnOff where+ fromString "on" = ZFSOnOff True+ fromString "off" = ZFSOnOff False+ fromString _ = error "Not on or off"++data ZFSACLInherit = AIDiscard | AINoAllow | AISecure | AIPassthrough deriving (Show, Eq, Ord)+instance IsString ZFSACLInherit where+ fromString "discard" = AIDiscard+ fromString "noallow" = AINoAllow+ fromString "secure" = AISecure+ fromString "passthrough" = AIPassthrough+ fromString _ = error "Not valid aclpassthrough value"++instance Value ZFSACLInherit where+ toValue AIDiscard = "discard"+ toValue AINoAllow = "noallow"+ toValue AISecure = "secure"+ toValue AIPassthrough = "passthrough"++data ZFSACLMode = AMDiscard | AMGroupmask | AMPassthrough deriving (Show, Eq, Ord)+instance IsString ZFSACLMode where+ fromString "discard" = AMDiscard+ fromString "groupmask" = AMGroupmask+ fromString "passthrough" = AMPassthrough+ fromString _ = error "Invalid zfsaclmode"++instance Value ZFSACLMode where+ toValue AMDiscard = "discard"+ toValue AMGroupmask = "groupmask"+ toValue AMPassthrough = "passthrough"++data ZFSProperty = Mounted ZFSYesNo+ | Mountpoint ZFSString+ | ReadOnly ZFSYesNo+ | ACLInherit ZFSACLInherit+ | ACLMode ZFSACLMode+ | StringProperty String ZFSString+ deriving (Show, Eq, Ord)++toPair :: ZFSProperty -> (String, String)+toPair (Mounted v) = ("mounted", toValue v)+toPair (Mountpoint v) = ("mountpoint", toValue v)+toPair (ReadOnly v) = ("readonly", toValue v)+toPair (ACLInherit v) = ("aclinherit", toValue v)+toPair (ACLMode v) = ("aclmode", toValue v)+toPair (StringProperty s v) = (s, toValue v)++fromPair :: (String, String) -> ZFSProperty+fromPair ("mounted", v) = Mounted (fromString v)+fromPair ("mountpoint", v) = Mountpoint (fromString v)+fromPair ("readonly", v) = ReadOnly (fromString v)+fromPair ("aclinherit", v) = ACLInherit (fromString v)+fromPair ("aclmode", v) = ACLMode (fromString v)+fromPair (s, v) = StringProperty s (fromString v)
src/System/Console/Concurrent/Internal.hs view
@@ -31,6 +31,7 @@ import qualified Data.Text.IO as T import Control.Applicative import Prelude+import System.Log.Logger import Utility.Monad import Utility.Exception@@ -114,21 +115,20 @@ withConcurrentOutput a = a `finally` liftIO flushConcurrentOutput -- | Blocks until any processes started by `createProcessConcurrent` have--- finished, and any buffered output is displayed. +-- finished, and any buffered output is displayed. Also blocks while+-- `lockOutput` is is use. ----- `withConcurrentOutput` calls this at the end; you can call it anytime--- you want to flush output.+-- `withConcurrentOutput` calls this at the end, so you do not normally+-- need to use this. flushConcurrentOutput :: IO () flushConcurrentOutput = do- -- Wait for all outputThreads to finish.- let v = outputThreads globalOutputHandle atomically $ do- r <- takeTMVar v+ r <- takeTMVar (outputThreads globalOutputHandle) if r <= 0- then putTMVar v r+ then putTMVar (outputThreads globalOutputHandle) r else retry- -- Take output lock to ensure that nothing else is currently- -- generating output, and flush any buffered output.+ -- Take output lock to wait for anything else that might be+ -- currently generating output. lockOutput $ return () -- | Values that can be output.@@ -286,17 +286,31 @@ fgProcess p = do r@(_, _, _, h) <- P.createProcess p `onException` dropOutputLock+ registerOutputThread+ debug ["fgProcess", showProc p] -- Wait for the process to exit and drop the lock. asyncProcessWaiter $ do void $ tryIO $ P.waitForProcess h+ unregisterOutputThread dropOutputLock+ debug ["fgProcess done", showProc p] return (toConcurrentProcessHandle r)+ +debug :: [String] -> IO ()+debug = debugM "concurrent-output" . unwords +showProc :: P.CreateProcess -> String+showProc = go . P.cmdspec+ where+ go (P.ShellCommand s) = s+ go (P.RawCommand c ps) = show (c, ps)+ #ifndef mingw32_HOST_OS bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle) bgProcess p = do (toouth, fromouth) <- pipe (toerrh, fromerrh) <- pipe+ debug ["bgProcess", showProc p] let p' = p { P.std_out = rediroutput (P.std_out p) toouth , P.std_err = rediroutput (P.std_err p) toerrh@@ -402,7 +416,7 @@ ( void $ mapConcurrently displaybuf ts , noop -- buffers already moved to global )- worker2 <- async $ void $ globalbuf activitysig+ worker2 <- async $ void $ globalbuf activitysig worker1 void $ async $ do void $ waitCatch worker1 void $ waitCatch worker2@@ -419,7 +433,7 @@ case change of Right BufSig -> displaybuf v Left AtEnd -> return ()- globalbuf activitysig = do+ globalbuf activitysig worker1 = do ok <- atomically $ do -- signal we're going to handle it -- (returns false if the displaybuf already did)@@ -436,6 +450,9 @@ atomically $ forM_ bs $ \(outh, b) -> bufferOutputSTM' outh b+ -- worker1 might be blocked waiting for the output+ -- lock, and we've already done its job, so cancel it+ cancel worker1 -- Adds a value to the OutputBuffer. When adding Output to a Handle, -- it's cheaper to combine it with any already buffered Output to that
src/Utility/Process.hs view
@@ -18,6 +18,7 @@ readProcessEnv, writeReadProcessEnv, forceSuccessProcess,+ forceSuccessProcess', checkSuccessProcess, ignoreFailureProcess, createProcessSuccess,@@ -129,11 +130,12 @@ -- | Waits for a ProcessHandle, and throws an IOError if the process -- did not exit successfully. forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()-forceSuccessProcess p pid = do- code <- waitForProcess pid- case code of- ExitSuccess -> return ()- ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n+forceSuccessProcess p pid = waitForProcess pid >>= forceSuccessProcess' p++forceSuccessProcess' :: CreateProcess -> ExitCode -> IO ()+forceSuccessProcess' _ ExitSuccess = return ()+forceSuccessProcess' p (ExitFailure n) = fail $+ showCmd p ++ " exited " ++ show n -- | Waits for a ProcessHandle and returns True if it exited successfully. -- Note that using this with createProcessChecked will throw away
+ src/Utility/Process/NonConcurrent.hs view
@@ -0,0 +1,35 @@+{- Running processes in the foreground, not via the concurrent-output+ - layer.+ -+ - Avoid using this in propellor properties!+ -+ - Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Process.NonConcurrent where++import System.Process+import System.Exit+import System.IO+import Utility.SafeCommand+import Control.Applicative+import Prelude++boolSystemNonConcurrent :: String -> [CommandParam] -> IO Bool+boolSystemNonConcurrent cmd params = do+ (Nothing, Nothing, Nothing, p) <- createProcessNonConcurrent $+ proc cmd (toCommand params)+ dispatch <$> waitForProcessNonConcurrent p+ where+ dispatch ExitSuccess = True+ dispatch _ = False++createProcessNonConcurrent :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)+createProcessNonConcurrent = createProcess++waitForProcessNonConcurrent :: ProcessHandle -> IO ExitCode+waitForProcessNonConcurrent = waitForProcess