propellor (0.8.1) unstable; urgency=medium
* Run apt-get update in initial bootstrap. * --list-fields now includes a table of fields that are not currently set, but would be used if they got set. * Remove .gitignore from cabal file list, to avoid build failure on Debian. Closes: #754334 # imported from the archive
This commit is contained in:
commit
82da31b3e0
|
@ -0,0 +1,22 @@
|
|||
Copyright 2014 Joey Hess <joeyh@debian.org> and contributors.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGE.
|
|
@ -0,0 +1,45 @@
|
|||
CABAL?=cabal
|
||||
|
||||
DEBDEPS=gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev
|
||||
|
||||
run: deps build
|
||||
./propellor
|
||||
|
||||
dev: build tags
|
||||
|
||||
build: dist/setup-config
|
||||
if ! $(CABAL) build; then $(CABAL) configure; $(CABAL) build; fi
|
||||
ln -sf dist/build/propellor-config/propellor-config propellor
|
||||
|
||||
deps:
|
||||
@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS) || (apt-get update && apt-get --no-upgrade --no-install-recommends -y install $(DEBDEPS)); fi || true
|
||||
@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || (cabal update; cabal install async); fi || true
|
||||
|
||||
dist/setup-config: propellor.cabal
|
||||
if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi
|
||||
$(CABAL) configure
|
||||
|
||||
install:
|
||||
install -d $(DESTDIR)/usr/bin $(DESTDIR)/usr/src/propellor
|
||||
install -s dist/build/propellor/propellor $(DESTDIR)/usr/bin/propellor
|
||||
$(CABAL) sdist
|
||||
cat dist/propellor-*.tar.gz | \
|
||||
(cd $(DESTDIR)/usr/src/propellor && tar zx --strip-components=1)
|
||||
|
||||
clean:
|
||||
rm -rf dist Setup tags propellor privdata/local
|
||||
find -name \*.o -exec rm {} \;
|
||||
find -name \*.hi -exec rm {} \;
|
||||
|
||||
# hothasktags chokes on some template haskell etc, so ignore errors
|
||||
# duplicate tags with Propellor.Property. removed from the start, as we
|
||||
# often import qualified by just the module base name.
|
||||
tags:
|
||||
find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags 2>/dev/null
|
||||
|
||||
# Upload to hackage.
|
||||
hackage:
|
||||
@cabal sdist
|
||||
@cabal upload dist/*.tar.gz
|
||||
|
||||
.PHONY: tags
|
|
@ -0,0 +1,5 @@
|
|||
{- cabal setup file -}
|
||||
|
||||
import Distribution.Simple
|
||||
|
||||
main = defaultMain
|
|
@ -0,0 +1,416 @@
|
|||
-- This is the live config file used by propellor's author.
|
||||
module Main where
|
||||
|
||||
import Propellor
|
||||
import Propellor.CmdLine
|
||||
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.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.Reboot as Reboot
|
||||
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.Docker as Docker
|
||||
import qualified Propellor.Property.Git as Git
|
||||
import qualified Propellor.Property.Apache as Apache
|
||||
import qualified Propellor.Property.Postfix as Postfix
|
||||
import qualified Propellor.Property.Service as Service
|
||||
import qualified Propellor.Property.Grub as Grub
|
||||
import qualified Propellor.Property.HostingProvider.DigitalOcean as DigitalOcean
|
||||
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.JoeySites as JoeySites
|
||||
|
||||
|
||||
main :: IO () -- _ ______`| ,-.__
|
||||
main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'
|
||||
{- Propellor -- \ / | / ) _.-"-._
|
||||
Deployed -} -- `/-==__ _/__|/__=-| ( \_
|
||||
hosts :: [Host] -- * \ | | '--------'
|
||||
hosts = -- (o) `
|
||||
[ host "darkstar.kitenet.net"
|
||||
& ipv6 "2001:4830:1600:187::2" -- sixxs tunnel
|
||||
|
||||
& Apt.buildDep ["git-annex"] `period` Daily
|
||||
& Docker.configured
|
||||
& Docker.docked hosts "android-git-annex"
|
||||
|
||||
, standardSystem "clam.kitenet.net" Unstable "amd64"
|
||||
[ "Unreliable server. Anything here may be lost at any time!" ]
|
||||
& ipv4 "162.248.9.29"
|
||||
|
||||
& CloudAtCost.decruft
|
||||
& Apt.unattendedUpgrades
|
||||
& Network.ipv6to4
|
||||
& Tor.isBridge
|
||||
& Postfix.satellite
|
||||
|
||||
& Docker.configured
|
||||
& Docker.garbageCollected `period` Daily
|
||||
|
||||
-- Orca is the main git-annex build box.
|
||||
, standardSystem "orca.kitenet.net" Unstable "amd64"
|
||||
[ "Main git-annex build box." ]
|
||||
& ipv4 "138.38.108.179"
|
||||
|
||||
& Hostname.sane
|
||||
& Apt.unattendedUpgrades
|
||||
& Postfix.satellite
|
||||
& Docker.configured
|
||||
& Docker.docked hosts "amd64-git-annex-builder"
|
||||
& Docker.docked hosts "i386-git-annex-builder"
|
||||
& Docker.docked hosts "armel-git-annex-builder-companion"
|
||||
& Docker.docked hosts "armel-git-annex-builder"
|
||||
& Docker.docked hosts "android-git-annex-builder"
|
||||
& Docker.garbageCollected `period` Daily
|
||||
& Apt.buildDep ["git-annex"] `period` Daily
|
||||
|
||||
, standardSystem "kite.kitenet.net" Unstable "amd64"
|
||||
[ "Welcome to the new kitenet.net server!"
|
||||
, "This is still under construction and not yet live.."
|
||||
]
|
||||
& ipv4 "66.228.36.95"
|
||||
& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
|
||||
|
||||
& Apt.installed ["linux-image-amd64"]
|
||||
& Linode.chainPVGrub 5
|
||||
& Hostname.sane
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.installed ["systemd"]
|
||||
& Ssh.hostKeys (Context "kitenet.net")
|
||||
|
||||
, standardSystem "diatom.kitenet.net" Stable "amd64"
|
||||
[ "Important stuff that needs not too much memory or CPU." ]
|
||||
& ipv4 "107.170.31.195"
|
||||
|
||||
& DigitalOcean.distroKernel
|
||||
& Hostname.sane
|
||||
& Ssh.hostKeys (Context "diatom.kitenet.net")
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.serviceInstalledRunning "ntp"
|
||||
& Postfix.satellite
|
||||
|
||||
-- Diatom has 500 mb of memory, so tune for that.
|
||||
& JoeySites.obnamLowMem
|
||||
& Apt.serviceInstalledRunning "swapspace"
|
||||
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
& File.hasPrivContent "/etc/ssl/certs/web.pem" (Context "kitenet.net")
|
||||
& File.hasPrivContent "/etc/ssl/private/web.pem" (Context "kitenet.net")
|
||||
& File.hasPrivContent "/etc/ssl/certs/startssl.pem" (Context "kitenet.net")
|
||||
& Apache.modEnabled "ssl"
|
||||
& Apache.multiSSL
|
||||
& File.ownerGroup "/srv/web" "joey" "joey"
|
||||
& Apt.installed ["analog"]
|
||||
|
||||
& alias "git.kitenet.net"
|
||||
& alias "git.joeyh.name"
|
||||
& JoeySites.gitServer hosts
|
||||
|
||||
& alias "downloads.kitenet.net"
|
||||
& JoeySites.annexWebSite hosts "/srv/git/downloads.git"
|
||||
"downloads.kitenet.net"
|
||||
"840760dc-08f0-11e2-8c61-576b7e66acfd"
|
||||
[("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")]
|
||||
& JoeySites.gitAnnexDistributor
|
||||
|
||||
& alias "tmp.kitenet.net"
|
||||
& JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git"
|
||||
"tmp.kitenet.net"
|
||||
"26fd6e38-1226-11e2-a75f-ff007033bdba"
|
||||
[]
|
||||
& JoeySites.twitRss
|
||||
|
||||
& alias "nntp.olduse.net"
|
||||
& alias "resources.olduse.net"
|
||||
& JoeySites.oldUseNetServer hosts
|
||||
|
||||
& alias "ns2.kitenet.net"
|
||||
& myDnsPrimary "kitenet.net" []
|
||||
& myDnsPrimary "joeyh.name" []
|
||||
& myDnsPrimary "ikiwiki.info" []
|
||||
& myDnsPrimary "olduse.net"
|
||||
[ (RelDomain "article",
|
||||
CNAME $ AbsDomain "virgil.koldfront.dk") ]
|
||||
|
||||
& alias "ns3.branchable.com"
|
||||
& branchableSecondary
|
||||
|
||||
& Dns.secondaryFor ["animx"] hosts "animx.eu.org"
|
||||
|
||||
, let ctx = Context "elephant.kitenet.net"
|
||||
in standardSystem "elephant.kitenet.net" Unstable "amd64"
|
||||
[ "Storage, big data, and backups, omnomnom!" ]
|
||||
& ipv4 "193.234.225.114"
|
||||
|
||||
& Grub.chainPVGrub "hd0,0" "xen/xvda1" 30
|
||||
& Hostname.sane
|
||||
& Postfix.satellite
|
||||
& Apt.unattendedUpgrades
|
||||
& Ssh.hostKeys ctx
|
||||
& Ssh.keyImported SshRsa "joey" ctx
|
||||
& Apt.serviceInstalledRunning "swapspace"
|
||||
|
||||
& alias "eubackup.kitenet.net"
|
||||
& Apt.installed ["obnam", "sshfs", "rsync"]
|
||||
& JoeySites.githubBackup
|
||||
& JoeySites.obnamRepos ["wren", "pell"]
|
||||
& Ssh.knownHost hosts "usw-s002.rsync.net" "joey"
|
||||
|
||||
& alias "podcatcher.kitenet.net"
|
||||
& Apt.installed ["git-annex"]
|
||||
|
||||
& alias "znc.kitenet.net"
|
||||
& JoeySites.ircBouncer
|
||||
|
||||
-- I'd rather this were on diatom, but it needs unstable.
|
||||
& alias "kgb.kitenet.net"
|
||||
& JoeySites.kgbServer
|
||||
|
||||
& alias "mumble.kitenet.net"
|
||||
& JoeySites.mumbleServer hosts
|
||||
|
||||
& alias "ns3.kitenet.net"
|
||||
& myDnsSecondary
|
||||
|
||||
& Docker.configured
|
||||
|
||||
& Docker.docked hosts "oldusenet-shellbox"
|
||||
& Docker.docked hosts "openid-provider"
|
||||
`requires` Apt.serviceInstalledRunning "ntp"
|
||||
& Docker.docked hosts "ancient-kitenet"
|
||||
|
||||
& Docker.garbageCollected `period` (Weekly (Just 1))
|
||||
|
||||
-- For https port 443, shellinabox with ssh login to
|
||||
-- kitenet.net
|
||||
& alias "shell.kitenet.net"
|
||||
& JoeySites.kiteShellBox
|
||||
-- Nothing is using http port 80, so listen on
|
||||
-- that port for ssh, for traveling on bad networks that
|
||||
-- block 22.
|
||||
& "/etc/ssh/sshd_config" `File.containsLine` "Port 80"
|
||||
`onChange` Service.restarted "ssh"
|
||||
|
||||
-- temp
|
||||
& Docker.docked hosts "amd64-git-annex-builder"
|
||||
& Docker.docked hosts "i386-git-annex-builder"
|
||||
& Docker.docked hosts "android-git-annex-builder"
|
||||
|
||||
|
||||
--' __|II| ,.
|
||||
---- __|II|II|__ ( \_,/\
|
||||
------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-
|
||||
----------------------- | [Docker] / ----------------------
|
||||
----------------------- : / -----------------------
|
||||
------------------------ \____, o ,' ------------------------
|
||||
------------------------- '--,___________,' -------------------------
|
||||
|
||||
-- Simple web server, publishing the outside host's /var/www
|
||||
, standardContainer "webserver" Stable "amd64"
|
||||
& Docker.publish "8080:80"
|
||||
& Docker.volume "/var/www:/var/www"
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
|
||||
-- My own openid provider. Uses php, so containerized for security
|
||||
-- and administrative sanity.
|
||||
, standardContainer "openid-provider" Stable "amd64"
|
||||
& alias "openid.kitenet.net"
|
||||
& Docker.publish "8081:80"
|
||||
& OpenId.providerFor ["joey", "liw"]
|
||||
"openid.kitenet.net:8081"
|
||||
|
||||
-- Exhibit: kite's 90's website.
|
||||
, standardContainer "ancient-kitenet" Stable "amd64"
|
||||
& alias "ancient.kitenet.net"
|
||||
& Docker.publish "1994:80"
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
& Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www"
|
||||
(Just "remotes/origin/old-kitenet.net")
|
||||
|
||||
, standardContainer "oldusenet-shellbox" Stable "amd64"
|
||||
& alias "shell.olduse.net"
|
||||
& Docker.publish "4200:4200"
|
||||
& JoeySites.oldUseNetShellBox
|
||||
|
||||
-- git-annex autobuilder containers
|
||||
, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
|
||||
, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"
|
||||
, GitAnnexBuilder.armelCompanionContainer dockerImage
|
||||
, GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h"
|
||||
, GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h"
|
||||
|
||||
-- for development of git-annex for android, using my git-annex
|
||||
-- work tree
|
||||
, let gitannexdir = GitAnnexBuilder.homedir </> "git-annex"
|
||||
in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir
|
||||
& Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)
|
||||
|
||||
-- temp for an acquantance
|
||||
] ++ monsters
|
||||
|
||||
type Motd = [String]
|
||||
|
||||
-- This is my standard system setup.
|
||||
standardSystem :: HostName -> DebianSuite -> Architecture -> Motd -> Host
|
||||
standardSystem hn suite arch motd = host hn
|
||||
& os (System (Debian suite) arch)
|
||||
& File.hasContent "/etc/motd" ("":motd++[""])
|
||||
& Apt.stdSourcesList `onChange` Apt.upgrade
|
||||
& Apt.cacheCleaned
|
||||
& Apt.installed ["etckeeper"]
|
||||
& Apt.installed ["ssh"]
|
||||
& GitHome.installedFor "root"
|
||||
& User.hasSomePassword "root" (Context hn)
|
||||
-- Harden the system, but only once root's authorized_keys
|
||||
-- is safely in place.
|
||||
& check (Ssh.hasAuthorizedKeys "root")
|
||||
(Ssh.passwordAuthentication False)
|
||||
& User.accountFor "joey"
|
||||
& User.hasSomePassword "joey" (Context hn)
|
||||
& Sudo.enabledFor "joey"
|
||||
& GitHome.installedFor "joey"
|
||||
& Apt.installed ["vim", "screen", "less"]
|
||||
& Cron.runPropellor "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 :: Docker.ContainerName -> DebianSuite -> Architecture -> Host
|
||||
standardContainer name suite arch = Docker.container name (dockerImage system)
|
||||
& os system
|
||||
& Apt.stdSourcesList `onChange` Apt.upgrade
|
||||
& Apt.installed ["systemd"]
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.cacheCleaned
|
||||
where
|
||||
system = System (Debian suite) arch
|
||||
|
||||
-- Docker images I prefer to use.
|
||||
dockerImage :: System -> Docker.Image
|
||||
dockerImage (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
|
||||
dockerImage (System (Debian Testing) arch) = "joeyh/debian-unstable-" ++ arch
|
||||
dockerImage (System (Debian Stable) arch) = "joeyh/debian-stable-" ++ arch
|
||||
dockerImage _ = "debian-stable-official" -- does not currently exist!
|
||||
|
||||
myDnsSecondary :: Property
|
||||
myDnsSecondary = propertyList "dns secondary for all my domains" $ map toProp
|
||||
[ Dns.secondary hosts "kitenet.net"
|
||||
, Dns.secondary hosts "joeyh.name"
|
||||
, Dns.secondary hosts "ikiwiki.info"
|
||||
, Dns.secondary hosts "olduse.net"
|
||||
]
|
||||
|
||||
branchableSecondary :: RevertableProperty
|
||||
branchableSecondary = Dns.secondaryFor ["branchable.com"] hosts "branchable.com"
|
||||
|
||||
-- Currently using diatom (ns2) as primary with secondaries
|
||||
-- elephant (ns3) and gandi.
|
||||
-- kite handles all mail.
|
||||
myDnsPrimary :: Domain -> [(BindDomain, Record)] -> RevertableProperty
|
||||
myDnsPrimary domain extras = Dns.primary hosts domain
|
||||
(Dns.mkSOA "ns2.kitenet.net" 100) $
|
||||
[ (RootDomain, NS $ AbsDomain "ns2.kitenet.net")
|
||||
, (RootDomain, NS $ AbsDomain "ns3.kitenet.net")
|
||||
, (RootDomain, NS $ AbsDomain "ns6.gandi.net")
|
||||
, (RootDomain, MX 0 $ AbsDomain "kitenet.net")
|
||||
, (RootDomain, TXT "v=spf1 a ?all")
|
||||
] ++ extras
|
||||
|
||||
|
||||
-- o
|
||||
-- ___ o o
|
||||
{-----\ / o \ ___o o
|
||||
{ \ __ \ / _ (X___>-- __o
|
||||
_____________________{ ______\___ \__/ | \__/ \____ |X__>
|
||||
< \___//|\\___/\ \____________ _
|
||||
\ ___/ | \___ # # \ (-)
|
||||
\ O O O # | \ # >=)
|
||||
\______________________________# # / #__________________/ (-}
|
||||
|
||||
|
||||
monsters :: [Host] -- Systems I don't manage with propellor,
|
||||
monsters = -- but do want to track their public keys etc.
|
||||
[ host "usw-s002.rsync.net"
|
||||
& sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="
|
||||
, host "github.com"
|
||||
& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
|
||||
, host "ns6.gandi.net"
|
||||
& ipv4 "217.70.177.40"
|
||||
, host "turtle.kitenet.net"
|
||||
& ipv4 "67.223.19.96"
|
||||
& ipv6 "2001:4978:f:2d9::2"
|
||||
& alias "backup.kitenet.net"
|
||||
& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
|
||||
, host "wren.kitenet.net"
|
||||
& ipv4 "80.68.85.49"
|
||||
& ipv6 "2001:41c8:125:49::10"
|
||||
& alias "kitenet.net"
|
||||
& alias "ns1.kitenet.net"
|
||||
& alias "ftp.kitenet.net"
|
||||
& alias "mail.kitenet.net"
|
||||
& alias "smtp.kitenet.net"
|
||||
& alias "sows-ear.kitenet.net"
|
||||
& alias "www.sows-ear.kitenet.net"
|
||||
& alias "wortroot.kitenet.net"
|
||||
& alias "www.wortroot.kitenet.net"
|
||||
& alias "joey.kitenet.net"
|
||||
& alias "anna.kitenet.net"
|
||||
& alias "bitlbee.kitenet.net"
|
||||
{- Remaining services on kite:
|
||||
-
|
||||
- mail
|
||||
- postfix
|
||||
- postgrey
|
||||
- mailman
|
||||
- spamassassin
|
||||
- sqwebmail
|
||||
- courier
|
||||
- imap
|
||||
- tls
|
||||
- apache
|
||||
- some static websites
|
||||
- bitlbee
|
||||
- prosody
|
||||
- (used by daddy's git-annex)
|
||||
- named
|
||||
- (branchable is still pushing to here
|
||||
- (thinking it's ns2.branchable.com), but it's no
|
||||
- longer a primary or secondary for anything)
|
||||
- ftpd (EOL)
|
||||
-
|
||||
- user shell stuff:
|
||||
- pine, zsh, make, git-annex, myrepos, ...
|
||||
-}
|
||||
, host "mouse.kitenet.net"
|
||||
& ipv6 "2001:4830:1600:492::2"
|
||||
, host "beaver.kitenet.net"
|
||||
& ipv6 "2001:4830:1600:195::2"
|
||||
, host "hydra.kitenet.net"
|
||||
& ipv4 "192.25.206.60"
|
||||
, host "branchable.com"
|
||||
& ipv4 "66.228.46.55"
|
||||
& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
|
||||
& 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"
|
||||
, host "animx"
|
||||
& ipv4 "76.7.162.101"
|
||||
& ipv4 "76.7.162.186"
|
||||
]
|
|
@ -0,0 +1,49 @@
|
|||
-- This is the main configuration file for Propellor, and is used to build
|
||||
-- the propellor program.
|
||||
|
||||
import Propellor
|
||||
import Propellor.CmdLine
|
||||
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.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.Reboot as Reboot
|
||||
--import qualified Propellor.Property.Tor as Tor
|
||||
import qualified Propellor.Property.Docker as Docker
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain hosts
|
||||
|
||||
-- The hosts propellor knows about.
|
||||
-- Edit this to configure propellor!
|
||||
hosts :: [Host]
|
||||
hosts =
|
||||
[ host "mybox.example.com"
|
||||
& os (System (Debian Unstable) "amd64")
|
||||
& Apt.stdSourcesList
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.installed ["etckeeper"]
|
||||
& Apt.installed ["ssh"]
|
||||
& User.hasSomePassword "root" (Context "mybox.example.com")
|
||||
& Network.ipv6to4
|
||||
& File.dirExists "/var/www"
|
||||
& Docker.docked hosts "webserver"
|
||||
& Docker.garbageCollected `period` Daily
|
||||
& Cron.runPropellor "30 * * * *"
|
||||
|
||||
-- A generic webserver in a Docker container.
|
||||
, Docker.container "webserver" "joeyh/debian-stable"
|
||||
& os (System (Debian Stable) "amd64")
|
||||
& Apt.stdSourcesList
|
||||
& Docker.publish "80:80"
|
||||
& Docker.volume "/var/www:/var/www"
|
||||
& Apt.serviceInstalledRunning "apache2"
|
||||
|
||||
-- add more hosts here...
|
||||
--, host "foo.example.com" = ...
|
||||
]
|
|
@ -0,0 +1,7 @@
|
|||
The Debian package of propellor ships its full source code because
|
||||
propellor is configured by rebuilding it, and embraces modification of any
|
||||
of the source code.
|
||||
|
||||
/usr/bin/propellor is a wrapper which will set up a propellor git
|
||||
repository in ~/.propellor/, and run ~/.propellor/propellor if it exists.
|
||||
Edit ~/.propellor/config.hs to configure it.
|
|
@ -0,0 +1,194 @@
|
|||
propellor (0.8.1) unstable; urgency=medium
|
||||
|
||||
* Run apt-get update in initial bootstrap.
|
||||
* --list-fields now includes a table of fields that are not currently set,
|
||||
but would be used if they got set.
|
||||
* Remove .gitignore from cabal file list, to avoid build failure on Debian.
|
||||
Closes: #754334
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Wed, 09 Jul 2014 22:11:31 -0400
|
||||
|
||||
propellor (0.8.0) unstable; urgency=medium
|
||||
|
||||
* Completely reworked privdata storage. There is now a single file,
|
||||
and each host is sent only the privdata that its Properties actually use.
|
||||
|
||||
To transition existing privdata, run propellor against a host and
|
||||
watch out for the red failure messages, and run the suggested commands
|
||||
to store the privdata using the new storage scheme. You may find
|
||||
it useful to run the old version of propellor to extract data from the old
|
||||
privdata files during this migration.
|
||||
|
||||
Several properties that use privdata now require a context to be
|
||||
specified. If in doubt, you can use anyContext, or
|
||||
Context "hostname.example.com"
|
||||
|
||||
* Add --edit to edit a privdata value in $EDITOR.
|
||||
* Add --list-fields to list all currently set privdata fields, along with
|
||||
the hosts that use them.
|
||||
* Fix randomHostKeys property to run openssh-server's postinst in a
|
||||
non-failing way.
|
||||
* Hostname.sane now cleans up the 127.0.0.1 localhost line in /etc/hosts,
|
||||
to avoid eg, apache complaining "Could not reliably determine the
|
||||
server's fully qualified domain name".
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sun, 06 Jul 2014 18:28:08 -0400
|
||||
|
||||
propellor (0.7.0) unstable; urgency=medium
|
||||
|
||||
* combineProperties no longer stops when a property fails; now it continues
|
||||
trying to satisfy all properties on the list before propigating the
|
||||
failure.
|
||||
* Attr is renamed to Info.
|
||||
* Renamed wrapper to propellor to make cabal installation of propellor work.
|
||||
* When git gpg signature of a fetched git branch cannot be verified,
|
||||
propellor will now continue running, but without merging in that branch.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Fri, 13 Jun 2014 10:06:40 -0400
|
||||
|
||||
propellor (0.6.0) unstable; urgency=medium
|
||||
|
||||
* Docker containers now propagate DNS attributes out to the host they're
|
||||
docked in. So if a docker container sets a DNS alias, every container
|
||||
it's docked in will automatically be added to a DNS round-robin,
|
||||
when propellor is used to manage DNS for the domain.
|
||||
* Apt.stdSourcesList no longer needs a suite to be specified.
|
||||
* Added --dump to dump out a field of a host's privdata. Useful for editing
|
||||
it.
|
||||
* Propellor's output now includes the hostname being provisioned, or
|
||||
when provisioning a docker container, the container name.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Thu, 05 Jun 2014 17:32:14 -0400
|
||||
|
||||
propellor (0.5.3) unstable; urgency=medium
|
||||
|
||||
* Fix unattended-upgrades config for !stable.
|
||||
* Ensure that kernel hostname is same as /etc/hostname when configuring
|
||||
hostname.
|
||||
* Added modules for some hosting providers (DigitalOcean, CloudAtCost).
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Thu, 29 May 2014 14:29:53 -0400
|
||||
|
||||
propellor (0.5.2) unstable; urgency=medium
|
||||
|
||||
* A bug that caused propellor to hang when updating a running docker
|
||||
container appears to have been fixed. Note that since it affects
|
||||
the propellor process that serves as "init" of docker containers,
|
||||
they have to be restarted for the fix to take effect.
|
||||
* Licence changed from GPL to BSD.
|
||||
* A few changes to allow building Propellor on OSX. One user reports
|
||||
successfully using it there.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 17 May 2014 16:42:55 -0400
|
||||
|
||||
propellor (0.5.1) unstable; urgency=medium
|
||||
|
||||
* Primary DNS servers now have allow-transfer automatically populated
|
||||
with the IP addresses of secondary dns servers. So, it's important
|
||||
that all secondary DNS servers have an ipv4 (and/or ipv6) property
|
||||
configured.
|
||||
* Deal with old ssh connection caching sockets.
|
||||
* Add missing build deps and deps. Closes: #745459
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Thu, 24 Apr 2014 18:09:58 -0400
|
||||
|
||||
propellor (0.5.0) unstable; urgency=medium
|
||||
|
||||
* Removed root domain records from SOA. Instead, use RootDomain
|
||||
when calling Dns.primary.
|
||||
* Dns primary and secondary properties are now revertable.
|
||||
* When unattendedUpgrades is enabled on an Unstable or Testing system,
|
||||
configure it to allow the upgrades.
|
||||
* New website, https://propellor.branchable.com/
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 19 Apr 2014 17:38:02 -0400
|
||||
|
||||
propellor (0.4.0) unstable; urgency=medium
|
||||
|
||||
* Propellor can configure primary DNS servers, including generating
|
||||
zone files, which is done by looking at the properties of hosts
|
||||
in a domain.
|
||||
* The `cname` property was renamed to `alias` as it does not always
|
||||
generate CNAME in the DNS.
|
||||
* Constructor of Property has changed (use `property` function instead).
|
||||
* All Property combinators now combine together their Attr settings.
|
||||
So Attr settings can be made inside a propertyList, for example.
|
||||
* Run all cron jobs under chronic from moreutils to avoid unnecessary
|
||||
mails.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 19 Apr 2014 02:09:56 -0400
|
||||
|
||||
propellor (0.3.1) unstable; urgency=medium
|
||||
|
||||
* Merge scheduler bug fix from git-annex.
|
||||
* Support for provisioning hosts with ssh and gpg keys.
|
||||
* Obnam support.
|
||||
* Apache support.
|
||||
* Postfix satellite system support.
|
||||
* Properties can now be satisfied differently on different operating
|
||||
systems.
|
||||
* Standard apt configuration for stable now includes backports.
|
||||
* Cron jobs generated by propellor use flock(1) to avoid multiple
|
||||
instances running at a time.
|
||||
* Add support for SSH ed25519 keys.
|
||||
(Thanks, Franz Pletz.)
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Thu, 17 Apr 2014 20:07:33 -0400
|
||||
|
||||
propellor (0.3.0) unstable; urgency=medium
|
||||
|
||||
* ipv6to4: Ensure interface is brought up automatically on boot.
|
||||
* Enabling unattended upgrades now ensures that cron is installed and
|
||||
running to perform them.
|
||||
* Properties can be scheduled to only be checked after a given time period.
|
||||
* Fix bootstrapping of dependencies.
|
||||
* Fix compilation on Debian stable.
|
||||
* Include security updates in sources.list for stable and testing.
|
||||
* Use ssh connection caching, especially when bootstrapping.
|
||||
* Properties now run in a Propellor monad, which provides access to
|
||||
attributes of the host.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 01:19:05 -0400
|
||||
|
||||
propellor (0.2.3) unstable; urgency=medium
|
||||
|
||||
* docker: Fix laziness bug that caused running containers to be
|
||||
unnecessarily stopped and committed.
|
||||
* Add locking so only one propellor can run at a time on a host.
|
||||
* docker: When running as effective init inside container, wait on zombies.
|
||||
* docker: Added support for configuring shared volumes and linked
|
||||
containers.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Tue, 08 Apr 2014 02:07:37 -0400
|
||||
|
||||
propellor (0.2.2) unstable; urgency=medium
|
||||
|
||||
* Now supports provisioning docker containers with architecture/libraries
|
||||
that do not match the host.
|
||||
* Fixed a bug that caused file modes to be set to 600 when propellor
|
||||
modified the file (did not affect newly created files).
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Fri, 04 Apr 2014 01:07:32 -0400
|
||||
|
||||
propellor (0.2.1) unstable; urgency=medium
|
||||
|
||||
* First release with Debian package.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Thu, 03 Apr 2014 01:43:14 -0400
|
||||
|
||||
propellor (0.2.0) unstable; urgency=low
|
||||
|
||||
* Added support for provisioning Docker containers.
|
||||
* Bootstrap deployment now pushes the git repo to the remote host
|
||||
over ssh, securely.
|
||||
* propellor --add-key configures a gpg key, and makes propellor refuse
|
||||
to pull commits from git repositories not signed with that key.
|
||||
This allows propellor to be securely used with public, non-encrypted
|
||||
git repositories without the possibility of MITM.
|
||||
* Added support for type-safe reversions. Only some properties can be
|
||||
reverted; the type checker will tell you if you try something that won't
|
||||
work.
|
||||
* New syntactic sugar for building a list of properties, including
|
||||
revertable properties.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Wed, 02 Apr 2014 13:57:42 -0400
|
|
@ -0,0 +1 @@
|
|||
9
|
|
@ -0,0 +1,44 @@
|
|||
Source: propellor
|
||||
Section: admin
|
||||
Priority: optional
|
||||
Build-Depends:
|
||||
debhelper (>= 9),
|
||||
ghc (>= 7.4),
|
||||
cabal-install,
|
||||
libghc-async-dev,
|
||||
libghc-missingh-dev,
|
||||
libghc-hslogger-dev,
|
||||
libghc-unix-compat-dev,
|
||||
libghc-ansi-terminal-dev,
|
||||
libghc-ifelse-dev,
|
||||
libghc-network-dev,
|
||||
libghc-quickcheck2-dev,
|
||||
libghc-mtl-dev,
|
||||
libghc-monadcatchio-transformers-dev,
|
||||
Maintainer: Joey Hess <joeyh@debian.org>
|
||||
Standards-Version: 3.9.5
|
||||
Vcs-Git: git://git.kitenet.net/propellor
|
||||
Homepage: http://joeyh.name/code/propellor/
|
||||
|
||||
Package: propellor
|
||||
Architecture: any
|
||||
Section: admin
|
||||
Depends: ${misc:Depends}, ${shlibs:Depends},
|
||||
ghc (>= 7.4),
|
||||
cabal-install,
|
||||
libghc-async-dev,
|
||||
libghc-missingh-dev,
|
||||
libghc-hslogger-dev,
|
||||
libghc-unix-compat-dev,
|
||||
libghc-ansi-terminal-dev,
|
||||
libghc-ifelse-dev,
|
||||
libghc-network-dev,
|
||||
libghc-quickcheck2-dev,
|
||||
libghc-mtl-dev,
|
||||
libghc-monadcatchio-transformers-dev,
|
||||
git,
|
||||
Description: property-based host configuration management in haskell
|
||||
Propellor enures that the system it's run in satisfies a list of
|
||||
properties, taking action as necessary when a property is not yet met.
|
||||
.
|
||||
It is configured using haskell.
|
|
@ -0,0 +1,28 @@
|
|||
Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
|
||||
Source: native package
|
||||
|
||||
Files: *
|
||||
Copyright: © 2010-2014 Joey Hess <joey@kitenet.net>
|
||||
License: BSD-2-clause
|
||||
|
||||
License: BSD-2-clause
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
.
|
||||
THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
SUCH DAMAGE.
|
|
@ -0,0 +1,2 @@
|
|||
# These files are used in a git repository that propellor sets up.
|
||||
propellor: package-contains-vcs-control-file usr/src/propellor/.gitignore
|
|
@ -0,0 +1,15 @@
|
|||
.\" -*- nroff -*-
|
||||
.TH propellor 1 "Commands"
|
||||
.SH NAME
|
||||
propellor \- property-based host configuration management in haskell
|
||||
.SH SYNOPSIS
|
||||
.B propellor [options] host
|
||||
.SH DESCRIPTION
|
||||
.I propellor
|
||||
is a property-based host configuration management program written
|
||||
and configured in haskell.
|
||||
.PP
|
||||
The first time you run propellor, it will set up a ~/.propellor/
|
||||
repository. Edit ~/.propellor/config.hs to configure it.
|
||||
.SH AUTHOR
|
||||
Joey Hess <joey@kitenet.net>
|
|
@ -0,0 +1,18 @@
|
|||
#!/usr/bin/make -f
|
||||
|
||||
# Avoid using cabal, as it writes to $HOME
|
||||
export CABAL=./Setup
|
||||
|
||||
%:
|
||||
dh $@
|
||||
|
||||
override_dh_auto_build:
|
||||
$(MAKE) build
|
||||
override_dh_installdocs:
|
||||
dh_installdocs doc/README.mdwn
|
||||
override_dh_installman:
|
||||
dh_installman debian/propellor.1
|
||||
|
||||
# Not intended for use by anyone except the author.
|
||||
announcedir:
|
||||
@echo ${HOME}/src/propellor/doc/news
|
|
@ -0,0 +1,71 @@
|
|||
[Propellor](https://propellor.branchable.com/) is a
|
||||
configuration management system using Haskell and Git.
|
||||
Each system has a list of properties, which Propellor ensures
|
||||
are satisfied.
|
||||
|
||||
Propellor is configured via a git repository, which typically lives
|
||||
in `~/.propellor/` on your development machine. Propellor clones the
|
||||
repository to each host it manages, in a
|
||||
[secure](http://propellor.branchable.com/security/) way. The git repository
|
||||
contains the full source code to Propellor, along with its config file.
|
||||
|
||||
Properties are defined using Haskell. Edit `~/.propellor/config.hs`
|
||||
to get started. There is fairly complete
|
||||
[API documentation](http://hackage.haskell.org/package/propellor/),
|
||||
which includes many built-in Properties for dealing with
|
||||
[Apt](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apt.html)
|
||||
and
|
||||
[Apache](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Apache.html)
|
||||
,
|
||||
[Cron](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cron.html)
|
||||
and
|
||||
[Commands](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Cmd.html)
|
||||
,
|
||||
[Dns](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Dns.html)
|
||||
and
|
||||
[Docker](http://hackage.haskell.org/package/propellor/docs/Propellor-Property-Docker.html), etc.
|
||||
|
||||
There is no special language as used in puppet, chef, ansible, etc.. just
|
||||
the full power of Haskell. Hopefully that power can be put to good use in
|
||||
making declarative properties that are powerful, nicely idempotent, and
|
||||
easy to adapt to a system's special needs!
|
||||
|
||||
If using Haskell to configure Propellor seems intimidating,
|
||||
see [configuration for the Haskell newbie](https://propellor.branchable.com/haskell_newbie/).
|
||||
|
||||
## quick start
|
||||
|
||||
1. Get propellor installed
|
||||
`cabal install propellor`
|
||||
or
|
||||
`apt-get install propellor`
|
||||
2. Run propellor for the first time. It will set up a `~/.propellor/` git
|
||||
repository for you.
|
||||
3. If you don't have a gpg private key already, generate one: `gpg --gen-key`
|
||||
4. Run: `propellor --add-key $KEYID`, which will make propellor trust
|
||||
your gpg key, and will sign your `~/.propellor` repository using it.
|
||||
5. `cd ~/.propellor/`; use git to push the repository to a central
|
||||
server (github, or your own git server). Configure that central
|
||||
server as the origin remote of the repository.
|
||||
6. Edit `~/.propellor/config.hs`, and add a host you want to manage.
|
||||
You can start by not adding any properties, or only a few.
|
||||
7. Pick a host and run: `propellor --spin $HOST`
|
||||
8. Now you have a simple propellor deployment, but it doesn't do
|
||||
much to the host yet, besides installing propellor.
|
||||
|
||||
So, edit `~/.propellor/config.hs` to configure the host (maybe
|
||||
start with a few simple properties), and re-run step 7.
|
||||
Repeat until happy and move on to the next host. :)
|
||||
9. To move beyond manually running `propellor --spin` against hosts
|
||||
when you change their properties, add a property to your hosts
|
||||
like: `Cron.runPropellor "30 * * * *"`
|
||||
|
||||
Now they'll automatically update every 30 minutes, and you can
|
||||
`git commit -S` and `git push` changes that affect any number of
|
||||
hosts.
|
||||
10. Write some neat new properties and send patches to <propellor@joeyh.name>!
|
||||
|
||||
## debugging
|
||||
|
||||
Set `PROPELLOR_DEBUG=1` to make propellor print out all the commands it runs
|
||||
and any other debug messages that Properties choose to emit.
|
|
@ -0,0 +1,9 @@
|
|||
[[!sidebar content="""
|
||||
[[!inline pages="comment_pending(*)" feedfile=pendingmoderation
|
||||
description="comments pending moderation" show=-1]]
|
||||
Comments in the [[!commentmoderation desc="moderation queue"]]:
|
||||
[[!pagecount pages="comment_pending(*)"]]
|
||||
"""]]
|
||||
|
||||
Recent comments posted to this site:
|
||||
[[!inline pages="comment(*)" template="comment"]]
|
|
@ -0,0 +1,4 @@
|
|||
This is a place to discuss using propellor, share tips and tricks, etc.
|
||||
If you need help, advice, or anything, post about it here.
|
||||
|
||||
[[!inline pages="forum/* and !*/Discussion" archive=yes rootpage=forum postformtext="Add a new thread titled:"]]
|
|
@ -0,0 +1,5 @@
|
|||
I just did a cabal install of propellor
|
||||
|
||||
The binaries it installs are called wrapper and config, although the makefile/documentation say that at least one of them should be called propellor.
|
||||
|
||||
Is this correct?
|
|
@ -0,0 +1,8 @@
|
|||
[[!comment format=mdwn
|
||||
username="http://joeyh.name/"
|
||||
ip="2001:4830:1600:187::2"
|
||||
subject="comment 1"
|
||||
date="2014-06-09T16:34:29Z"
|
||||
content="""
|
||||
wrapper should be named propellor. This is fixed in git.
|
||||
"""]]
|
|
@ -0,0 +1,95 @@
|
|||
The only remote which seems to be copied to /root/.propellor/.git/config is upstream... My /home/user/.propellor/.git/config contains a "origin" remote, but this part (as well as the master branch part) of my git config is not copied to the /root/.propellor/.git/config of a host I'm trying to manage...
|
||||
|
||||
propellor fails with the following message:
|
||||
|
||||
user@laptop:~$ PROPELLOR_DEBUG=1 propellor --spin laptop.localdomain
|
||||
if ! cabal build; then cabal configure; cabal build; fi
|
||||
Building propellor-0.5.0...
|
||||
Preprocessing library propellor-0.5.0...
|
||||
In-place registering propellor-0.5.0...
|
||||
Preprocessing executable 'propellor' for propellor-0.5.0...
|
||||
Preprocessing executable 'config' for propellor-0.5.0...
|
||||
ln -sf dist/build/config/config propellor
|
||||
|
||||
|
||||
[2014-04-21 18:07:45 CEST] command line: Spin "laptop.localdomain"
|
||||
[2014-04-21 18:07:45 CEST] call: make ["build"]
|
||||
if ! cabal build; then cabal configure; cabal build; fi
|
||||
Building propellor-0.5.0...
|
||||
Preprocessing library propellor-0.5.0...
|
||||
In-place registering propellor-0.5.0...
|
||||
Preprocessing executable 'propellor' for propellor-0.5.0...
|
||||
Preprocessing executable 'config' for propellor-0.5.0...
|
||||
ln -sf dist/build/config/config propellor
|
||||
Propellor build ... done
|
||||
[2014-04-21 18:07:48 CEST] read: git ["config","remote.deploy.url"]
|
||||
[2014-04-21 18:07:48 CEST] read: git ["config","remote.origin.url"]
|
||||
[2014-04-21 18:07:48 CEST] call: git ["commit","--gpg-sign","--allow-empty","-a","-m","propellor spin"]
|
||||
|
||||
You need a passphrase to unlock the secret key for
|
||||
...
|
||||
|
||||
[master ee393d6] propellor spin
|
||||
[2014-04-21 18:07:48 CEST] call: git ["push"]
|
||||
Counting objects: 1, done.
|
||||
Writing objects: 100% (1/1), 852 bytes | 0 bytes/s, done.
|
||||
Total 1 (delta 0), reused 0 (delta 0)
|
||||
To git@remote-origin:propellor.git
|
||||
16a1f8b..ee393d6 master -> master
|
||||
[2014-04-21 18:08:21 CEST] chat: ssh ["-o","ControlPath=/home/user/.ssh/propellor/laptop.localdomain.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@laptop.localdomain","sh -c 'if [ ! -d /usr/local/propellor ] ; then apt-get --no-install-recommends --no-upgrade -y install git make && echo STATUSNeedGitClone ; else cd /usr/local/propellor && if ! test -x ./propellor; then make deps build; fi && ./propellor --boot laptop.localdomain ; fi'"]
|
||||
Initialized empty Git repository in /root/.propellor/.git/
|
||||
warning: no common commits
|
||||
From https://github.com/joeyh/propellor
|
||||
* [new branch] joeyconfig -> upstream/joeyconfig
|
||||
* [new branch] master -> upstream/master
|
||||
* [new branch] setup -> upstream/setup
|
||||
* [new tag] 0.1 -> 0.1
|
||||
* [new tag] 0.1.1 -> 0.1.1
|
||||
* [new tag] 0.1.2 -> 0.1.2
|
||||
* [new tag] 0.2.0 -> 0.2.0
|
||||
* [new tag] 0.2.1 -> 0.2.1
|
||||
* [new tag] 0.2.2 -> 0.2.2
|
||||
* [new tag] 0.2.3 -> 0.2.3
|
||||
* [new tag] 0.3.0 -> 0.3.0
|
||||
* [new tag] 0.3.1 -> 0.3.1
|
||||
* [new tag] 0.4.0 -> 0.4.0
|
||||
* [new tag] 0.5.0 -> 0.5.0
|
||||
* [new tag] debian/0.3.1 -> debian/0.3.1
|
||||
* [new tag] debian/0.4.0 -> debian/0.4.0
|
||||
* [new tag] debian/0.5.0 -> debian/0.5.0
|
||||
Merge made by the 'ours' strategy.
|
||||
if [ "cabal" = ./Setup ]; then ghc --make Setup; fi
|
||||
cabal configure
|
||||
Warning: The package list for 'hackage.haskell.org' does not exist. Run 'cabal
|
||||
update' to download it.
|
||||
Resolving dependencies...
|
||||
Configuring propellor-0.5.0...
|
||||
if ! cabal build; then cabal configure; cabal build; fi
|
||||
Building propellor-0.5.0...
|
||||
Preprocessing executable 'propellor' for propellor-0.5.0...
|
||||
[ 1 of 14] Compiling Utility.Env ( Utility/Env.hs, dist/build/propellor/propellor-tmp/Utility/Env.o )
|
||||
...
|
||||
[14 of 14] Compiling Main ( propellor.hs, dist/build/propellor/propellor-tmp/Main.o )
|
||||
Linking dist/build/propellor/propellor ...
|
||||
Preprocessing library propellor-0.5.0...
|
||||
[ 1 of 58] Compiling Utility.QuickCheck ( Utility/QuickCheck.hs, dist/build/Utility/QuickCheck.o )
|
||||
...
|
||||
[58 of 58] Compiling Propellor.CmdLine ( Propellor/CmdLine.hs, dist/build/Propellor/CmdLine.o )
|
||||
In-place registering propellor-0.5.0...
|
||||
Preprocessing executable 'config' for propellor-0.5.0...
|
||||
[ 1 of 44] Compiling Utility.QuickCheck ( Utility/QuickCheck.hs, dist/build/config/config-tmp/Utility/QuickCheck.o )
|
||||
...
|
||||
[44 of 44] Compiling Main ( config.hs, dist/build/config/config-tmp/Main.o )
|
||||
Linking dist/build/config/config ...
|
||||
ln -sf dist/build/config/config propellor
|
||||
fatal: No remote repository specified. Please, specify either a URL or a
|
||||
remote name from which new revisions should be fetched.
|
||||
Git fetch ... failed
|
||||
merge: origin/master - not something we can merge
|
||||
propellor: /usr/local/propellor/.lock: openFd: does not exist (No such file or directory)
|
||||
Setting up your propellor repo in /root/.propellor
|
||||
|
||||
|
||||
|
||||
** error: protocol error (perhaps the remote propellor failed to run?)
|
||||
propellor: user error (ssh ["-o","ControlPath=/home/user/.ssh/propellor/laptop.localdomain.sock","-o","ControlMaster=auto","-o","ControlPersist=yes","root@laptop.localdomain","sh -c 'if [ ! -d /usr/local/propellor ] ; then apt-get --no-install-recommends --no-upgrade -y install git make && echo STATUSNeedGitClone ; else cd /usr/local/propellor && if ! test -x ./propellor; then make deps build; fi && ./propellor --boot laptop.localdomain ; fi'"] exited 1)
|
|
@ -0,0 +1,25 @@
|
|||
[[!comment format=mdwn
|
||||
username="http://joeyh.name/"
|
||||
ip="209.250.56.114"
|
||||
subject="comment 1"
|
||||
date="2014-04-24T17:47:41Z"
|
||||
content="""
|
||||
I tried using propellor from scratch on a fresh system, and I cannot reproduce this problem.
|
||||
|
||||
/root/.propellor should only be created if /usr/bin/propellor is run as root. A normal use of propellor does not run /usr/bin/propellor as root (and your commands don't show you doing that).
|
||||
|
||||
This is the instant where something unexplained happens:
|
||||
|
||||
<pre>
|
||||
[2014-04-21 18:08:21 CEST] chat: ssh [\"-o\",\"ControlPath=/home/user/.ssh/propellor/laptop.localdomain.sock\",\"-o\",\"ControlMaster=auto\",\"-o\",\"ControlPersist=yes\",\"root@laptop.localdomain\",\"sh -c 'if [ ! -d /usr/local/propellor ] ; then apt-get --no-install-recommends --no-upgrade -y install git make && echo STATUSNeedGitClone ; else cd /usr/local/propellor && if ! test -x ./propellor; then make deps build; fi && ./propellor --boot laptop.localdomain ; fi'\"]
|
||||
Initialized empty Git repository in /root/.propellor/.git/
|
||||
</pre>
|
||||
|
||||
It ssh's in, and it apparently runs propellor. But apparently without running \"make deps build\" first, which is weird. (And as we see later, without /usr/local/propellor existing at all, which is weirder!)
|
||||
The ./propellor (in /usr/local/propellor) that it's supposed to run should be a symlink to dist/build/config/config, which is the program built from config.hs. It's not the same program as /usr/bin/propellor, which is a wrapper build from propellor.hs. However, it appears that in your case, when it sshed in, it ran /usr/bin/propellor, or something that behaves a lot like it..
|
||||
|
||||
My guesses:
|
||||
|
||||
1. Perhaps you modified the source tree in some strange way. (Doubtful)
|
||||
2. Perhaps you have some other configuration, eg a ssh authorized keys file for root with a forced command that runs /usr/bin/propellor. This will defeat propellor's own bootstrap code, and would exactly explain what you pasted.
|
||||
"""]]
|
|
@ -0,0 +1,120 @@
|
|||
[[!meta title="Propellor configuration for the Haskell newbie"]]
|
||||
|
||||
Propellor's config file is written in Haskell, and
|
||||
[Haskell](http://www.haskell.org/) is invaluable to extend Propellor with
|
||||
your own custom properties. But you don't need to know about monads to
|
||||
configure Propellor!
|
||||
|
||||
Let's take a quick tour of the `config.hs` file..
|
||||
|
||||
[[!format haskell """
|
||||
-- | This is the main configuration file for Propellor, and is used to build
|
||||
-- the propellor program.
|
||||
"""]]
|
||||
|
||||
So, `-- ` starts a comment in this file.
|
||||
|
||||
[[!format haskell """
|
||||
import Propellor
|
||||
import Propellor.CmdLine
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.User as User
|
||||
import qualified Propellor.Property.Cron as Cron
|
||||
"""]]
|
||||
|
||||
This loads up Propellor's modules. You'll almost certainly want these;
|
||||
many more can be found in the [API documentation](http://hackage.haskell.org/package/propellor).
|
||||
|
||||
[[!format haskell """
|
||||
main :: IO ()
|
||||
main = defaultMain hosts
|
||||
"""]]
|
||||
|
||||
This config file *is* the Propellor program, and so it needs a little
|
||||
stub to go run itself. No need to ever change this part.
|
||||
`hosts` is the list of hosts that you configure, and it comes next:
|
||||
|
||||
[[!format haskell """
|
||||
-- The hosts propellor knows about.
|
||||
-- Edit this to configure propellor!
|
||||
hosts :: [Host]
|
||||
hosts =
|
||||
[ host "mybox.example.com"
|
||||
& os (System (Debian Unstable) "amd64")
|
||||
& Apt.stdSourcesList
|
||||
, host "server.example.com"
|
||||
& os (System (Debian Stable) "amd64")
|
||||
& Apt.stdSourcesList
|
||||
& Apt.installed ["ssh"]
|
||||
]
|
||||
"""]]
|
||||
|
||||
This defines a list of hosts, with two hosts in it.
|
||||
|
||||
The configuration for the mybox host first tells propellor what
|
||||
OS it's running. Then the `stdSourcesList` line tells propellor to
|
||||
configure its `/etc/apt/sources.list`, using its OS.
|
||||
(Of course you might want to change that `Unstable` to `Stable`.)
|
||||
|
||||
Each property of the host is prefixed with an "&" operator. This just makes
|
||||
a list of properties.
|
||||
|
||||
Some other properties you may find in your config.hs, or want to add:
|
||||
|
||||
[[!format haskell """
|
||||
& Apt.unattendedUpgrades
|
||||
& User.hasSomePassword "root"
|
||||
& "/etc/default/foodaemon" `File.containsLine` "ENABLED=yes"
|
||||
& Cron.runPropellor "30 * * * *"
|
||||
"""]]
|
||||
|
||||
Some of these properties can be reverted -- this makes Propellor undo whatever
|
||||
effects they might have. For example, unattended upgrades can be scary, so
|
||||
maybe you turned that on, but want to disable it now. To do so, just change
|
||||
the "&" to a "!"
|
||||
|
||||
[[!format haskell """
|
||||
! Apt.unattendedUpgrades
|
||||
"""]]
|
||||
|
||||
Some properties cannot be reverted. Yet. It takes coding to implement
|
||||
revertability. If you try to revert a property that does not support
|
||||
reversion, propellor will **fail to compile**! This is a good thing..
|
||||
it avoids you getting confused or bad things happening.
|
||||
|
||||
The error message when this happens might look a little scary. But if
|
||||
you read through it, it's remarkably precise about what and where the problem
|
||||
is.
|
||||
|
||||
<pre>
|
||||
config.hs:30:19:
|
||||
Couldn't match expected type `RevertableProperty'
|
||||
with actual type `Property'
|
||||
In the return type of a call of `Apt.installed'
|
||||
In the second argument of `(!)', namely `Apt.installed ["ssh"]'
|
||||
In the first argument of `(&)', namely
|
||||
`host "mybox.example.com" & Apt.stdSourcesList Unstable
|
||||
& Apt.unattendedUpgrades
|
||||
! Apt.installed ["ssh"]'
|
||||
</pre>
|
||||
|
||||
Similarly, if you make a typo in the config file, you'll probably get a long
|
||||
but informative error message.
|
||||
|
||||
<pre>
|
||||
config.hs:27:19:
|
||||
Not in scope: `Apt.standardSourcesList'
|
||||
Perhaps you meant one of these:
|
||||
`Apt.stdSourcesList' (imported from Propellor.Property.Apt)
|
||||
...
|
||||
</pre>
|
||||
|
||||
That's really all there is to configuring Propellor. Once you
|
||||
have a `config.hs` ready to try out, you can run `propellor --spin $host`
|
||||
on one of the hosts configured in it.
|
||||
|
||||
See the [[README]] for a further quick start.
|
||||
|
||||
(If you'd like to learn a little Haskell after all, check out
|
||||
[Learn You a Haskell for Great Good](http://learnyouahaskell.com/).)
|
|
@ -0,0 +1,31 @@
|
|||
[[!meta title="propellor: property-based host configuration management in haskell"]]
|
||||
|
||||
[[!sidebar content="""
|
||||
[[Install]]
|
||||
[API documentation](http://hackage.haskell.org/package/propellor)
|
||||
[Sample config file](http://git.joeyh.name/?p=propellor.git;a=blob;f=config-joey.hs)
|
||||
[[Security]]
|
||||
[[Todo]]
|
||||
[[Forum]]
|
||||
"""]]
|
||||
|
||||
[[!inline raw=yes pages="README"]]
|
||||
|
||||
## enjoy
|
||||
|
||||
Hope you find Propellor fun and useful!
|
||||
|
||||
<pre>
|
||||
-- _ ______`| ,-.__
|
||||
{- Propellor -- / \___-=O`/|O`/__| (____.'
|
||||
Deployed -} -- \ / | / ) _.-"-._
|
||||
-- `/-==__ _/__|/__=-| ( \_
|
||||
hosts :: [Host] -- * \ | | '--------'
|
||||
hosts = -- (o) `
|
||||
</pre>
|
||||
|
||||
Propellor is free software, licensed under the BSD license.
|
||||
|
||||
## news
|
||||
|
||||
[[!inline pages="news/* and !*/Discussion" show="4" archive=yes]]
|
|
@ -0,0 +1,4 @@
|
|||
`git clone git://propellor.branchable.com/ propellor`
|
||||
Or get it [from github](https://github.com/joeyh/propellor).
|
||||
|
||||
Propellor is recently available in Debian.
|
|
@ -0,0 +1,9 @@
|
|||
propellor 0.5.2 released with [[!toggle text="these changes"]]
|
||||
[[!toggleable text="""
|
||||
* A bug that caused propellor to hang when updating a running docker
|
||||
container appears to have been fixed. Note that since it affects
|
||||
the propellor process that serves as "init" of docker containers,
|
||||
they have to be restarted for the fix to take effect.
|
||||
* Licence changed from GPL to BSD.
|
||||
* A few changes to allow building Propellor on OSX. One user reports
|
||||
successfully using it there."""]]
|
|
@ -0,0 +1,6 @@
|
|||
propellor 0.5.3 released with [[!toggle text="these changes"]]
|
||||
[[!toggleable text="""
|
||||
* Fix unattended-upgrades config for !stable.
|
||||
* Ensure that kernel hostname is same as /etc/hostname when configuring
|
||||
hostname.
|
||||
* Added modules for some hosting providers (DigitalOcean, CloudAtCost)."""]]
|
|
@ -0,0 +1,11 @@
|
|||
propellor 0.6.0 released with [[!toggle text="these changes"]]
|
||||
[[!toggleable text="""
|
||||
* Docker containers now propagate DNS attributes out to the host they're
|
||||
docked in. So if a docker container sets a DNS alias, every container
|
||||
it's docked in will automatically be added to a DNS round-robin,
|
||||
when propellor is used to manage DNS for the domain.
|
||||
* Apt.stdSourcesList no longer needs a suite to be specified.
|
||||
* Added --dump to dump out a field of a host's privdata. Useful for editing
|
||||
it.
|
||||
* Propellor's output now includes the hostname being provisioned, or
|
||||
when provisioning a docker container, the container name."""]]
|
|
@ -0,0 +1,9 @@
|
|||
propellor 0.7.0 released with [[!toggle text="these changes"]]
|
||||
[[!toggleable text="""
|
||||
* combineProperties no longer stops when a property fails; now it continues
|
||||
trying to satisfy all properties on the list before propigating the
|
||||
failure.
|
||||
* Attr is renamed to Info.
|
||||
* Renamed wrapper to propellor to make cabal installation of propellor work.
|
||||
* When git gpg signature of a fetched git branch cannot be verified,
|
||||
propellor will now continue running, but without merging in that branch."""]]
|
|
@ -0,0 +1,20 @@
|
|||
propellor 0.8.0 released with [[!toggle text="these changes"]]
|
||||
[[!toggleable text="""
|
||||
* Completely reworked privdata storage. There is now a single file,
|
||||
and each host is sent only the privdata that its Properties actually use.
|
||||
To transition existing privdata, run propellor against a host and
|
||||
watch out for the red failure messages, and run the suggested commands
|
||||
to store the privdata using the new storage scheme. You may find
|
||||
it useful to run the old version of propellor to extract data from the old
|
||||
privdata files during this migration.
|
||||
Several properties that use privdata now require a context to be
|
||||
specified. If in doubt, you can use anyContext, or
|
||||
Context "hostname.example.com"
|
||||
* Add --edit to edit a privdata value in $EDITOR.
|
||||
* Add --list-fields to list all currently set privdata fields, along with
|
||||
the hosts that use them.
|
||||
* Fix randomHostKeys property to run openssh-server's postinst in a
|
||||
non-failing way.
|
||||
* Hostname.sane now cleans up the 127.0.0.1 localhost line in /etc/hosts,
|
||||
to avoid eg, apache complaining "Could not reliably determine the
|
||||
server's fully qualified domain name"."""]]
|
|
@ -0,0 +1,37 @@
|
|||
Propellor's security model is that the hosts it's used to deploy are
|
||||
untrusted, and that the central git repository server is untrusted too.
|
||||
|
||||
The only trusted machine is the laptop where you run `propellor --spin`
|
||||
to connect to a remote host. And that one only because you have a ssh key
|
||||
or login password to the host.
|
||||
|
||||
Since the hosts propellor deploys are not trusted by the central git
|
||||
repository, they have to use git:// or http:// to pull from the central
|
||||
git repository, rather than ssh://.
|
||||
|
||||
So, to avoid a MITM attack, propellor checks that any commit it fetches
|
||||
from origin is gpg signed by a trusted gpg key, and refuses to deploy it
|
||||
otherwise.
|
||||
|
||||
That is only done when privdata/keyring.gpg exists. To set it up:
|
||||
|
||||
gpg --gen-key # only if you don't already have a gpg key
|
||||
propellor --add-key $MYKEYID
|
||||
|
||||
In order to be secure from the beginning, when `propellor --spin` is used
|
||||
to bootstrap propellor on a new host, it transfers the local git repositry
|
||||
to the remote host over ssh. After that, the remote host knows the
|
||||
gpg key, and will use it to verify git fetches.
|
||||
|
||||
Since the propoellor git repository is public, you can't store
|
||||
in cleartext private data such as passwords, ssh private keys, etc.
|
||||
|
||||
Instead, `propellor --spin $host` looks for a
|
||||
`~/.propellor/privdata/privdata.gpg` file and if found decrypts it,
|
||||
extracts the private that that the $host needs, and sends it to to the
|
||||
$host using ssh. This lets a host know its own private data, without
|
||||
seeing all the rest.
|
||||
|
||||
To securely store private data, use: `propellor --set $field $context`
|
||||
Propellor will tell you the details when you use a Property that needs
|
||||
PrivData.
|
|
@ -0,0 +1,6 @@
|
|||
This is propellor's todo list. Link items to [[todo/done]] when done.
|
||||
|
||||
See also: [Debian BTS](http://bugs.debian.org/propellor).
|
||||
|
||||
[[!inline pages="./todo/* and !./todo/done and !link(done)
|
||||
and !*/Discussion" actions=yes postform=yes show=0 archive=yes]]
|
|
@ -0,0 +1,12 @@
|
|||
It can be annoying to need to move privdata values around when moving
|
||||
services between hosts, which is otherwise often just a cut-n-paste
|
||||
of a line in config.hs.
|
||||
|
||||
It would be better if privdata were all stored in one Map, and the set of
|
||||
privdata that a host's current properties need were sent to it
|
||||
automatically, rather than the current 1-file-per-host separation.
|
||||
|
||||
For this to work though, each property that uses privdata would need to add
|
||||
to the host's Info the privdata field it uses.
|
||||
|
||||
> [[done]]! --[[Joey]]
|
|
@ -0,0 +1,3 @@
|
|||
* There is no way for a property of a docker container to require
|
||||
some property be met outside the container. For example, some servers
|
||||
need ntp installed for a good date source.
|
|
@ -0,0 +1,10 @@
|
|||
[[!comment format=mdwn
|
||||
username="gueux"
|
||||
ip="109.190.19.251"
|
||||
subject="CMD"
|
||||
date="2014-04-21T13:49:08Z"
|
||||
content="""
|
||||
It would be great to be able to set the CMD of a docker container.
|
||||
|
||||
http://docs.docker.io/reference/builder/#cmd
|
||||
"""]]
|
|
@ -0,0 +1,10 @@
|
|||
[[!comment format=mdwn
|
||||
username="http://joeyh.name/"
|
||||
ip="209.250.56.114"
|
||||
subject="comment 2"
|
||||
date="2014-04-24T23:31:09Z"
|
||||
content="""
|
||||
propellor does not build docker containers, I think that's the point where a CMD is set.
|
||||
|
||||
It would probably make sense to have a mode where docker run is not passed any explicit command to run, which would let the predefined CMD be used. Although this would not let propellor run inside the container, so it could not perform any provisioning of it. In this mode, propellor would only be able to ensure that a container was installed and start it running with its default configuration.
|
||||
"""]]
|
|
@ -0,0 +1,4 @@
|
|||
recently fixed [[todo]] items.
|
||||
|
||||
[[!inline pages="./* and link(./done) and !*/Discussion" sort=mtime show=10
|
||||
archive=yes]]
|
|
@ -0,0 +1,7 @@
|
|||
* Need a way to run an action when a property changes, but only
|
||||
run it once for the whole. For example, may want to restart apache,
|
||||
but only once despite many config changes being made to satisfy
|
||||
properties. onChange is a poor substitute.a
|
||||
* Relatedly, a property that say, installs systemd needs to have a way
|
||||
to reboot the system when a change is made. But this should only
|
||||
happen at the very end, after everything else.
|
|
@ -0,0 +1,28 @@
|
|||
Currently, Info about a Host's Properties is manually gathered and
|
||||
propigated. propertyList combines the Info of the Properties in the list.
|
||||
Docker.docked extracts relevant Info from the Properties of the container
|
||||
(but not al of it, intentionally!).
|
||||
|
||||
This works, but it's error-prone. Consider this example:
|
||||
|
||||
withOS desc $ \o -> case o of
|
||||
(Just (System (Debian Unstable) _)) -> ensureProperty foo
|
||||
_ -> ensureProperty bar
|
||||
|
||||
Here, the Info of `foo` is not propigated out. Nor is `bar`'s Info.
|
||||
Of course, only one of them will be run, and only its info should be propigated
|
||||
out..
|
||||
|
||||
One approach might be to make the Propellor monad be able to be run in two
|
||||
modes. In one mode, it actually perform IO, etc. In the other mode, all
|
||||
liftIO is a no-op, but all Info encountered is accumulated using a Reader
|
||||
monad. This might need two separate monad definitions.
|
||||
|
||||
That is surely doable, but the withOS example above shows a problem with it --
|
||||
the OS is itself part of a Host's info, so won't be known until all its
|
||||
properties have been examined for info!
|
||||
|
||||
Perhaps that can be finessed. We don't really need to propigate out OS info.
|
||||
Just DNS and PrivDataField Info. So info could be collected in 2 passes,
|
||||
first as it's done now by static propertyInfo values. Then by running
|
||||
the Properties in the Reader monad.
|
|
@ -0,0 +1,5 @@
|
|||
* Should be possible to generate a metapackage of all packages that
|
||||
properties direct apt to install. Then any other packages can be
|
||||
auto-removed. This would just be a matter of storing the apt-installed
|
||||
packages in to Info or somewhere. Although not removing essential and base packages
|
||||
could be problimatic.
|
|
@ -0,0 +1 @@
|
|||
It would be great to be able to ssh to a user different from root, and then to use sudo to run commands.
|
|
@ -0,0 +1,10 @@
|
|||
[[!comment format=mdwn
|
||||
username="http://joeyh.name/"
|
||||
ip="209.250.56.214"
|
||||
subject="comment 1"
|
||||
date="2014-04-21T13:31:13Z"
|
||||
content="""
|
||||
Running propellor that way would probably need ssh to allocate a tty in order for sudo's password prompt to work. And it adds complexity. Does it add security? I don't think so, PermitRootLogin=without-password or PasswordAuthentication=no is not going to let anyone brute force the root account.
|
||||
|
||||
PermitRootLogin=forced-commands-only might be worth making easy to set up, so the only command that can be run with some special propellor-specific ssh key is propellor.
|
||||
"""]]
|
|
@ -0,0 +1,8 @@
|
|||
[[!comment format=mdwn
|
||||
username="gueux"
|
||||
ip="109.190.19.251"
|
||||
subject="comment 2"
|
||||
date="2014-04-21T13:54:39Z"
|
||||
content="""
|
||||
I didn't knew \"PermitRootLogin=forced-commands-only\", it seems great!
|
||||
"""]]
|
|
@ -0,0 +1,10 @@
|
|||
[[!comment format=mdwn
|
||||
username="http://joeyh.name/"
|
||||
ip="209.250.56.114"
|
||||
subject="comment 3"
|
||||
date="2014-04-24T22:17:31Z"
|
||||
content="""
|
||||
Except that it led you to run into the failure mode described at [[forum/remote.origin_not_copied_to_managed_host?]]
|
||||
|
||||
So now we have a concrete change to make: Make /usr/bin/propellor work if it's forced as the only command that can be run. Including making propellor's host bootstrapping work via it.
|
||||
"""]]
|
|
@ -0,0 +1,7 @@
|
|||
* Either `Ssh.hostKey` should set the sshPubKey info
|
||||
(which seems hard, as info needs to be able to be calculated without
|
||||
running any IO code, and here IO is needed along with decrypting the
|
||||
PrivData..), or the public key should not be stored in
|
||||
the PrivData, and instead configured using the info.
|
||||
Getting the ssh host key into the info will allow automatically
|
||||
exporting it via DNS (SSHFP record)
|
Binary file not shown.
|
@ -0,0 +1,439 @@
|
|||
-----BEGIN PGP MESSAGE-----
|
||||
Version: GnuPG v1
|
||||
|
||||
hQIMA7ODiaEXBlRZAQ//aeJpq25yXbayk/fuqQZITiC+BVuslYxKMo0lBC5D8d5D
|
||||
EkTAEvqHLUip3Ikl3nTVDMabdisxzAjwl6nDBzUwTMxPMAh89gOOwxmsfFbdioGn
|
||||
dbKweCAuZ0qXZGo8viM8ZjA9kag3sOQzqnmLdVa77Fj8WnfNEsEAFXZFU6aXLlG2
|
||||
n60+bhdo5858uK1dEItdhT0I2gi2SOEIJ3ojRs5jvV94X6+imSfpgrp9hwKBrffK
|
||||
Ao9nL9e15KHG39wx/ZgBMxP74HgdQsfmzdRh1eW8hqj0F4SnBzPoG9x/cTrufavC
|
||||
ZViSTngiROE22iEeAFHnPgyS1fo4pD1Vm0CxpqThhVn5yaEKBliRsOtOP3wIlAXH
|
||||
7YKtSbBlHx1d2jRQdT4y3S6f8BdP5feYXjOj1BO8AvK+nJEcU2YhVEuhigXgNMDa
|
||||
kbOTB11DId6WkxORvcVmXM4mcSESTVerLdqH2otpa7dxv+EWIj3mpCxLIB5w558T
|
||||
0gagUVobw1ee8y6FxktCj93KE75AjawvcPqub7Yoc7J4PdzbrGPweepxjtGcgi8L
|
||||
WNSkMzNk5d9wnm72TopaTQam5g5RndgRL1o4yqgchHr3fdzmA5CfACxitXTUwQsV
|
||||
sAEjo9nelmYin81seJalwLFUr3Uo638dvu4RjZZLmm0HQ24RIFXPBsClY9HAhAPS
|
||||
7QGPa3cOY7PkqS6gGA/ypN6/XkPsvq0QasFZbnQ26F0DQnvLXQroPFxeOgz9CG1A
|
||||
WHXdet0KkYB5e+MRcnDTDjOwfPlaxCzSsduwNR4tMqVuZ78gDbMALUH+utYL8pUY
|
||||
FojAnt5nigbwcEN0vaUY8WKTrOCUv4nQiu6jT/6YFDWRDHPVqytSA6rfWew0iO7j
|
||||
K2VbqSvOq3EkD6Yi4N2CNH1cZKo13eQ17gQ1sIntOip1YYbUDYLml0vpfXMVRGb2
|
||||
1ed7SR2xmrMk+s5bUtoNtX/IQLB/fcsuCzRmBQY+PJKkRlj8lW3t8xTNheGoTu6g
|
||||
EmK/LIf97PrIO/PzEDAjrHGD46V6L6qukH97k8HDkHNl7aox1ANYj5i/Y/DR/Jdp
|
||||
qP3rtlmiHgpLX8i375JxJqGkIQ+ZzH1v86HrxVKFsPS8A7lILVkFkvI//H/TrcoV
|
||||
KaF/LdOqQsd0OuKd0Gs3gxLytjaKHxK/AMHz51/VAgOZ11SfMvQpZRdt1D6ygAzl
|
||||
PDdb6Nugu/Jt6GIe2hDmWHhxbWvW85sGxJft8tpZPvRNPolFnf5VjYluQSQq1JAl
|
||||
QAX5RE3yY6ngW6KRmSbfWRFRNSXC9B1lxQ0CDgIPaz96KrzAH9M83Vv5RPQSICn7
|
||||
8F+t4YOrZrg4gD5qMT8sHIrBkvognvoT60ILz8qTR1Ou2w4xPlQUVPIfC1YCOY30
|
||||
gNo4XsrsjJxMtjOsx4fr6eLCaqzSVm9/gcxMJJQqE+ukPVHlX67WrDwEufBsSxZr
|
||||
Dx9ZkCoiiVE+i4UiBztmd6r68yWFMNT2d8VHw66Y1IbLNZS8ZjZqo/OQtQwbnCnv
|
||||
01Rn4xpBnjasMClGOBt+gNbpc6uziTORKjTLOIxazoVqoeWekM2ELrFCvpGS6YOz
|
||||
rZr2psYRP6TO3AG4+MsqkK72+YcMMqtAnq6IM9nv3wEddAz7MQn9VLc+xGYbiXdX
|
||||
yfEQxx7Gc0J6TJnIzASpRiwbpPlGvE4DtuFpigFzjjnyms/usj2d8HrZLhiN9xnS
|
||||
q9O4ODIvEECGm2H6/DRjCbLPbKpEMqFu4OLW+2lUW9IK6YPBRJLjhepLHzEHZDrD
|
||||
FPGvj3X3psMsT/nc6v3Rj+r5GqQeTySEBPkfgon5gs2kaBFbmAlzdOEimZJXKnC3
|
||||
zE6c6WdpiNs9tCNvxzkEu4TGk0KOE7NvVEgEKETMjTMYmccoueZFRIM0cdzg8s6Q
|
||||
Sx1KeSHjJ7Z1L+aIFLZ6UyL7pFejjroh+1MzMf+ml7hLt/mrOcg2f+zm+cgJUQzy
|
||||
hoMxXKNGc8w9aIsjSWcPhsuLJZLSIG/AQdd7fY7xJDIJ1fd2osX67ixXEiydz8BN
|
||||
DiDlMVkNKzQp+r74RmNmJpziMBMtzIfHuk4YKmqS9EKiAMn+3APsFr/adyP+RBE6
|
||||
qBnvnDclbqviLkiXg2b6eQ0NZDN4NTEq8I6BSFKXFxoSJzeG/GkF8SvHUQaAHkCq
|
||||
EmUxfMYw8cbQlYeRl/gtCiWz1WH2LBRulZvHVfiUzqjFY0GhnJzpLo/Pwjj2EzYz
|
||||
+kONv2jdLmSa7Ub80XzngODjkun0xwIWCjMHa2F7GioZwyYSmxP2UiCCGAnOzDsZ
|
||||
J/x7Y7/QQbDAaBQwpLPu4Ozx/7rEAxoBKTqjUWJ/VaQ+jrOhWuWCHWc3WIOo7YXz
|
||||
HUK2kkw/7z7+l/I8w/RkX9uAxRIdD4c2SOAiDjK0EHTk0+e2bSGr4AMLfbtOQMOz
|
||||
hiLLeMLXfT6uH/Dcp69URnfwH2h2CsRRK7w91/0gx4W8maxKbJXOXX8G+q6mGHZa
|
||||
G6CPprGunt1Ycnb+CD0pmuPl8+4/jlkrz5vp0h4SBHEf47OgqwEuhqIvBeFJBQR3
|
||||
nccoOyNPkmFi131Drl9W+KSBZB6saXgOBqSDs/68zU843N9OyFLcGZANmwvTuA0S
|
||||
LXom64j94cYrt4kq8uI2RYbNqxAGie7q593cbdnlj9nY4/tNolrphTiC/eFi7Ksr
|
||||
113g2B2kvoH5lAupBr/LVUTMiit0wEWLcxTCN7rfYelcuBakRvkJwMu2UhG40EGQ
|
||||
tMrWeBpJr4MeupSqFOvvVZwzIU/zA3X39cQm94SPv0N2gemeWj53IxzvP44GBENc
|
||||
t7pFgNnnvPBCn7EeURviumAaBTWppTl77mz+eOlHdY2mnhV6M/3Gbw3PCflVQ+sb
|
||||
r9Xvjhk6PZ3b0fQuQI1Lh8wWlwNDwJ9KkiIW9nfBYVFguKuDAwq/1P994Al4ae9U
|
||||
C9XlhdNofWO9FhYdv6EK4lHFtsu8kx/Q1ilBTqqSCpm70ua5MtSYd1+Qk1eugelO
|
||||
gvD3Q2GCIxhzd/gEIJcMpapeGJrLhr5YF5w3kInI78vNbZzESPZzR5pt0xzO0odK
|
||||
xtYlXOGyc6bdq9pMZXLOGfsiom7IY+TZd1vRMKSbjuM2cFODSmwJus0/R0fSqL2r
|
||||
2qhrL5bxR7v2mV1DM7mBFdFKSOVenrnX2QOgmZu41CoDyBXi+Y0Nosemjk9PTqs6
|
||||
ZQFu6malOyvWpOcnXNc51gcHDtQAgJ3efky5h/mXDem+8lWKT2zGT9sFN3p+6/Sy
|
||||
oMJ2/Uu+XyaxkHOE8PW5qYFLopwkt8vmPBTmfT7368wVCTmIbmyxW164GbL3N0oE
|
||||
aqM2/QnVLYXzhv7WXaPNuUDxWNeXhyoN9zZcDaeBYyctbLm8dFTEEbeZvFF5g4+U
|
||||
ItTEZd0+b9DycF4C5Yw3wieuKFtzX3DikJ07i4TU0HwkFIBXZDDGMtsHB2DUvpeK
|
||||
Ijk0tIVDyBfambdm6Is7OKtpmuHhPhtHZVPA/GDK7n1t1csmDV+HnXF6w6oRfsbK
|
||||
aAptfc4mkeGlijFxOCS8DWLxKMXF3PhWHPQZI3x91hhujUDe4X8kAvOA+k+/iwbL
|
||||
ZNXTXaoxbVLUaKLm8Y9PKNW63WzVsC8zgP262N/o+eJ+Fq+HJnTzsWAUDHvrV2XR
|
||||
hcKUVxM9EivLNwURHeu1GrWJ3M/775Qyo+AB1eJ9IjPPLxM0h7LJV8KYyku+GMWn
|
||||
P1UnlMlbqojj+qPezn2MGZggP0Nh8dD9HbFbFNzZI0MF8OWNAsvHD1F0IwJ89E11
|
||||
Kkx4uiQW0TEY7oghIUpRqKqsMIdAhfFwHTzkqDmXcu1JxMayAteAclTmWiuLapje
|
||||
Z86RLF+d6HPr9qIluOJPONYsA8aFp9S9xqJ/PWcn3BRXxNJWv2PREo/TnGVo765r
|
||||
hHfiIj7DL8kE3TR+CWg9Y3zjhpScXaqmzMbU6EhS01EIdFLNibEh5sKyqdzhMzxu
|
||||
8dWAASbfzWDwugIoTIPPdBixIAfMQYFjUoi6SBaZ1peRVvBop3tN78WD5Ql5Qw4n
|
||||
LY00EKpXuMPdS/2XrFXmRMxWLqRyIKYaGgNP0dGLMuvlUgHcl4GWGjIkEYw7jQen
|
||||
/bs6GYTmrciXLPEWarZtv0qYMHENWvWMYWeTgstSbvSx8/uqn6tjQhywOkMoAOlf
|
||||
WxVMqZwx94nDC/+6RPiTXfiD9vJ9SduLvAk989GWndkJJr6ZGunNtQKap+EBMMpW
|
||||
HoLW9v+Yp7emm5uJPgvho6a/aTFeXQ7UsEq1uBGRxrRwaOyxlRxyiLF87upbiN4D
|
||||
Ngs+RD792PsCiex45taJPeFchDmFQLjlj8+mY8sHOh2OlsfpIl5qq0CtU2Jr4RN6
|
||||
saXnQi8pKPW1V1sOvYcp0/vTx2B7eiIJP0JHxm4SgACU8S7UE/Avqkb09h9EGIlq
|
||||
EPaq+wWOk8MnLW4YYNPDUNdTnb8iyduHVe2o6HwI67rNsstKpeaKudiFM6vFLkWh
|
||||
3uiRoi1ZFYH+Y3vd34aSHV3K65h/N+Sv+X+6DP03+vZ6zg84mveHaOyI3VLTpadO
|
||||
QicabiXcJpsU6trG+C/5Q4Z78O0Y+ZsLAFYP3Ro6KTpnV2XZKebHNQMfMJ3bClmV
|
||||
2YIxDP6Iwss/PEUaG5R6Cg0YWcqzU0BuEeZelSpvOsfqh97T+yf73v108nz7CbbE
|
||||
PIXCnf9uYBF2lDhO312NjfjkkpV88QX3OHqOMuIX4ULK4xIXMTm+ZoOI0RjS/VhC
|
||||
5tbaE7rTH6L7vGG8ZxVSNA/u4QeqHTACJ18DhiPWWVnbeSWe19t2DWSU3+vFJiec
|
||||
TsegBPogtW7KRcWul3eqwPvVRd0WtE0EHeh/vWKVE90VmPw7SfTkSAW7tl7//yt7
|
||||
83oEpj6Ze3mxQ6nXFDX8zwugClkIP6E8cC63x04ObKUaSIrAYBfgSlT2UxPg9MJk
|
||||
lbNvDAjtar26ZmP/6ifYqhHQydiZoypN1ccMPjbtKTrmjY9/ZfKpB75KLRj25ZfG
|
||||
2PAkcLHPRHDuhl0T4S+w+Wye3ollrO3OA7pI3TvEk22fS1GNUjmphUhGq9/EFVdF
|
||||
D6T4e+feVI3sqepmOge1GgCaBrUEpt3w51p20GDLv9C/DfmIrOlZILAq+xXH1aNB
|
||||
7QZTMzJ3RmPWvPrZTusic3ah1jO9vP2+WkB9DxysLp+DW9UVmW8LkVJsLoL0VuuU
|
||||
CwBNoSKmIiWhTr2b+XUr/GnIzsssjQkalGDXtobDYz/LvQmMjHc2QNH0dL6GRvKe
|
||||
33in7A7VbswE76Pbuof/OtICHuPI3fg+SlQK2vKLTFJOyLKKKvUqK1ZtLGX86IDq
|
||||
f71oJT4MApic6Ep+Cd8aGsz5hFdy5KfRZX0rJ4+lwsCew3USh1GyOK7/a2EoPw7E
|
||||
iTVmAQ2KVWjF6dADDRbmLsoTT4eWLb8TOlSnF6LCAe4eCwcmgRLKJSJYhkpp7JVB
|
||||
e3g9qRkLzv6ypRJD7GTwubVyJJL7vW/c1v8PokTHYGfn/cM4r2iZTrxDiMvk1+0n
|
||||
1HKA0jhco5gjTSrah8gBFD496VCklhLr8kqcxK3TGZgim0KstF2drrnKtT5xfL6+
|
||||
8EHY7e+Z1AdqYj8bINOKDs2x1rWNMZEkhxn8GUDodh2rE7Gfide9PARrZclwupo8
|
||||
0I1MmzxXCuoXSGMAoDGRRCykjEbeFmIvprBO9WiP9SC0ruhg2nEElxlLuri4Uen8
|
||||
nV3Age5IVcXLHl1Tsruc459glWmXY52k3WaJk4Up+pk7KpsTVEO47O11tYwtFBR3
|
||||
B4HRAOTWVEA89iXYTVlYFJzzrB2KEFJ1qEZHdLxHhOzLKjaXKFNwJikW3oAvVpPp
|
||||
vOX3dgNPfnUA0vZoczEQW/A4oSPM21vTqcOs0tceHQ1pjE5ZL0iO4TMHTwbeY6cl
|
||||
iq5SR3rC4O9N/uTYX3DWPU1JY7ovqMqjokDNkMOFHoN5AUsCMxRXj5IeQOP7jxyX
|
||||
CTIbr59HfaC9+Y7w9VpNDW74SNxjccbTA9tUgfBX8DtCGdF5sDWpBo3JOD1pmZIu
|
||||
EB1aoZbRnwKvv/6I7mFfeBV0CojwbbEaYhgQYX+l13KIuyonIFybEWUUVK45LdtV
|
||||
pLoOyh3VgzknPWNqE8NTyfw40DIlkIA8i6wvRpAw8kmnx9Pdg2XuMEJYYb+CP2Sj
|
||||
nR7asXXPsyWdm+qxgJqSCxU7RupFD72sereADF1rIgwU+UFiLCEIoi06bzAS0QDe
|
||||
cijeTI4v6ZLr6lTjeXqoNcJlYaQZvH5Sh3RWLcR+XeYXZsstRbpVDITMb9/fAKMv
|
||||
ohu5DeGEJnx0Da6wdOW8Cz8xtxe+yuwxkqyd2lVB77bkzYjfWW26LAKhVVKiEyR3
|
||||
QqJPF53TeXjh4RDxrQF5iYJkBJ98jPAUxGaTzupDTxIxVMRgKrNbK/rYmFCyeE5o
|
||||
DAawqg1/NPISUMjgHNijCMg+dVPHDgP9bRdDrUPCimQ8mfmum+1gS+kmyhxCj4op
|
||||
0TEB/XnC6QlTrK/kCCxv8q2gSBdR9bA95LkWBtHkI8GTDhnEWl4R2uL8DR3y13wt
|
||||
dPe8yQgQIY41UZEAQzBu3Y1hBxhLlRRcPtz4/C4BH/8JqVasZe/XA3J9As2dmSZD
|
||||
7lGFerfkHVMAoworZa8qf941JxWue7HP7kweos5KsEbtyHhF86Rq2l6DiUT5BWFR
|
||||
Pwge6+rK39jSnqSGHRSASrE7/M9ZTD2f7tPHqUnrLQcxFfjWE3DOo8muwZOYOFWG
|
||||
ZpzRli3k9pvtQpfyrexJ254OuKgvViRWmOQgrbJEsQ7VisbwGLalLUCr7Oi3Y/gV
|
||||
EV2H9NcJkhXr7S1ObXSPc75j5q0wgeV57bSgsMIbNqSaVeIqL2ncWH4Ga+VFir22
|
||||
BvHXUcMXT+FyKq+tUHK/Ot/qFmS0D5Y/QvXg1xDSg7zEePA8NlC6sibYxFklh6qE
|
||||
PgVnJ0PTm9dv3hDcO1NpRPGHi9fbFJ1oy4q7XiYOmux2hDM3+dkJGkGS4+Ir0vPj
|
||||
+WrQ1UTaKf5GCSL5pUP/zc0BsXlxvyrQ8Eczs/Nk5BZx7UmT8NlK0RsFqpGV3CG6
|
||||
VyEjVJ4D5avDV0P4zB4xIisLKvGbM1GcQp8WKbMjzuOhueI3UzpcpgJPzgjgdayE
|
||||
bz0Qk2FgkwB0oxHmN4fEzcIFLk4t3OzVGcP4uSjEJsmH33jAS/1FhNd/8FJr0dtN
|
||||
CWkPhZmc0PG4GtLcBvgag4nvwY+9D3Hgl0o8FpV/nesWAl0ySVxhJMM9Y/37TQyl
|
||||
fLDgmpQjYLshUfmWWGYwCqHa/Ov5PBITuPOZWK5kE0bIKLTl64l7cd9A8lMYrMe/
|
||||
23bCPxZMe5ZIInB1EP5jfuiAVFbSAu/rPlSQVlK7iXtrYTC0pSNsuVxzpU5unsG0
|
||||
+tqKE1NDBTJOVvmiw11bmC11HIdl+75gJ+hWnlHs78o5gJFuMpJsv7koDustEkJx
|
||||
I/+DB0i9s8De2QGuy1dpZo7IpitvckaAQIFQ45lidaAaZv3CT5wxEhB5Sl0kbrR5
|
||||
tguQ/y50S/RRdklx2AtocJfnJVmR0Pc9CxxYPreHx8fC3uVV6d026GFnUXRPlWKW
|
||||
ftiyL/lwGb0iEt3Y5K0CUucDjSi0iCNEjx1J9QBXc8hg/WjFih6egnvrvZWx8J5B
|
||||
/sc4VukW4kHjs6ulJ+cg/by64uTc6jmsAR9vzVC7mIJPfWp0f7VABrPyTEmcFBJd
|
||||
5eoyPUyGIu8C5rnOBOmcjYM/NNEtx4EqukVLha5YZwbVGYa+rC+xN07NNLQbFvWG
|
||||
RZVSyt3pVioLfjQ8faHHRIu7qolrICvLP7LaV5jyPyrKcwpb46IIYHOk+/iJ6MOF
|
||||
NsUjPJvfraYoeRVqpm1itIXCcM1g7uyTmc6Fg264+LVAYIlvLwCWlOyM1QeoqBVG
|
||||
PL+k1xY50jwg5hkejFRDaE8I9+0Pa/bNF/XknDcZRv+sHjVpTU/DMEIN1jK9TM2G
|
||||
SsltNHQTzYgKr3kYL0ud5lTRgSMU4tA0UuVOqn6OuObXeswsonfU2fqvXXrqE+W+
|
||||
Wofr3xJMphG3c4cnMmyDjUVOsl1AyL21ZB0R8kCqBDJLG7yyVTHjf/avpeTUfZwx
|
||||
HBIpiZKkhdVkFo/du9wO0CfvHB89l8VnK0+js2OXZzDwPB8KCWTO8VllHAosqULI
|
||||
Cp/p7F++Eyq9PKg6vOw43ZDbpKBoacHUgLNFd5OJMScQdKSGDCZtT7NRXzxGsoFa
|
||||
KkxMCc8VMN3hwjP00EP9cHVfiqQ4d65lDE11yK3IQsBOKaF3q59doHxWOBH3NMPB
|
||||
g3wJ+dEFDcMwwhhkbIjNPkROHeUY0C/6L7m3DKpV/44seVk6EhsGGNpsu/L+nDvc
|
||||
pZwRmpWnioB2QTDbs21vTfr8iI1rh0bO2Kc5lfFXEvZYVxMizrjdPNCSty3aX+oy
|
||||
e5oeDUOXafHSZhtbgrHEWXSzZv/7/endB7/ZYkSx7/5jBFsVZcMdWHnP4dkIBtLz
|
||||
gTimwG5XHWiIMs1Jsunu+BUQfzTzTGv94o5E688XtsZRPYasb2JRdrDaGFdW8P3Q
|
||||
w1bxyUMpqh3GcsD/d88I2HQFZ1Pt/4IBF0ooh8WZFurZtX59tF8eaYLeBBEkIKX+
|
||||
N9KHxNZHcXV8sCez8HUFKzTm18m2V/PeHxV6zQ7wq20MEHbq3EjrdVme9/iJbHjL
|
||||
KBmqztjnkb+ux1QTV1871W7B+Xx06bnvBPPI5R3GvWbN7nY227C7FtMbQg6Lrgxu
|
||||
FX5ARg/QhSgvTzJW4sOkZHYx8qDFbzovjWJxtsEGwsUnlfvAnL3FoK/3lpH5AXNW
|
||||
mFjprgSYMZFRGuPEbUHd7kROwZU73Lazzu9vOpVvGaBYxz1U9JhK1NYyvo9VBP1x
|
||||
euTv4yMGek7aWyICeFOZZqHa4OVymwN/HzHEzxaRBQ67garIbTzIGi2eDLkh2qFN
|
||||
TzDIEAV0k5SyiBNCmFFYi2/qXhNRFOkz8BrlUGoB5/s/nn/aWT8Ll84TdxzJLVfx
|
||||
atL/28krtafQIb8a6VniGzy5ij/wL+nKLzkNaGxvwOLVD+CurdnvJVOkeGatmhfN
|
||||
AxDm5j7Hxrd9rZfblkyBbo+tarLYaCwc0AqKAEfKiJse8tOEPokJfJXeICwmCZJ/
|
||||
ttoaEEKkRpJSGSQxwezAz8QpkmCxW3wfBapJKOtNJLR6iIKxqa72lzIM9utV5tUi
|
||||
n4sQh9hWMgb0pc8mx+MyEVjScN3f47IQqh9BSI7xadl9ZnKXPPc+SFqjqZAHbum6
|
||||
gWYLv54sIKu8g7sAPbXfxVpWK8FR7d/ODWkwK4L7v3nMFre6r1Y/QnX//ZAvX12L
|
||||
LFj5FI9iS6RCeU2pPetyD/crxWOgzsJG4UGuC+6nQVBN35uGgHOtMQa3NedWVB4B
|
||||
zTd88JJIylpAl5al4cIQ8HXZvMgOparfYAUR7E22jkg8+ikLTwmO7dnmUI2farQL
|
||||
THksb4pB9P5XVAWkq6xhmXFOlrK/jm1jnmfxrLf6Hs8Ef8GTDXBcNLrMnrCZLMvf
|
||||
hrL4Ou6zPz91dPmSy9fPExUVKut22JIefS4DGeUgEVWVGUvxb5hp/ZvQ028/VQA6
|
||||
D+ylOL11ZaCW6elpJkcTe5KtJkzM0+Q41QycYLdLOkxW6um/60wcMSiOoDOC0X59
|
||||
31fQsvAPLFiCGemnN7euge3cwsZjgBK4CL8wmQ7s/GwzB1WkJ7iPdA1qIUqRXuYa
|
||||
0sB66fGx/12bbW7l+Waj/9GSe7Cx7PL7Re1EZOhy+n39PWmKB9KeFmlmKwd9U5g7
|
||||
cK1V62wuPn9M+0bbXpc5jzHI9C85PyTJ7iRb4hEFZG+pd4ITEG57EFeEd2/+HoJr
|
||||
vW2OBFEnBSxfU89THqvIZPVhpsS/eo/7liq8P6MVlkEC36vtiUgC6mS36LaRGSMK
|
||||
LB3EP6/TAXz39Q0qLll2dT9Tytn1OndC9MdOst/svD7QcobH4UdzdjITiPhXEmYK
|
||||
1M3augOGh9NOO/rd5i1QATHOMr8meazQdN592tTdmP0u359PoM/AYXnZjzSz36oZ
|
||||
+uz4GeYwW33JAelM/Eva+stf8D2t9jrdACA3PG/bammASMQgK5tihrxnRC9s4MoO
|
||||
KyOCW2V/sZWIR6x/3lId8r7g2SwfUf6QRKIkcz6CsqR6TFGhOfsAOz9vIHVr+Q3Q
|
||||
8V/ZmoVoyKgGlbsXq3tc8cThYnDl/WdcUT2DFIZxyOJsxIt00mo3+qnHN4lQb3Az
|
||||
DLaPxefTAENXQK4lce5VdkwIPCOF5TXghpS/BwP+fY0ECPvhvLZ0UkHmdMr6frqx
|
||||
1IzKF2Dhs/un0sZYHTFtQaH9/orcDe/8EfyzpAFXN1tBf1G8is2tX0rW0W28LA2O
|
||||
EUNPc+T6dtPVFSWuj0nBkEUxBwtU6/1o9RmkRqx5JFnJFergALwShQIyLhs8KAaI
|
||||
BQndkiGpZfsM454/boaBe3mgUXBHk62CeHb6DtptV7tim889kpAocv+kLqYSAUr4
|
||||
igUX/07Dkqa/TdTFiEzsiGAeBY5UeLN5KLuxkSj71cS7F9rQhbDHMc67YuIA2Jft
|
||||
NjQBZB6RwEEOfhgpenHlLBQNMaBpAb9XGZbefwBJc3c3kZmTR8idk6YRYgZOHYcc
|
||||
h6ocLXs6AXzu4D55uzpa8gT0nwop4SrcTQCINo0N1TsEH4Q8AZh/uBqJirCB/tNk
|
||||
eXbUsKUloK/McpWvQJdDtqRNFhYVwALANk9RQa3SQXf+AcbMbRKD2bZ17Lzn914T
|
||||
sbEiVnUFLDPA1DcJc+yfr9jrY8AOqriXpguob48XfODmhsb6+fzpRpAaY9kOuu04
|
||||
WWddWWcYIgLmD0gQPRk32NmTHhQQ3ngrULFS3Uklhbg9qi2C2lBgJwlH42W7lVen
|
||||
zBqabgdivz/ojc24qDMV91P+MEk7VeSs3qFhz0jDcQNNtPbq1VnLp/dHDVqC3x+L
|
||||
faUVrZ/jwpeQEJx96VtHU9+4mx5OMEtb6uosFwCBa0EsdtimF3twpTW3WedTiDHZ
|
||||
S0ZfcnPIqqZ6gHMAwU7If8JdvlMq79G4rxYpFKd0tSbyKQm8zJO3fIn2oRS62Wop
|
||||
5eUyigVB5XltTK1jTzJcOvDc4skh7GxDQUtDcpBbKxpze+hjjt3loNKIRnn9Kd0k
|
||||
/BgenFgID9ujB0Ym4h5cjeZoSHanE3PBLFBO88IH6PBjEErKkCjomD4h0IMN90/0
|
||||
2g8yYwKFUfKbxeTlVYxGqdBXpjt1zbogeyAafzIs7rJlXdjARYoi7wo4GzPgHvlQ
|
||||
EKA6aAWo0uNfmqhQOyT+yV41BDC+B5/HlxDNY9KCqHfR+wQbqqxwNbxm6oIH7Sax
|
||||
DSNV0pYsroo2KIOn+SaxukY82wvj1Jp8D8hkyS7MNnpVlHgV58GbIurGUe/bsBxa
|
||||
cNEM+DynNxZ6BYCZthiioSjCd/dq74WUvrh35kpnYUmprZH1a4ihbbUPauDCuo6k
|
||||
jRWw3GSbycRF13J64iIr8CwmhOE8XkSklRIsTIv7QmPg/wIMlHX2DMSDV4QqVxeF
|
||||
kI/1/a7Ef/Wxc2L9U+bW4jxcdyvN2pDs3B5WsACN0ari1JFoKAtSe9nJJ+LLBcrC
|
||||
H5Q+jagOEc9y1wHs4Rj8Ck22muIhusOOHF6b2hDJBgnwukewUxiicKd8Z99PIGIn
|
||||
yBcAJ7b64biQLFLRqZLD4t/myp578Cg/0Ic0BeQw1I3d7VPhkI8L4ge3Hz8rbegQ
|
||||
bIvzB3YFUptYpubP3yB0/zWo4OrWT7FwvtTvajLcHa2HZONpRP5SpXDG2FqGVqAJ
|
||||
R4W9Kk4pu7wOtFkh1viA1dkgltYZhz71CAUrpSfFf0DlPyf6BggMxcTHs2TT0Te8
|
||||
dkQaJxKkXrvEppCJQrxhamaeRliyje4IFL85ROZK28gH/Z6YIC18/JqphNCjVm1V
|
||||
s+zEZIr08hyB9gVhkOWApUA4Wz7jvAeIWQiVZg4MxyYr8o7yqt6619iBiNL602kf
|
||||
aFRw2DDWy1vHKTdLR+ldm3o8dHgF41k3BSVt915kaBLf7awpyiic93d/uOxyO4Qh
|
||||
XLfMq3yFlbdg5vAAHhM6V93CKJIvem3njcCHH7gb46s6EyHqAhVNTL5HmmtmWx+/
|
||||
/EHRusq8Aljx4yXO0mMw+E/MGaprPPZ/Vrbajb+Sa/OKUu0zBGEX8nQTEyRCz5pB
|
||||
OmlUBXSAlXDxeL10urj/ZrmRzaTfedYL4/tH0Z87JuyphuDk/7yxm5vM5cV0NP6K
|
||||
WDIHkX2GNBqjGLm9FXXVwDhbJ6/rnWZjdNHqT1UyvM1u5DrKbLqwbYtGOxvJwmC+
|
||||
UsHLOewDhHIusbHjdFMh4YZ7jURR1VCGc5mr9OtbEBSwI8s2zroKiEhxwjlvzbI3
|
||||
LIh0Bq64GQ4PlMOwc8++mqlY1jnq/UR/Nf1zEx+b/fBL6PJb6M1cpG3T7sq+habl
|
||||
61IQdstNigRQdiXxgxmqQ5H3T/r0HBCIabThSS2jZorjK6qyZOY/onTnxLo41NUM
|
||||
V4DHMht/pqk6qszK0v2bdb0Llew23JgE0BqKgoqAAbUDrjdN/c8Z1EEp9eHIZPOH
|
||||
sl7GIz23OPggXUPwcay2mRYp5PJfCt3yOmAWEjBGv3Tm/gcs0vNtCmNvFr8yuTI6
|
||||
5zAlDx+JBdKMPewTNQ4BdtRGM1aBm6dEclgRJ+Mw2WcuhqJo35YBdthf3GtAfvqT
|
||||
9pp5+RN3KcUXQfsvHOoDf31BElP6sJzzQdDaQt2yEfZ2O+dFZ8iob+8lGCp+Xl5s
|
||||
ROOVZy669Mn5Y7ZMsGEmqppU9+dGjrnXYwQHzTZvGuc/9QPe53L+cplfEkA1b2Eq
|
||||
4mYadKChYjFkLViUfwBC53tzbbT31khTMM7nHAKyubEjOnHukzMVHW5Ta1a++OQT
|
||||
3SRWjKGMW9O+nDbzH3CQMfuCakJpqzh/TBvWyowKxpCcLml+Hw14XkPHFdYJlrG/
|
||||
AU19YTmlhdysXEradLbVxgNhqK3+QM+B6FEAgHwDEFW7SyOH7tqwtDuO0ql3lLjL
|
||||
DF/LDEKyzIud+Jv0Ib+XP4v3nyj3pCg4gtATOdo/XPPppVbRLjdTAFDTsjv0f72M
|
||||
oNnvRAvlyDxYSXalRQ0wKK6OeL5rOtPDFj2n2McmGWx+DExC+hkdsSa9JzfrNibT
|
||||
KG6V4DEjC2sjJEDXxuKsLxaWtUwXa2sb7ttDwOQ5BBR1IN8+vznLl4ygM9DMdZX8
|
||||
mEPFPDwCYWC5yPwiVnYU+OdKTlcOkjqTO2EX45pB4vgYdjJcOTteIHEEAIM1o8QX
|
||||
w0IwGoBTWBRzYUw8Gcde/KVBH0A9CMV9qe9h3+9blRhSpYW/1vkoO5EMIEmn4C9T
|
||||
k3fcM+e+3TIF/1eTFbYPTctGa+RrrGz30PReXQ0ukyL0zGWzplPQxeqKUpFA/P29
|
||||
5HhgFYXgPft5HlI3ZYZ2vlTLho+mCwx4p7M6WT6c88vMXx48N5OAlafzGP/ClYfb
|
||||
Gv631Zf/8fkQzx80xqwB8o1E+YLyuSsS+8E55s48XZ/77aKA+IrWK9vUmtFacshU
|
||||
cVZlgQtL3vHO1EwkSJSoQwEXJ0rscIW1YqKAAQuS5QhZl0CffKJb6V77oc/tyhxP
|
||||
qdEa8wKvF4TKBtQHlyCiZQPt1WR50k1QmjU9wrynq+MFHZ0FedQ4wsnQHbUWNvjt
|
||||
Cr+7lLaFXZpk+5trckiMVKBbpxHYcwW7mc2RI28es75GGQKuaEMJ7riIw3Nxllkx
|
||||
5mvIUlUy3d6mEAsjB3SolI9jjlg1RgKkqnyX3E606XNaTrTWBr4dAnrXw+GqqAFt
|
||||
2G6/G5V9ge5ovbbhCzZDJcz97mj0OiVzWR+R3WE6RERUqvMKso8AnNqLAi7YmWQK
|
||||
8aRgXKkJiSTTOJDIFfi1XXilJhH9Ek7rfyvy4h+6xF3U26W0sIc12eV2HRgDqAJA
|
||||
1MAxPIc8HytjLoCtiZEfBA38JkbymY/Vfm1ZP/LyZpEGtLX6Og6bcrLKTvm5C+gL
|
||||
OYXKIf6eYfV6BDhjlyUqkHf/sJCpWUyfAuSVFhu8CrO3S4dx3dPuEsifSptmPjKC
|
||||
HTo4Rj9SfZoLCwiX/L8VFOvanU9aFSLmZjkuymS/6WMV93UlfbxvItKTcyhmuiBq
|
||||
nk5ee3P0elLSFe56cvC9D1AcM4zIwXcfmTxyIzfigXrp53IyY154R5nOe1NDjnVb
|
||||
D5sm6FrfKvHIhUU0E03ez5XyFZccwc49Kj640R9JKXa2RMXav3f8xlIctC6JzCJJ
|
||||
v8QECi7m5plkKszvl/7HEMfS2r02ph7NJjcb3Or/jTG402N8+23x/IpOh+HJK5ee
|
||||
B39f35IIDd1chF0sHulelIIxOQi98GYffJD1r7ygONMVmhEAV2P3fV2i9pfOqrjV
|
||||
QCXpq8ULShb3lgAKm5JfjSOTkwRjTIE144gvvIO7UuVjFZUYHniXCPT4X9ojnQ+p
|
||||
abNxf0mqqbISPgUL9AUxfmkbnsBskIAp2l2eDqrSYxvyJ8F7UprbtdaMTXRw5PJR
|
||||
j+SSZbCoIS4HB3PUZLHly4X2xvr5ZJXBp3eQqQ4uOlrN7VqH9MV3l9FCz1XTo80v
|
||||
5esl1B7In0poQqI2kYPyYrC1fV9tZsb6j47CDELEOR+n3U+4ExBwlWkj54FGFDiC
|
||||
SPMMyi4PwMyFlvO/Rdyk06bxS6siAbWQOS8ajQI07UZRCm4kEAr+TZqdH5ueOf/N
|
||||
YCeDQhJONsEzhgT7hgsXz4HAlGrFeoKoJKsaTL6oDLaeWt4ZrUbK8bpuY8JAbh2e
|
||||
VEgP3QNxnnnqukRTpCl/L6slWrM3kgu+0/6PW1OlZjFLbvHoqtE7PfRRoFE6bqd6
|
||||
CyEgC8OqWK1+XWQQnVAv8DnBonE65Eu2oqShOgtx8LEbZ4K/FebfSMCa+saA8sIS
|
||||
i9IfWF4v8Ll4wy2+IPCploaCPcMfhYtu9iaIn+uO5ZDC6SJRhUiD0JTb2v6cK8zP
|
||||
KO0AwQS8PB67H9wAgL48B3ssP5HRj9lGmA1gFeyTAxlVF9Dey7eqirhM8z89/LX9
|
||||
3bW5HW+MKbM8CwF83B4+tQaOjjGMfid8ckwcBvRor+pAiS3gAOfBDFgi0ykwC0bA
|
||||
f8vsgPfmDPyIiOI7TtQpEpqRvaYA7veK9IxZNETs59vbt/mLcqHP0WotB5t7y9eT
|
||||
/h6NFK7fXK8YwCVO0Yf59JA4gyhi0d0N89kbRg+0nmO2eCbMHVAGKZw/cm0Zosow
|
||||
G8VdZP0si6usJPQ5xFoF/8Ku6hMw+VPR76F5NBNRDzaJOpFCnhYlNtJfwLwhMy/B
|
||||
53nWQ3R0wx2gh7uqNaIXHI24ZQ35gluWeb+6KMrAjZ/vpVl7mEjZgL5cViEIKWXK
|
||||
JK7dLRW1Kxujf+tj0+7ohpLhMn1DhzVT7nys2CttTla9rW48ix2mYjYHI26UXoTq
|
||||
+CXjPe8WqfEUDoc7v99AqUMbHHW5s7AfgdHYlTj3dcZJkfariEsfdTVxrQ6QZAvo
|
||||
PNvPjpewXm/PgpSYj4DeGMxx2VobogUc3rUE074p7Q4IsErFMkvBfiNBDkEBiLT1
|
||||
6WDKQnypZLCOGgCrUXbVlgxQkmJHcz9thQYlrDbBoagZf4GDrhU4Fv4lmHJKrEXc
|
||||
1bolRCwEm46igHrft6C+YoP5F1Bxa+D5L3O5iy77ypumnoouznPpqFfmHyfTDD0B
|
||||
GDdBs2OMcTlg5tfLP6SpGVgmTMokD20RJ+9THE8WQX404nLE7UZXZGyUKhbxlCGv
|
||||
ZIZDHltDMtOu5giRQfbiR8cp3nhYAhNVCxbZWLEujpT2S9vPhcs/J8XWkc3v7X/0
|
||||
cbnli1bRniYe+BU7FAVGUz21RpkHlqBABO/jhJ3NDuINkr8c55UF+FT0AmCxL5Wr
|
||||
iG1uWAhMNXX4lkKM7pQjONU2OkrEjs5JC6kyrbZeRgzlKg29vk1gR5TdQFt4Yb19
|
||||
XLVKk4m1owXRcn3S3KjFKwX3FmXNXcgE+KhBH69PDGU/b1bqoc+Md+9SxED+IdSp
|
||||
MZEVfO421wl6hrIOO7KKGNze5Iqq2rOVfNwmyqWFiryuPozoLXkB7juXjV46+Rp8
|
||||
7phq3w/XX5E+YBDUErWkwFNgEsyzrL4IibML2zsSlr/H+Cx8oGvpcYKnpvydM6qU
|
||||
sfENcf9ppNjA2W9RU+XN/HYNG+PajVRonXkcvs/y7DVrZiGHa3ZGXkSmVZuZ4POk
|
||||
9M0njwzSQTRS8B8kzq4iExn5nzjcG7AJN2NtWY7EcpIjJr528PJqNw0Dy5X2DJH5
|
||||
qag2HTiSzVVreC+e1Zs2NeK4XJokFNe3GSxacZOpcAmzHzFGRgyx3nbI+i20/gIG
|
||||
XWtkMqeT3PV1LhmvjTPcYlCWEbwzJk5khY5GWu4PratEyoYkRi0fBDFDPIewCR+U
|
||||
NRfucK6xnUzSSzNmHJxWSaRD41V6LmozctsljVWQzPY978qxoVFRkirj0JG+EfrH
|
||||
2iuT/RAbEwZP2a8cDME90xxtCLARqlLAfUujvaqK+hyxs6oYQzEkCsvp6evRDMfr
|
||||
KlmDfWJonIacUpFKF4j/F+KaebX6TJEHY4e0OmGSTaKuEcwQoeek+PtIgghAXte0
|
||||
xpOUSnX65Zj0FDSyEKTcG7sb2/a67vmobRdrPS8PeGfHKgCVwUP7RN5K/mz61I0t
|
||||
ltNv+RsnXHwboI75DdkUfbet8O3TYlvEz0qUiyBBKnmADComXwXjV9TuMjDgcjVk
|
||||
dXRy9GXFwu3rxK76YKMniRp4ktr0oZ6LUd9PazD3JCaAAMCmt+w35A/G2rREGsZ7
|
||||
B6XKZW/MQi7tehS0qRDOIU/xhMt5nQkJB/ifipnrdY8yfe0M8+cALjVq+L0lRIZn
|
||||
esAF2fQJ576KL9TApL6MeivhvagbTfYWiGMC6w0urLqMZQr63SEHmpAzAScr/fLS
|
||||
R1zcvqnFKV0+GnbeGbgcNEzfIPrhfKFWJjmIHK4Y1NsxHUe1VWQVA4veFwwmUZg6
|
||||
RQB/WqyEUht6ea2XC7gTDOzDrHPbX04PW8F0apZFSydNmQU1bkxAwcCbKys/bqRu
|
||||
rtusoQBUVRIcsAqN51J0GufqBqS9AD6Wa8vRhqhvlXasHsWcdgjG6s3/r0p7QeI3
|
||||
guBuz8t3G2esomWxOYazaGCstxcj9f/LQpyRY4VA9dbGHZ7G7C1Og/Qh3yCoEqyx
|
||||
6EFwt5wtytH+5gt4L79EVePeqyczMTiW4PXS9lMpmOmzzdYwwOq0IMNKYak2KLrJ
|
||||
EUqzkKT+H7o8G1sjX6+/pwok50ULsjYOPiFg03xzo8Z9NL9eIgrA5lQT5PjY6RZ1
|
||||
hwoME4Nn7J2lESntey1B/UtocUCFlEzrtSV5QhtCovDs+U6fqmO2+BTGaRMKlqOj
|
||||
PqeQG9BTPWBOLym5+qASbsNtmK1e0MFdLpqW7X6by4D09PJJ9blQtRLxpfJXCm2A
|
||||
7Zl7t5KHiOoUXhaX4X4rm3JcaA2v3oRW5oqQBV7q22N+mWEQwXMMr3BQl8UUUXTA
|
||||
ZhNBS9r7z+Epw79jPyW2lUttINtYaDrc1RmflT26BPUNxaAUoxYv//QOKkpMvkNB
|
||||
hueQIGKoHdRTjcbVCwv18o9KtARk67M+3j0jyS7h5D/W3T/SQfIHBer2SmkJvkK5
|
||||
EeicPQy1g/nP6mLV+RGuYXBijZOADfcTHLkXhGmDNNgtYXgW02gV7XV6x6IxyGuD
|
||||
80xHBH3oPwU3hyWwDVegKhZCF9NUv9sOwCpawG1RD+K/MczfsZTRc6cRjaXlYmll
|
||||
OplhRGJ/cumFbTULaIhcsH6iG2zUEfsrTEtbXUmp/p4dQ1O++VpVUw3itUjLmaPZ
|
||||
bI7tVb3PKwH0G16Y1anZmaRCjkOWtuBezFXDxn+ooHhlJE9H/hJZSu7b5pVcv+Me
|
||||
PV2uaFPlkhfh9+kzhp8jBK64KQUOfWdQSdPHAA9uN/ZM9ZgSZoY4kTr5OuI76WoP
|
||||
6Da5lcmglg9B9YIHwFa2wjguF9QFcF2e/8ooeGYRtuLCDYP9Ym6WMc9NqEjW4JQR
|
||||
3F17BYHd0Dnj0WoepqhnToC2qVNqCT2gTDbTCk07qHR1IkDKmE7T9K582rNwjAzy
|
||||
Sj+c7Rw2MBB9cZcGiu6U/ja7kGLDyhhS1YmYZ3luvWDR58Mc97DPGYofgDpIY3l6
|
||||
v02MQTgxf7VOlzczNEcYh3Y9RqfUS6KK7OyP/GH+YHoCfS/Rbp1jW4TI+Nam6Kjv
|
||||
tl7m/TQH9tadWanLxTKLYq8zSPJNdpkDXWyl6LwCPKm2R5FBrweoExJo3M2eH6ln
|
||||
WL08ymCW4mKd8ARGKEwfk5rKcFx4at5Myoqtdkuv9I1NBeDsgao4Lufi2whedOUe
|
||||
rnWK/hJTvDRlTYz6cyGEpF8ksR5RFcQbJyoZJYFuuRNQFuESMa6WUAsIK1L7VGGs
|
||||
l45UIu4FR+51J3KavXwZ1AcGw1eUSDzF+b5iEVhEvHrizPxd76qrFAzjM5SJ4eiM
|
||||
Tf2EEHzwYfA1XVUoa4b0sqkEDa14ok2sdAR6HLzlhow6m84IVtI/euUVc2iuOJNR
|
||||
dKUNAVoe8cM/uxyxOFvJIPL/epTppbEeKzPX7eJZPSvlnquhiQ/qzdHBfL9QLa2F
|
||||
FvUnQr3zibDi3Kjn1uPh1Guc683wKU+C4wP0++KUFvI19z3XgUu7NIHnQUtgfMFE
|
||||
olpjxudGQLDVr2x67VrL8mrvqxyzTpokwHy/2nkzB9rPlRacozCE/VALFFedsJT6
|
||||
UREgIXbAOh4e4WXVRXcCjXSPm+ydsrD9k0txjjFVUvSd2JzEYQvWvjuG0QDibny6
|
||||
nSVBmwXANslve/DQnHQTVzsrP6DL7h2m078aayLBWbJun+zQfOVYXGUthyPSZIDY
|
||||
enegzKURe7u0gJlL3NCNLRj/aWxPZCr+D1phl18T2ES9mUJ8Ms8dAKpPusYxS8En
|
||||
Hm2bYWZGrbQ3mGuVlBuvdJs2jS71a8X0tIDr1khDXGcTqAY2teLLFlXHlWbu5YJe
|
||||
3/fDAgCV3q4s7Y4voUE8hTn9MuSJMzeKeTy8bcEMLtssdZTlp5kEdR/bHVSEQZGG
|
||||
po7TiGfa4yCySfpc+/bglgd3q98dwe2Ouoq4EtmZkfnAU1dTbthnO1AUs77ymCy6
|
||||
V6ANPZALhq2qObQugcpinkDDZBdCnFj+nQLUwCyA7SSr8RqEUGxJpCJT6lpTL/rO
|
||||
0MMXPVFtq9r9Y38+cCl+kRbecMNkJ21EjlLHb1s7wA6RiMJr3MzrasWkmParfHE+
|
||||
7hiAFdVtW7/sdRPo4BwAkIyK5vTZbi0jeRwF89IFdB/VlhOT3cJ0stXRVaNgfqP/
|
||||
vq9Ag9sSq+j7J2GFgdfZ8UZLteBEK9tHH8jwQIKfGqfpZXa2uknRaw3sX9S1EDhL
|
||||
dYh9Le0CzPie/BRBtBJlulw2OnMJzT5bD4O7CRlrop4AOVqVA/vjlqZbCdvsF5o2
|
||||
oEymUUsPl8K4kdOmdH9E1/CgGjHgFb12cMMFTum83ElOJi28nR6nXuaizkd0NTxz
|
||||
o47d0iZa6rv+oyJ0qZ4nO8SI8YpFUlkaWkX/WIB8Od3j9Dd8BM98vuR/xGnKElvr
|
||||
OsxR9CxarGFdmF/Zua0vHJU3yoAwPpt6QpUQPPOscvC/L7ztG+mYvGQ3gA21u7n2
|
||||
2RXhr20M/htxgr9tP79iDUZ8dyVP7tgIATmeb1lzMOIWkxJ+S/hjCX13TKNREf3p
|
||||
tNEFsjsep2HwOOKwZIYBq5fD6jrxyHY2d4LVYTYaDWwRL1gCEt2ILXXVZ4p2MRfY
|
||||
qGFQAZglry7gfotoTDMfFNJ39LmoOoLM78k/vU1wUuNRMUvuikn8oJbVoPhtrnK9
|
||||
oAi43XBudv0GldxHu+hlImEbP4Hcz4AadJxNlo5lMEqAMP5tORMRTcp7WXV2XojE
|
||||
sSk5J2JXM//kKkYqmtpoJ2EmDc4xCIPGAPGfan68ID8rV3Cd38IOKkaLzgLn5pxb
|
||||
QibTuTkd7w+cqFIsG/ex1WZQW9I+UhROTYd9qfz/HGkQH+I9PleP1oHSZpacViPx
|
||||
zON1uCvZksp2QoMMaR1iqW6A9ZL+psntexMePQ0gqReNHpdAAc6VTxVapsmH4Qeg
|
||||
bbmenCXhh1FAc4gVGvjtv7fG0w92WxQTnKZAUsXUeRtFPcj6vkzqBqFwIGRREmmy
|
||||
ZfkhpmNYarWSAGkmE/07NIjsHYuHLw4LkAKrVbUIHEoBvVnItIoBW2X1MhZDm9Ro
|
||||
2c6p6DUvJ+XceZxS4y7jOImmDFHRadIZTLQ8D+yhg9jhdRf9Lodus8z7Xu6fjErm
|
||||
i6n9fqbWpoirjXQIDXk/j37jaKGeZW0YtWoqjzYSaIKjybsPQWz5GHMioNRJnxHD
|
||||
Bn3GIKkO2QdoGlwq80OI1O3bzq8/nqap3h6adiBjEWloxkYVjr5ieKpSLDomYMF3
|
||||
nS+XpyPCJe8h3uEbOfk0gay3hrEPE4HZk0RdKJDg/RMWKwheMCsB81O2IwpTdg0R
|
||||
RC9QLtQUaUGS5hjJQfYPeP9b6Spio5j1g+y2OtQU8jZgoafq2cuYzicUUUmbJ13D
|
||||
3P4opfobxBuFi0H0FubDnfOf93Y35Uh+dS4tNNbTOsn/Swnpk3/ZeCVErz9BISM5
|
||||
1insLN/3TLfK8LTVM/lOB8BfLQNkdXeZTM5E/rV+LXGrVkQf8M2pAf1QUWXmQ1h9
|
||||
tQy302ikaBC43A8SUhWDVRuLiW9tItIGCZKEqs6xDtPz7T1Jr2TwUeCtqmNxQaFW
|
||||
F61bBz5uEBeVXOdb184/0yn499rOKUri1Gq+E4TVAy241KtDKEQ0bGTdQjI6mzLf
|
||||
H6fxkt1pExYc8L/JzvyB4nwbaaE2gTM8cl9U5/vwmxPyDsFpYi91dInZjb5lwQ+0
|
||||
pxZsU0z9uLnkiO2bHK/WdyJpvYPR4zt2XCjwCl2EFYt64Ib/hhSJ6hH/fIm5W1/R
|
||||
L5wpPIu/Dp4c0BsQW44wP7BPJkAWzJrDVHC0mMw1XbchQuBOnLtM3V+VHVAAM/M2
|
||||
95Wt97EZyEQGrx3+w1+DHbmPpZJADxhPBJiNjFhW8h4ekzXuVScC9oJprZoPPVYt
|
||||
3C7OKRpPQbhkzVP/m8f3Bm+jhcD2gbNe40lsi5X4Qq6bzRhLJprU2XsVc2O5Fq8J
|
||||
Uyj1BN4nKq3ZGXvu9A70uavjRY8ru8/jxAfckLgqnfrc2GBcTbx+1sPmxz1BwH7h
|
||||
fNV2esyXI4sthJ1FsOpf8nqKYnsNfclScNzx48qqbbj205202jj/HFBuY8/gw1FH
|
||||
b/hZUKT2QRcxo+JfeGkMQag9GxSJztENLkBCiMdg84Byyrvfqm/+eEGthOk0LJwz
|
||||
yEKY5zHlqi9zItCrbNglq6yeNn7NuAlN9Jh+iLqGRwrcjDDZX1wUroeQ3IlK0u0W
|
||||
VraBfM3bpXaoENqHxGR4Kr7l+dUMdvNLcMnnHPYsBrcIdsjOKdA3B6lnYvg5wK2s
|
||||
gGTiXtJtePb01AEuWK3az8EghCCvEN9bhd7KMBA3sQXdGPUqrcKHagP/z9b/dbEQ
|
||||
+KzcNykjUqlA/m5Xc0YsND3K7D01wwgU124e5LBfR12xs6n3Y5MJ0SXU9eAxWPwg
|
||||
5JN0I6uKDu3hJeJsIbghEFrFNPfdNYPXZx78yrYO7dX1yylSfVK36gPeD5YYAOds
|
||||
DxdujWuPTRHlaKTTUAGinYF2RHN6/ewQyQF1SWNHG7nXPlrGPAXT8r+UdGGwghmM
|
||||
KElGesVmyIf0mb5WiyZ4dV0r1zc7SqL24qVKLfmOzjgxylH5JVdrhNzoBYTlaUZe
|
||||
Zuz21vja3HZvGHOqpa55k7106ajVPfjcQdsRYqs8T4rlmu+YIeqL57GD7fj9O3r5
|
||||
buSCjGzWM+icFp5QamfFE1/o2W7LHZmK/3tT2kTh/+6wksRn6FVnmQWTOQb4wwIY
|
||||
zIKuNnNPDjmxapUL07QmatlVs2XxQ9d7JfkpfzkKLNCC1tVGguowQvWxG5ChTfxf
|
||||
5i0/mQQie5gVggPylqx5PQ3qtExZF/0VyL1QO3H4+dk3ksvpiWz7x6NZJjplancS
|
||||
CIEYmV+0G4uYQe1bVMHOdBOkAcMbvcGSE+FKmFX0XljzGNosSfW24mozjp7j5OwE
|
||||
SxVXwTELn4ocBjHwp4xUCZ/a7UGj4P7FReyOFMkHSyqrpeTfIteMCwL251v/KsgO
|
||||
KP9otmx7ri7kN2YdkS+6z12wvXEiqvakCobbcZ9WDpTgmK1UWHe5GycmrhsGoA/0
|
||||
B+v08hOwMnn8amCKWkiC4H9ElU/LAQpSjNmzkeICtX7V+PIz7CpA1e8MrFdvgdzf
|
||||
Sla44zXWpRYCXznlneDnJ3/7DwWkSFXma9/PE2ORMaFkDWus4AZa4wp+8LzXyS94
|
||||
rFz4dDSoh4NZ3oC4245yggcMNOVgf4nmSquM5qc+EOgV34nT/M2cJuQqMoHKKTnb
|
||||
8caEl8YFWCj4VuCYgUxE6MQN5F1egqa4mkr0KSIS9oLqwTeC1dVkj6WDNyHVaiL+
|
||||
5a0Yf/RMf8ARjb7g8tM3O+2R1V59GuPGvZUOKLdma9wNn62e6wgg9UQCMZPzOck/
|
||||
NlQIi5Hs+kxeLE3n8ILVmwDZC0uZhhyLyFbSNZnYZ7lY8x6OQmAR0lbwM/+fGkh0
|
||||
tJZ+brC/z6etHyG75UXJqgl1tXcmm7tCIufbVYcWJ70ZG3dZ4u8ngiUuCqjGhX5z
|
||||
r7JOU/gGkoDeTuLqL08eqKfd8FbaWEcvmkY/XPUdUOdDbHwI72axL3Iz8BqPhmM3
|
||||
dgN3YHfIK0gk/NP30LKL6JGs63HD7CvBtu9tC17rKlwTKUo5+VQZwNQtnI2Sl9t8
|
||||
/lnJppcHAftsye8b+RIHvQUu3Ev/y3J71eYMDbFBepLeoH/ufgNGbUt2h2dlfmZI
|
||||
sNEvQ66rONz8gsBdRn38mYvpRGopFfLgjDaGokn5sJ+McEWROHWu1sjy4KRQv1j+
|
||||
skZOaMTCMd0cAyCwwatmpuQOsOAiM2XG9IiQ3LuJ5u1ixwFuWVmPnDfLQgYixJ9p
|
||||
QcmAi333zKxmQHrLCLH+2leqI7TWn767pJTJuKsgGFRLsTWIOLFwaebxo0oq5JyL
|
||||
QNkU5zQ3nI316i31qXx8WwKQohTRvM7LQ6poOVukibtzC3qEeIUGRYiKZbtAmFvH
|
||||
Ff9pABj0V3FgeZfICQRpe1Bz5TDO4OXz7u8QnzZrKf1lvRp0ALtij9YwPXs/B9Or
|
||||
De4xl9OEx4u7oaShCmUp0lcjHmNDpfPGE/L3GhsQ9f6PY6tQzmY1EhIIzomDT4pA
|
||||
zCxjf7q9mETZoopbpU/d9nGbgMGJlXWMBI1SpcHkdorGR5EmPVwm3prJcLvEw2ew
|
||||
C6Y6atpLvQHxra80zQvCFZJ6oTZeB3glYWiukjBFDJlbUXN5xxHDkng4UvOpSZvN
|
||||
MsFOXpoEKedcMvSP++Nl0fchPdQo7zcrY4VoVoGcFVV0zHabFnK7157VSUYH3WIZ
|
||||
HLTBrIQtClmfZqXhz+cTzDKUdLkZEGxrdCBGYF3Euo/4X6s1GRcqm1Lf4h/ho14Y
|
||||
5m8q9fR9K71yPzzUpkOvzgpNirip4lxmFKJqely6rviWfkMeshvpre/2b4tOS/BF
|
||||
huI7kvA7RdeyT+2zoogvfwbdFpMltu3XY4qLlZ5stzDVjY8EMOdOwUZ0uwZtbXn9
|
||||
v0+7GLSSlAsa5ikcttSgMj+Ico9sXSD+1kTfu0Ub4pB+Dqxr0lJrqBhhABuMxYqk
|
||||
oNEdAk56DqGVy15mVs+M85Oat8Xxz7VtgWZomynMtTUwskZYcMQA2YC41GF92Rt7
|
||||
L4+dww0C80S6S3DzIq1F0AXBIVUqHYL5ZxWUiyQV1fqgTi4gZs7Z6Axjww+Eauf/
|
||||
UgwX7B+iJZMWfg0T9QBhsJAGKgB9vV/iZhkiaLS+2I7J1wybyq++2URa9Dq66gYp
|
||||
JPtuNSKpSJf329qo6LUjUGBodpEes7sA99S8NCek1oTQ8NHKeGHX3UrkvECU4Vly
|
||||
mjmVg8eSJzYFtbR7+hPurJHr9me4lj+szB0XwO6wJ7SVgeEn//cpGFTeJ7s+w6Yu
|
||||
TOolk9MbSVdGviWZ36zDI1eaatg5jDHt0EsjvaS9S8TK74CPpcugzOLCfNKjwVJw
|
||||
kKmAnATg8khtRYVMPI6X2/uL3LLS8Q2vJY0uv1SS2pCrha4MTRisZ0d7QdNNCzMj
|
||||
C/DDAM5qzJ/xXUEz9/XFjkLMGfnvivEGuOrF3SaYLoTIXhf8iBuP0EBTkI6ljjDS
|
||||
jfyeBIA8YQ2Iy8fFD5/PjrssemJBOims0bfNAJQocfCr6S/MARi5R0Rlg4ylqHXL
|
||||
F2K0wiM/K4gpzl0AX65VRTZktMEaoyJ5hdvwyDMnyzv9cXePBjnb5YLuJPSdw10/
|
||||
8fdEWedqkZlgNSka7Yv3uY1hZzySCxYxB6FZ/PZRsSUvf07DLKGgm2Vw5bI9SOOR
|
||||
+0gZ3YollK50HKOH61uQmmLl9ONwhSdvMnAgAFCT4hm7roYZcYVyH9rFaL7vb5Ih
|
||||
i6ZTJidr1LqyY4+MbBvc0fJjuJ2YYhqUzg/IYp8KdmBbXDz79uqpjOkJQxWngQke
|
||||
LBiMO63D/KRP9krtkdnyUH8O9luPp412csoxFADE3pKWcSEtiigmIOHm+YzU5H92
|
||||
UM/8A9gCFm4c/4+AEay/Gif9GYtaBHFWgTCHKfJ01Hzny5WhapaNDkpe9FExRxV1
|
||||
541fwKud2kKcVQNIgx0VQ+uinhnv+Nf9wv6WfiHYUtA0UJSj85yW7MO/GCViFydb
|
||||
A1mHZ9owUOGrNdxX0smxJXkcM4aXZUfzeT5jjYa2SNFB+mX+biqgWP0BfUhAxEX0
|
||||
a1E/ojJzT7PTfXKxoUiVVZOlCgZU0saHJK6HIw2i45LruUGQOQgVKEAst36a7GVH
|
||||
HX3UkPG2CIXO8X0pJ1QfCd0FndMyNcHPVa5z6yPs890FMjxTg6wZdpkMymnMeTW3
|
||||
/EJ+KRGMbfHn3h8eXcXEPyGVj6JfkAhbqsZGtgCByPWq/6NIhuLDTPDu+mzON/2u
|
||||
Zbga4vPLm7/g+UKPXe9ZI8eIO79cRqfqJwVBZSst6Aoj11F5Ub67FlfHdba6xHIi
|
||||
S21QS881+aRSu7oDPPa1kB/A+atdzm8NBOUFHvhNQ4jSCsMWcNaERICjrJas5Jjk
|
||||
899bsJz/iX1sJnX/k1NYQzB6zKZIUhcjPob02LkROA9cD48R/gOB3KZBIYGs60Bt
|
||||
NzO9H5oSNYhJH/7Bq5Tv+Gnvb42MWcHKqgYeb/1zVnW7IppDMCli7WKxbwfQxbkL
|
||||
vI/E/0z5utGhuKAi8hEFIigbaXvtdjJlrHMru7S1WYWUHjU4TtkVnjByfkddf9wh
|
||||
sjeNgWDUgdD7UOS+mOI+k5xXeAADDaCGZd85byFvMWfv7roWdcuhScheB6MzgY7d
|
||||
q+yWbeWg7fyRtsQcIGc4tw0DE+OYE52Z2IJWTEq0UYX0bQqZNXgYswdD0HckqilE
|
||||
0iRoZKJvmub0tEma2Ugqu51gx2RbNM7RLzlRXCupVS9JlYuKY3fpFT8QobGuA2Pw
|
||||
dJDh6iM59TkQGf2fc9SpUs46SutJaSVRf+nNAfh9nDHcLN4hkWaVzz/23jVwBjzW
|
||||
JAyPEPJGd0Y6TEZus4dP/ED43H9kzcXAVzocfxeoMGPmxWX+JAGcsqj1eUSx0Fj7
|
||||
SLlJEreQuVmzpOVo7xBB/7ZC5XYRKOxgDa6aAMg7d6jAT27L5TwTfmNpM9fKfMza
|
||||
KhqWzncuvQ7ggTnjxQ184498HQP6wnwVkE92dKlNnA3XSpehhkEaqOoj5zAfWSSC
|
||||
oghpsk2aSEVoJn7NZ8Ii5BDcgW2GnIMs3XZVWNmSByqxMLSCR3MvJzEgjcgKXSfV
|
||||
wHpjfjfKnJoG6DUVhElk0ywXQEWN7JNJMx+8Xq5DIPFdYRKhjczqifPa0OhcJxQh
|
||||
PPayhJk8AAmPXqHNW4qKOjfBzSjOKV+K3AfwUQgvfc9ZAiyaGIKJZQmZQtuMQtRb
|
||||
0EiW2MsAlFyoDJzliZYO4+yqwieUfYPMInuW60rNW8cXKDBLZiC5gbLMSdA+kZZd
|
||||
ATaJTH3sTN0+i0ZrU5MInP02ERfrXJzHvkn/QFxG1NYtqpP664n0rYyO5Dhq55cN
|
||||
JCD7JOXs466Ids1mCMH5FyChw7u2aWGK06diUELk9sZyboLO/kw2R0q75AZ7OMhU
|
||||
IDoMfawrp81WHKQ7r66FAmHMOca1Y2tzrLdf29INzCXqXztoSHQ6vmEM1iNEcyu2
|
||||
Wczp8DuC5v2gM88QcN6CiwriIxcFyYbgr8WTaVG33iK+JVYwORwMvUKppi32Ityx
|
||||
zaybZtkYhfJJOi98sK8DFEFA5z3hB50MpVDHBs0cYMc66XHRs2HXOIYpRhvFCN0f
|
||||
G7VAMSit3sJ8VfOheTZaGCwKaT3k8l8LTd6VyrBz2ZlxnmGXR/9gJfUFT+U0i9m8
|
||||
Etogz+ftf8xMW5o1oCHDOpzS8s369hdBmpqd92kcITjHZy0FxK709SnAVY42tNhZ
|
||||
BUXVUvpqkcgP8GRWHP1o+eNGFNDGxtedSkoLzeFTITUFOh1STZuJmL/2VQ8IFSkM
|
||||
KodxW495lNZ3gjOWmAMgelhrpQ9OHJcp9+iHat7Whp0RNrN2T6wjuEC9rnl+zHF8
|
||||
EhfYxn9iKpYeGADY2tV5EVE1EPDSD8byv0zNG0lq6adU+w5tae+5g1QKkXzyCs8e
|
||||
ri5ac2T93Fho0WdAObZJV2JIeS8NfUA5bkogXYRQjEkCSSBKTx6LFUpwfTUdNQYT
|
||||
z+IHu76MDe1aZD8EQiMfwC6hVtzH66yQtte4rG39nYoqJF8ws/NxWDNBzhv6g/Vi
|
||||
KuNxO47KjOoYEJ64A9ACdjtt8F46wy4HhLzBCKKF/S2f9GYleOCHMmtAwGwL90sW
|
||||
dA0zP9ZZT7SkYU03Nk0bcwu3W7LpldLbyYFoo2PjeBHGWEu7sUsf9w2WxaDxTXvx
|
||||
vUZ0hBaFlZ6BVOyWivTaSEl/BOAAteZBPJ3hakY2r2dZaFkbp2JF2jPhD3e05eMR
|
||||
cK4JCbn6QzBaHb/Zave7g+F3rfrDr8hCVlA6WSi1Mmb4mTMF9t1r+l9/PgF7iXgC
|
||||
b7cfHje8r5bR/OrQIbM6BkfR5rRQVSzQHoxmUNBOSjXybRnLr9ZCuY8krU1eZ33l
|
||||
3nRLER3E1ao2NuQWORHwcwzGWyr1GNR3h8uJ6dXqlj4biBVcwHr6qLdkcoolb+1N
|
||||
2NIcqmvD9C/m/YcdCNf99RNBdGuT7o3JPGV8lcWvGBA3SG7fH0RaUm098K8B7sDZ
|
||||
m8aOiNsJx2UoX1lTVOG2CeSYrHKomB0rMtPa7Dczi0eBgLBswqIRNfJulQnLZyGB
|
||||
+nFq+Dy5puMs26Zgzx0UzgI+JDoyFefAve/V8cGZnT2iBarzZGL5unqPxshq2r+a
|
||||
e+HswcgpFlCuHEgRPDpCuodcWRoZ+V9V5qdid/H5yzFqzAkgUbsxZvsyBjoN3Dq6
|
||||
1+7fArlKVEYCIDHyIV2D8EHBrZErbnTPPcLVgv4eAM514aOpzMJpJbHeTkuWuDRt
|
||||
y/sHtjHklXcBrgFODjN0Rd6LZmLza3fWYq8dERFCeJpBD06xR6AvZWEQegMBwDkW
|
||||
y0ewgozAdtcKQjJ9FeNPbzh50rTTC4HEhpHcq6nVj80JzuxjoiaMKP/V2vmt/LCI
|
||||
9S2gySRpNMCrhrpbOcpiW8i5ZZdFOFtEGgd54hPedyG7LTTbVaKNsTSs0UGdUlKJ
|
||||
Src4YU5Et6yHaS3JCpIPV6fia89UKF6b+LQCdNGDVrNJLlyvMqrxSUYnG5lv8W3X
|
||||
7nQZAZMhwgOq7m+uGH87o2H814X/9z9JpEbXwIgcw7nuTQ65H44F8pLKwvQg1fMW
|
||||
y7wownaEA+iu5FH+mXDtMddPeHC/jFwe6Ky58EVWE0me9I9Lmi1ImB3p4116Bujm
|
||||
3ptybxOCYN+8x5BPjsO+i2Mmke1FsM4CK/+L0430h5BET2LDqyTUVbWgcxSEC1Uc
|
||||
7pa2HSH3ZFmSC8g5gt5ZA3TSQv8iY/7xD5cMsbk=
|
||||
=6HOm
|
||||
-----END PGP MESSAGE-----
|
|
@ -0,0 +1,139 @@
|
|||
Name: propellor
|
||||
Version: 0.8.1
|
||||
Cabal-Version: >= 1.6
|
||||
License: BSD3
|
||||
Maintainer: Joey Hess <joey@kitenet.net>
|
||||
Author: Joey Hess
|
||||
Stability: Stable
|
||||
Copyright: 2014 Joey Hess
|
||||
License-File: LICENSE
|
||||
Build-Type: Simple
|
||||
Homepage: https://propellor.branchable.com/
|
||||
Category: Utility
|
||||
Extra-Source-Files:
|
||||
README.md
|
||||
doc/README.mdwn
|
||||
CHANGELOG
|
||||
Makefile
|
||||
config-simple.hs
|
||||
config-joey.hs
|
||||
debian/changelog
|
||||
debian/README.Debian
|
||||
debian/propellor.1
|
||||
debian/compat
|
||||
debian/control
|
||||
debian/copyright
|
||||
debian/rules
|
||||
debian/lintian-overrides
|
||||
Synopsis: property-based host configuration management in haskell
|
||||
Description:
|
||||
Propellor enures that the system it's run in satisfies a list of
|
||||
properties, taking action as necessary when a property is not yet met.
|
||||
.
|
||||
It is configured using haskell.
|
||||
|
||||
Executable propellor
|
||||
Main-Is: wrapper.hs
|
||||
GHC-Options: -Wall -threaded -O0
|
||||
Hs-Source-Dirs: src
|
||||
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
|
||||
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
|
||||
containers, network, async, time, QuickCheck, mtl,
|
||||
MonadCatchIO-transformers
|
||||
|
||||
if (! os(windows))
|
||||
Build-Depends: unix
|
||||
|
||||
Executable propellor-config
|
||||
Main-Is: config.hs
|
||||
GHC-Options: -Wall -threaded -O0
|
||||
Hs-Source-Dirs: src
|
||||
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
|
||||
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
|
||||
containers, network, async, time, QuickCheck, mtl,
|
||||
MonadCatchIO-transformers
|
||||
|
||||
if (! os(windows))
|
||||
Build-Depends: unix
|
||||
|
||||
Library
|
||||
GHC-Options: -Wall -O0
|
||||
Hs-Source-Dirs: src
|
||||
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
|
||||
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
|
||||
containers, network, async, time, QuickCheck, mtl,
|
||||
MonadCatchIO-transformers
|
||||
|
||||
if (! os(windows))
|
||||
Build-Depends: unix
|
||||
|
||||
Exposed-Modules:
|
||||
Propellor
|
||||
Propellor.Property
|
||||
Propellor.Property.Apache
|
||||
Propellor.Property.Apt
|
||||
Propellor.Property.Cmd
|
||||
Propellor.Property.Hostname
|
||||
Propellor.Property.Cron
|
||||
Propellor.Property.Dns
|
||||
Propellor.Property.Docker
|
||||
Propellor.Property.File
|
||||
Propellor.Property.Git
|
||||
Propellor.Property.Gpg
|
||||
Propellor.Property.Grub
|
||||
Propellor.Property.Network
|
||||
Propellor.Property.Obnam
|
||||
Propellor.Property.OpenId
|
||||
Propellor.Property.Postfix
|
||||
Propellor.Property.Reboot
|
||||
Propellor.Property.Scheduled
|
||||
Propellor.Property.Service
|
||||
Propellor.Property.Ssh
|
||||
Propellor.Property.Sudo
|
||||
Propellor.Property.Tor
|
||||
Propellor.Property.User
|
||||
Propellor.Property.HostingProvider.CloudAtCost
|
||||
Propellor.Property.HostingProvider.DigitalOcean
|
||||
Propellor.Property.HostingProvider.Linode
|
||||
Propellor.Property.SiteSpecific.GitHome
|
||||
Propellor.Property.SiteSpecific.JoeySites
|
||||
Propellor.Property.SiteSpecific.GitAnnexBuilder
|
||||
Propellor.Info
|
||||
Propellor.Message
|
||||
Propellor.PrivData
|
||||
Propellor.Engine
|
||||
Propellor.Exception
|
||||
Propellor.Types
|
||||
Propellor.Types.OS
|
||||
Propellor.Types.Dns
|
||||
Propellor.Types.PrivData
|
||||
Other-Modules:
|
||||
Propellor.Types.Info
|
||||
Propellor.CmdLine
|
||||
Propellor.SimpleSh
|
||||
Propellor.Property.Docker.Shim
|
||||
Utility.Applicative
|
||||
Utility.Data
|
||||
Utility.Directory
|
||||
Utility.Env
|
||||
Utility.Exception
|
||||
Utility.FileMode
|
||||
Utility.FileSystemEncoding
|
||||
Utility.LinuxMkLibs
|
||||
Utility.Misc
|
||||
Utility.Monad
|
||||
Utility.Path
|
||||
Utility.PartialPrelude
|
||||
Utility.PosixFiles
|
||||
Utility.Process
|
||||
Utility.SafeCommand
|
||||
Utility.Scheduled
|
||||
Utility.Table
|
||||
Utility.ThreadScheduler
|
||||
Utility.Tmp
|
||||
Utility.UserInfo
|
||||
Utility.QuickCheck
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: git://git.kitenet.net/propellor.git
|
|
@ -0,0 +1,77 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
-- | Pulls in lots of useful modules for building and using Properties.
|
||||
--
|
||||
-- When propellor runs on a Host, it ensures that its list of Properties
|
||||
-- is satisfied, taking action as necessary when a Property is not
|
||||
-- currently satisfied.
|
||||
--
|
||||
-- A simple propellor program example:
|
||||
--
|
||||
-- > import Propellor
|
||||
-- > import Propellor.CmdLine
|
||||
-- > import qualified Propellor.Property.File as File
|
||||
-- > import qualified Propellor.Property.Apt as Apt
|
||||
-- >
|
||||
-- > main :: IO ()
|
||||
-- > main = defaultMain hosts
|
||||
-- >
|
||||
-- > hosts :: [Host]
|
||||
-- > hosts =
|
||||
-- > [ host "example.com"
|
||||
-- > & Apt.installed ["mydaemon"]
|
||||
-- > & "/etc/mydaemon.conf" `File.containsLine` "secure=1"
|
||||
-- > `onChange` cmdProperty "service" ["mydaemon", "restart"]
|
||||
-- > ! Apt.installed ["unwantedpackage"]
|
||||
-- > ]
|
||||
--
|
||||
-- See config.hs for a more complete example, and clone Propellor's
|
||||
-- git repository for a deployable system using Propellor:
|
||||
-- git clone <git://git.kitenet.net/propellor>
|
||||
|
||||
module Propellor (
|
||||
module Propellor.Types
|
||||
, module Propellor.Property
|
||||
, module Propellor.Property.Cmd
|
||||
, module Propellor.Info
|
||||
, module Propellor.PrivData
|
||||
, module Propellor.Engine
|
||||
, module Propellor.Exception
|
||||
, module Propellor.Message
|
||||
, localdir
|
||||
|
||||
, module X
|
||||
) where
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Property
|
||||
import Propellor.Engine
|
||||
import Propellor.Property.Cmd
|
||||
import Propellor.PrivData
|
||||
import Propellor.Message
|
||||
import Propellor.Exception
|
||||
import Propellor.Info
|
||||
|
||||
import Utility.PartialPrelude as X
|
||||
import Utility.Process as X
|
||||
import Utility.Exception as X
|
||||
import Utility.Env as X
|
||||
import Utility.Directory as X
|
||||
import Utility.Tmp as X
|
||||
import Utility.Monad as X
|
||||
import Utility.Misc as X
|
||||
|
||||
import System.Directory as X
|
||||
import System.IO as X
|
||||
import System.FilePath as X
|
||||
import Data.Maybe as X
|
||||
import Data.Either as X
|
||||
import Control.Applicative as X
|
||||
import Control.Monad as X
|
||||
import Data.Monoid as X
|
||||
import Control.Monad.IfElse as X
|
||||
import "mtl" Control.Monad.Reader as X
|
||||
|
||||
-- | This is where propellor installs itself when deploying a host.
|
||||
localdir :: FilePath
|
||||
localdir = "/usr/local/propellor"
|
|
@ -0,0 +1,405 @@
|
|||
module Propellor.CmdLine where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import Data.List
|
||||
import System.Exit
|
||||
import System.Log.Logger
|
||||
import System.Log.Formatter
|
||||
import System.Log.Handler (setFormatter, LogHandler)
|
||||
import System.Log.Handler.Simple
|
||||
import System.PosixCompat
|
||||
import Control.Exception (bracket)
|
||||
import System.Posix.IO
|
||||
import Data.Time.Clock.POSIX
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Docker as Docker
|
||||
import qualified Propellor.Property.Docker.Shim as DockerShim
|
||||
import Utility.FileMode
|
||||
import Utility.SafeCommand
|
||||
import Utility.UserInfo
|
||||
|
||||
usage :: IO a
|
||||
usage = do
|
||||
putStrLn $ unlines
|
||||
[ "Usage:"
|
||||
, " propellor"
|
||||
, " propellor hostname"
|
||||
, " propellor --spin hostname"
|
||||
, " propellor --add-key keyid"
|
||||
, " propellor --set field context"
|
||||
, " propellor --dump field context"
|
||||
, " propellor --edit field context"
|
||||
, " propellor --list-fields"
|
||||
]
|
||||
exitFailure
|
||||
|
||||
processCmdLine :: IO CmdLine
|
||||
processCmdLine = go =<< getArgs
|
||||
where
|
||||
go ("--help":_) = usage
|
||||
go ("--spin":h:[]) = return $ Spin h
|
||||
go ("--boot":h:[]) = return $ Boot h
|
||||
go ("--add-key":k:[]) = return $ AddKey k
|
||||
go ("--set":f:c:[]) = withprivfield f c Set
|
||||
go ("--dump":f:c:[]) = withprivfield f c Dump
|
||||
go ("--edit":f:c:[]) = withprivfield f c Edit
|
||||
go ("--list-fields":[]) = return ListFields
|
||||
go ("--continue":s:[]) = case readish s of
|
||||
Just cmdline -> return $ Continue cmdline
|
||||
Nothing -> errorMessage "--continue serialization failure"
|
||||
go ("--chain":h:[]) = return $ Chain h
|
||||
go ("--docker":h:[]) = return $ Docker h
|
||||
go (h:[])
|
||||
| "--" `isPrefixOf` h = usage
|
||||
| otherwise = return $ Run h
|
||||
go [] = do
|
||||
s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
|
||||
if null s
|
||||
then errorMessage "Cannot determine hostname! Pass it on the command line."
|
||||
else return $ Run s
|
||||
go _ = usage
|
||||
|
||||
withprivfield s c f = case readish s of
|
||||
Just pf -> return $ f pf (Context c)
|
||||
Nothing -> errorMessage $ "Unknown privdata field " ++ s
|
||||
|
||||
defaultMain :: [Host] -> IO ()
|
||||
defaultMain hostlist = do
|
||||
DockerShim.cleanEnv
|
||||
checkDebugMode
|
||||
cmdline <- processCmdLine
|
||||
debug ["command line: ", show cmdline]
|
||||
go True cmdline
|
||||
where
|
||||
go _ (Continue cmdline) = go False cmdline
|
||||
go _ (Set field context) = setPrivData field context
|
||||
go _ (Dump field context) = dumpPrivData field context
|
||||
go _ (Edit field context) = editPrivData field context
|
||||
go _ ListFields = listPrivDataFields hostlist
|
||||
go _ (AddKey keyid) = addKey keyid
|
||||
go _ (Chain hn) = withhost hn $ \h -> do
|
||||
r <- runPropellor h $ ensureProperties $ hostProperties h
|
||||
putStrLn $ "\n" ++ show r
|
||||
go _ (Docker hn) = Docker.chain hn
|
||||
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
|
||||
go True cmdline = updateFirst cmdline $ go False cmdline
|
||||
go False (Spin hn) = withhost hn $ spin hn
|
||||
go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
|
||||
( onlyProcess $ withhost hn mainProperties
|
||||
, go True (Spin hn)
|
||||
)
|
||||
go False (Boot hn) = onlyProcess $ withhost hn boot
|
||||
|
||||
withhost :: HostName -> (Host -> IO ()) -> IO ()
|
||||
withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
|
||||
|
||||
onlyProcess :: IO a -> IO a
|
||||
onlyProcess a = bracket lock unlock (const a)
|
||||
where
|
||||
lock = do
|
||||
l <- createFile lockfile stdFileMode
|
||||
setLock l (WriteLock, AbsoluteSeek, 0, 0)
|
||||
`catchIO` const alreadyrunning
|
||||
return l
|
||||
unlock = closeFd
|
||||
alreadyrunning = error "Propellor is already running on this host!"
|
||||
lockfile = localdir </> ".lock"
|
||||
|
||||
unknownhost :: HostName -> [Host] -> IO a
|
||||
unknownhost h hosts = errorMessage $ unlines
|
||||
[ "Propellor does not know about host: " ++ h
|
||||
, "(Perhaps you should specify the real hostname on the command line?)"
|
||||
, "(Or, edit propellor's config.hs to configure this host)"
|
||||
, "Known hosts: " ++ unwords (map hostName hosts)
|
||||
]
|
||||
|
||||
buildFirst :: CmdLine -> IO () -> IO ()
|
||||
buildFirst cmdline next = do
|
||||
oldtime <- getmtime
|
||||
ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
|
||||
( do
|
||||
newtime <- getmtime
|
||||
if newtime == oldtime
|
||||
then next
|
||||
else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
|
||||
, errorMessage "Propellor build failed!"
|
||||
)
|
||||
where
|
||||
getmtime = catchMaybeIO $ getModificationTime "propellor"
|
||||
|
||||
getCurrentBranch :: IO String
|
||||
getCurrentBranch = takeWhile (/= '\n')
|
||||
<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
|
||||
|
||||
updateFirst :: CmdLine -> IO () -> IO ()
|
||||
updateFirst cmdline next = do
|
||||
branchref <- getCurrentBranch
|
||||
let originbranch = "origin" </> branchref
|
||||
|
||||
void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
|
||||
|
||||
oldsha <- getCurrentGitSha1 branchref
|
||||
|
||||
whenM (doesFileExist keyring) $ do
|
||||
{- To verify origin branch commit's signature, have to
|
||||
- convince gpg to use our keyring. While running git log.
|
||||
- Which has no way to pass options to gpg.
|
||||
- Argh! -}
|
||||
let gpgconf = privDataDir </> "gpg.conf"
|
||||
writeFile gpgconf $ unlines
|
||||
[ " keyring " ++ keyring
|
||||
, "no-auto-check-trustdb"
|
||||
]
|
||||
-- gpg is picky about perms
|
||||
modifyFileMode privDataDir (removeModes otherGroupModes)
|
||||
s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
|
||||
(Just [("GNUPGHOME", privDataDir)])
|
||||
nukeFile $ privDataDir </> "trustdb.gpg"
|
||||
nukeFile $ privDataDir </> "pubring.gpg"
|
||||
nukeFile $ privDataDir </> "gpg.conf"
|
||||
if s == "U\n" || s == "G\n"
|
||||
then do
|
||||
putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
|
||||
hFlush stdout
|
||||
void $ boolSystem "git" [Param "merge", Param originbranch]
|
||||
else warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
|
||||
|
||||
newsha <- getCurrentGitSha1 branchref
|
||||
|
||||
if oldsha == newsha
|
||||
then next
|
||||
else ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
|
||||
( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
|
||||
, errorMessage "Propellor build failed!"
|
||||
)
|
||||
|
||||
getCurrentGitSha1 :: String -> IO String
|
||||
getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
|
||||
|
||||
spin :: HostName -> Host -> IO ()
|
||||
spin hn hst = do
|
||||
url <- getUrl
|
||||
void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
|
||||
void $ boolSystem "git" [Param "push"]
|
||||
cacheparams <- toCommand <$> sshCachingParams hn
|
||||
go cacheparams url =<< hostprivdata
|
||||
where
|
||||
hostprivdata = show . filterPrivData hst <$> decryptPrivData
|
||||
|
||||
go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
|
||||
let finish = do
|
||||
senddata toh "privdata" privDataMarker privdata
|
||||
hClose toh
|
||||
|
||||
-- Display remaining output.
|
||||
void $ tryIO $ forever $
|
||||
showremote =<< hGetLine fromh
|
||||
hClose fromh
|
||||
status <- getstatus fromh `catchIO` (const $ errorMessage "protocol error (perhaps the remote propellor failed to run?)")
|
||||
case status of
|
||||
Ready -> finish
|
||||
NeedGitClone -> do
|
||||
hClose toh
|
||||
hClose fromh
|
||||
sendGitClone hn url
|
||||
go cacheparams url privdata
|
||||
|
||||
user = "root@"++hn
|
||||
|
||||
bootstrapcmd = shellWrap $ intercalate " ; "
|
||||
[ "if [ ! -d " ++ localdir ++ " ]"
|
||||
, "then " ++ intercalate " && "
|
||||
[ "apt-get update"
|
||||
, "apt-get --no-install-recommends --no-upgrade -y install git make"
|
||||
, "echo " ++ toMarked statusMarker (show NeedGitClone)
|
||||
]
|
||||
, "else " ++ intercalate " && "
|
||||
[ "cd " ++ localdir
|
||||
, "if ! test -x ./propellor; then make deps build; fi"
|
||||
, "./propellor --boot " ++ hn
|
||||
]
|
||||
, "fi"
|
||||
]
|
||||
|
||||
getstatus :: Handle -> IO BootStrapStatus
|
||||
getstatus h = do
|
||||
l <- hGetLine h
|
||||
case readish =<< fromMarked statusMarker l of
|
||||
Nothing -> do
|
||||
showremote l
|
||||
getstatus h
|
||||
Just status -> return status
|
||||
|
||||
showremote s = putStrLn s
|
||||
senddata toh desc marker s = void $
|
||||
actionMessage ("Sending " ++ desc ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do
|
||||
sendMarked toh marker s
|
||||
return True
|
||||
|
||||
sendGitClone :: HostName -> String -> IO ()
|
||||
sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
|
||||
branch <- getCurrentBranch
|
||||
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]
|
||||
]
|
||||
where
|
||||
remotebundle = "/usr/local/propellor.git"
|
||||
unpackcmd branch = shellWrap $ intercalate " && "
|
||||
[ "git clone " ++ remotebundle ++ " " ++ localdir
|
||||
, "cd " ++ localdir
|
||||
, "git checkout -b " ++ branch
|
||||
, "git remote rm origin"
|
||||
, "rm -f " ++ remotebundle
|
||||
, "git remote add origin " ++ url
|
||||
-- same as --set-upstream-to, except origin branch
|
||||
-- has not been pulled yet
|
||||
, "git config branch."++branch++".remote origin"
|
||||
, "git config branch."++branch++".merge refs/heads/"++branch
|
||||
]
|
||||
|
||||
data BootStrapStatus = Ready | NeedGitClone
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
type Marker = String
|
||||
type Marked = String
|
||||
|
||||
statusMarker :: Marker
|
||||
statusMarker = "STATUS"
|
||||
|
||||
privDataMarker :: String
|
||||
privDataMarker = "PRIVDATA "
|
||||
|
||||
toMarked :: Marker -> String -> String
|
||||
toMarked marker = intercalate "\n" . map (marker ++) . lines
|
||||
|
||||
sendMarked :: Handle -> Marker -> String -> IO ()
|
||||
sendMarked h marker s = do
|
||||
-- Prefix string with newline because sometimes a
|
||||
-- incomplete line is output.
|
||||
hPutStrLn h ("\n" ++ toMarked marker s)
|
||||
hFlush h
|
||||
|
||||
fromMarked :: Marker -> Marked -> Maybe String
|
||||
fromMarked marker s
|
||||
| null matches = Nothing
|
||||
| otherwise = Just $ intercalate "\n" $
|
||||
map (drop len) matches
|
||||
where
|
||||
len = length marker
|
||||
matches = filter (marker `isPrefixOf`) $ lines s
|
||||
|
||||
boot :: Host -> IO ()
|
||||
boot h = do
|
||||
sendMarked stdout statusMarker $ show Ready
|
||||
reply <- hGetContentsStrict stdin
|
||||
|
||||
makePrivDataDir
|
||||
maybe noop (writeFileProtected privDataLocal) $
|
||||
fromMarked privDataMarker reply
|
||||
mainProperties h
|
||||
|
||||
addKey :: String -> IO ()
|
||||
addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
|
||||
where
|
||||
gpg = do
|
||||
createDirectoryIfMissing True privDataDir
|
||||
boolSystem "sh"
|
||||
[ Param "-c"
|
||||
, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
|
||||
unwords (gpgopts ++ ["--import"])
|
||||
]
|
||||
gitadd = boolSystem "git"
|
||||
[ Param "add"
|
||||
, File keyring
|
||||
]
|
||||
|
||||
gitconfig = boolSystem "git"
|
||||
[ Param "config"
|
||||
, Param "user.signingkey"
|
||||
, Param keyid
|
||||
]
|
||||
|
||||
gitcommit = gitCommit
|
||||
[ File keyring
|
||||
, Param "-m"
|
||||
, Param "propellor addkey"
|
||||
]
|
||||
|
||||
{- Automatically sign the commit if there'a a keyring. -}
|
||||
gitCommit :: [CommandParam] -> IO Bool
|
||||
gitCommit ps = do
|
||||
k <- doesFileExist keyring
|
||||
boolSystem "git" $ catMaybes $
|
||||
[ Just (Param "commit")
|
||||
, if k then Just (Param "--gpg-sign") else Nothing
|
||||
] ++ map Just ps
|
||||
|
||||
keyring :: FilePath
|
||||
keyring = privDataDir </> "keyring.gpg"
|
||||
|
||||
gpgopts :: [String]
|
||||
gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
|
||||
|
||||
getUrl :: IO String
|
||||
getUrl = maybe nourl return =<< getM get urls
|
||||
where
|
||||
urls = ["remote.deploy.url", "remote.origin.url"]
|
||||
nourl = errorMessage $ "Cannot find deploy url in " ++ show urls
|
||||
get u = do
|
||||
v <- catchMaybeIO $
|
||||
takeWhile (/= '\n')
|
||||
<$> readProcess "git" ["config", u]
|
||||
return $ case v of
|
||||
Just url | not (null url) -> Just url
|
||||
_ -> Nothing
|
||||
|
||||
checkDebugMode :: IO ()
|
||||
checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
|
||||
where
|
||||
go (Just s)
|
||||
| s == "1" = do
|
||||
f <- setFormatter
|
||||
<$> streamHandler stderr DEBUG
|
||||
<*> pure (simpleLogFormatter "[$time] $msg")
|
||||
updateGlobalLogger rootLoggerName $
|
||||
setLevel DEBUG . setHandlers [f]
|
||||
go _ = noop
|
||||
|
||||
-- Parameters can be passed to both ssh and scp, to enable a ssh connection
|
||||
-- caching socket.
|
||||
--
|
||||
-- If the socket already exists, check if its mtime is older than 10
|
||||
-- minutes, and if so stop that ssh process, in order to not try to
|
||||
-- use an old stale connection. (atime would be nicer, but there's
|
||||
-- a good chance a laptop uses noatime)
|
||||
sshCachingParams :: HostName -> IO [CommandParam]
|
||||
sshCachingParams hn = do
|
||||
home <- myHomeDir
|
||||
let cachedir = home </> ".ssh" </> "propellor"
|
||||
createDirectoryIfMissing False cachedir
|
||||
let socketfile = cachedir </> hn ++ ".sock"
|
||||
let ps =
|
||||
[ Param "-o", Param ("ControlPath=" ++ socketfile)
|
||||
, Params "-o ControlMaster=auto -o ControlPersist=yes"
|
||||
]
|
||||
|
||||
maybe noop (expireold ps socketfile)
|
||||
=<< catchMaybeIO (getFileStatus socketfile)
|
||||
|
||||
return ps
|
||||
|
||||
where
|
||||
expireold ps f s = do
|
||||
now <- truncate <$> getPOSIXTime :: IO Integer
|
||||
if modificationTime s > fromIntegral now - tenminutes
|
||||
then touchFile f
|
||||
else do
|
||||
void $ boolSystem "ssh" $
|
||||
[ Params "-O stop" ] ++ ps ++
|
||||
[ Param "localhost" ]
|
||||
nukeFile f
|
||||
tenminutes = 600
|
|
@ -0,0 +1,49 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Engine where
|
||||
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import Data.Monoid
|
||||
import Control.Applicative
|
||||
import System.Console.ANSI
|
||||
import "mtl" Control.Monad.Reader
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Message
|
||||
import Propellor.Exception
|
||||
import Propellor.Info
|
||||
|
||||
runPropellor :: Host -> Propellor a -> IO a
|
||||
runPropellor host a = runReaderT (runWithHost a) host
|
||||
|
||||
mainProperties :: Host -> IO ()
|
||||
mainProperties host = do
|
||||
r <- runPropellor host $
|
||||
ensureProperties [Property "overall" (ensureProperties $ hostProperties host) mempty]
|
||||
setTitle "propellor: done"
|
||||
hFlush stdout
|
||||
case r of
|
||||
FailedChange -> exitWith (ExitFailure 1)
|
||||
_ -> exitWith ExitSuccess
|
||||
|
||||
ensureProperties :: [Property] -> Propellor Result
|
||||
ensureProperties ps = ensure ps NoChange
|
||||
where
|
||||
ensure [] rs = return rs
|
||||
ensure (l:ls) rs = do
|
||||
hn <- asks hostName
|
||||
r <- actionMessageOn hn (propertyDesc l) (ensureProperty l)
|
||||
ensure ls (r <> rs)
|
||||
|
||||
ensureProperty :: Property -> Propellor Result
|
||||
ensureProperty = catchPropellor . propertySatisfy
|
||||
|
||||
-- | Lifts an action into a different host.
|
||||
--
|
||||
-- For example, `fromHost hosts "otherhost" getSshPubKey`
|
||||
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
|
||||
fromHost l hn getter = case findHost l hn of
|
||||
Nothing -> return Nothing
|
||||
Just h -> liftIO $ Just <$>
|
||||
runReaderT (runWithHost getter) h
|
|
@ -0,0 +1,18 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Exception where
|
||||
|
||||
import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as M
|
||||
import Control.Exception
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Message
|
||||
|
||||
-- | Catches IO exceptions and returns FailedChange.
|
||||
catchPropellor :: Propellor Result -> Propellor Result
|
||||
catchPropellor a = either err return =<< tryPropellor a
|
||||
where
|
||||
err e = warningMessage (show e) >> return FailedChange
|
||||
|
||||
tryPropellor :: Propellor a -> Propellor (Either IOException a)
|
||||
tryPropellor = M.try
|
|
@ -0,0 +1,83 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Info where
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Types.Info
|
||||
|
||||
import "mtl" Control.Monad.Reader
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Control.Applicative
|
||||
|
||||
pureInfoProperty :: Desc -> Info -> Property
|
||||
pureInfoProperty desc = Property ("has " ++ desc) (return NoChange)
|
||||
|
||||
askInfo :: (Info -> Val a) -> Propellor (Maybe a)
|
||||
askInfo f = asks (fromVal . f . hostInfo)
|
||||
|
||||
os :: System -> Property
|
||||
os system = pureInfoProperty ("Operating " ++ show system) $
|
||||
mempty { _os = Val system }
|
||||
|
||||
getOS :: Propellor (Maybe System)
|
||||
getOS = askInfo _os
|
||||
|
||||
-- | Indidate that a host has an A record in the DNS.
|
||||
--
|
||||
-- TODO check at run time if the host really has this address.
|
||||
-- (Can't change the host's address, but as a sanity check.)
|
||||
ipv4 :: String -> Property
|
||||
ipv4 = addDNS . Address . IPv4
|
||||
|
||||
-- | Indidate that a host has an AAAA record in the DNS.
|
||||
ipv6 :: String -> Property
|
||||
ipv6 = addDNS . Address . IPv6
|
||||
|
||||
-- | Indicates another name for the host in the DNS.
|
||||
--
|
||||
-- When the host's ipv4/ipv6 addresses are known, the alias is set up
|
||||
-- to use their address, rather than using a CNAME. This avoids various
|
||||
-- problems with CNAMEs, and also means that when multiple hosts have the
|
||||
-- same alias, a DNS round-robin is automatically set up.
|
||||
alias :: Domain -> Property
|
||||
alias = addDNS . CNAME . AbsDomain
|
||||
|
||||
addDNS :: Record -> Property
|
||||
addDNS r = pureInfoProperty (rdesc r) $
|
||||
mempty { _dns = S.singleton r }
|
||||
where
|
||||
rdesc (CNAME d) = unwords ["alias", ddesc d]
|
||||
rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
|
||||
rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr]
|
||||
rdesc (MX n d) = unwords ["MX", show n, ddesc d]
|
||||
rdesc (NS d) = unwords ["NS", ddesc d]
|
||||
rdesc (TXT s) = unwords ["TXT", s]
|
||||
rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]
|
||||
|
||||
ddesc (AbsDomain domain) = domain
|
||||
ddesc (RelDomain domain) = domain
|
||||
ddesc RootDomain = "@"
|
||||
|
||||
sshPubKey :: String -> Property
|
||||
sshPubKey k = pureInfoProperty ("ssh pubkey known") $
|
||||
mempty { _sshPubKey = Val k }
|
||||
|
||||
getSshPubKey :: Propellor (Maybe String)
|
||||
getSshPubKey = askInfo _sshPubKey
|
||||
|
||||
hostMap :: [Host] -> M.Map HostName Host
|
||||
hostMap l = M.fromList $ zip (map hostName l) l
|
||||
|
||||
findHost :: [Host] -> HostName -> Maybe Host
|
||||
findHost l hn = M.lookup hn (hostMap l)
|
||||
|
||||
getAddresses :: Info -> [IPAddr]
|
||||
getAddresses = mapMaybe getIPAddr . S.toList . _dns
|
||||
|
||||
hostAddresses :: HostName -> [Host] -> [IPAddr]
|
||||
hostAddresses hn hosts = case hostInfo <$> findHost hosts hn of
|
||||
Nothing -> []
|
||||
Just info -> mapMaybe getIPAddr $ S.toList $ _dns info
|
|
@ -0,0 +1,66 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Message where
|
||||
|
||||
import System.Console.ANSI
|
||||
import System.IO
|
||||
import System.Log.Logger
|
||||
import "mtl" Control.Monad.Reader
|
||||
|
||||
import Propellor.Types
|
||||
|
||||
-- | Shows a message while performing an action, with a colored status
|
||||
-- display.
|
||||
actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
|
||||
actionMessage = actionMessage' Nothing
|
||||
|
||||
-- | Shows a message while performing an action on a specified host,
|
||||
-- with a colored status display.
|
||||
actionMessageOn :: (MonadIO m, ActionResult r) => HostName -> Desc -> m r -> m r
|
||||
actionMessageOn = actionMessage' . Just
|
||||
|
||||
actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
|
||||
actionMessage' mhn desc a = do
|
||||
liftIO $ do
|
||||
setTitle $ "propellor: " ++ desc
|
||||
hFlush stdout
|
||||
|
||||
r <- a
|
||||
|
||||
liftIO $ do
|
||||
setTitle "propellor: running"
|
||||
showhn mhn
|
||||
putStr $ desc ++ " ... "
|
||||
let (msg, intensity, color) = getActionResult r
|
||||
colorLine intensity color msg
|
||||
hFlush stdout
|
||||
|
||||
return r
|
||||
where
|
||||
showhn Nothing = return ()
|
||||
showhn (Just hn) = do
|
||||
setSGR [SetColor Foreground Dull Cyan]
|
||||
putStr (hn ++ " ")
|
||||
setSGR []
|
||||
|
||||
warningMessage :: MonadIO m => String -> m ()
|
||||
warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
|
||||
|
||||
colorLine :: ColorIntensity -> Color -> String -> IO ()
|
||||
colorLine intensity color msg = do
|
||||
setSGR [SetColor Foreground intensity color]
|
||||
putStr msg
|
||||
setSGR []
|
||||
-- Note this comes after the color is reset, so that
|
||||
-- the color set and reset happen in the same line.
|
||||
putStrLn ""
|
||||
hFlush stdout
|
||||
|
||||
errorMessage :: String -> IO a
|
||||
errorMessage s = do
|
||||
liftIO $ colorLine Vivid Red $ "** error: " ++ s
|
||||
error "Cannot continue!"
|
||||
|
||||
-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
|
||||
debug :: [String] -> IO ()
|
||||
debug = debugM "propellor" . unwords
|
|
@ -0,0 +1,175 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.PrivData where
|
||||
|
||||
import Control.Applicative
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import System.Directory
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.List
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
import "mtl" Control.Monad.Reader
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Types.Info
|
||||
import Propellor.Message
|
||||
import Propellor.Info
|
||||
import Utility.Monad
|
||||
import Utility.PartialPrelude
|
||||
import Utility.Exception
|
||||
import Utility.Process
|
||||
import Utility.Tmp
|
||||
import Utility.SafeCommand
|
||||
import Utility.Misc
|
||||
import Utility.FileMode
|
||||
import Utility.Env
|
||||
import Utility.Table
|
||||
|
||||
-- | Allows a Property to access the value of a specific PrivDataField,
|
||||
-- for use in a specific Context.
|
||||
--
|
||||
-- Example use:
|
||||
--
|
||||
-- > withPrivData (PrivFile pemfile) (Context "joeyh.name") $ \getdata ->
|
||||
-- > property "joeyh.name ssl cert" $ getdata $ \privdata ->
|
||||
-- > liftIO $ writeFile pemfile privdata
|
||||
-- > where pemfile = "/etc/ssl/certs/web.pem"
|
||||
--
|
||||
-- Note that if the value is not available, the action is not run
|
||||
-- and instead it prints a message to help the user make the necessary
|
||||
-- private data available.
|
||||
--
|
||||
-- The resulting Property includes Info about the PrivDataField
|
||||
-- being used, which is necessary to ensure that the privdata is sent to
|
||||
-- the remote host by propellor.
|
||||
withPrivData
|
||||
:: PrivDataField
|
||||
-> Context
|
||||
-> (((PrivData -> Propellor Result) -> Propellor Result) -> Property)
|
||||
-> Property
|
||||
withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a ->
|
||||
maybe missing a =<< liftIO (getLocalPrivData field context)
|
||||
where
|
||||
missing = liftIO $ do
|
||||
warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")"
|
||||
putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'"
|
||||
return FailedChange
|
||||
addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } }
|
||||
|
||||
addPrivDataField :: (PrivDataField, Context) -> Property
|
||||
addPrivDataField v = pureInfoProperty (show v) $
|
||||
mempty { _privDataFields = S.singleton v }
|
||||
|
||||
{- Gets the requested field's value, in the specified context if it's
|
||||
- available, from the host's local privdata cache. -}
|
||||
getLocalPrivData :: PrivDataField -> Context -> IO (Maybe PrivData)
|
||||
getLocalPrivData field context =
|
||||
getPrivData field context . fromMaybe M.empty <$> localcache
|
||||
where
|
||||
localcache = catchDefaultIO Nothing $ readish <$> readFile privDataLocal
|
||||
|
||||
type PrivMap = M.Map (PrivDataField, Context) PrivData
|
||||
|
||||
{- Get only the set of PrivData that the Host's Info says it uses. -}
|
||||
filterPrivData :: Host -> PrivMap -> PrivMap
|
||||
filterPrivData host = M.filterWithKey (\k _v -> S.member k used)
|
||||
where
|
||||
used = _privDataFields $ hostInfo host
|
||||
|
||||
getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData
|
||||
getPrivData field context = M.lookup (field, context)
|
||||
|
||||
setPrivData :: PrivDataField -> Context -> IO ()
|
||||
setPrivData field context = do
|
||||
putStrLn "Enter private data on stdin; ctrl-D when done:"
|
||||
setPrivDataTo field context =<< hGetContentsStrict stdin
|
||||
|
||||
dumpPrivData :: PrivDataField -> Context -> IO ()
|
||||
dumpPrivData field context =
|
||||
maybe (error "Requested privdata is not set.") putStrLn
|
||||
=<< (getPrivData field context <$> decryptPrivData)
|
||||
|
||||
editPrivData :: PrivDataField -> Context -> IO ()
|
||||
editPrivData field context = do
|
||||
v <- getPrivData field context <$> decryptPrivData
|
||||
v' <- withTmpFile "propellorXXXX" $ \f h -> do
|
||||
hClose h
|
||||
maybe noop (writeFileProtected f) v
|
||||
editor <- getEnvDefault "EDITOR" "vi"
|
||||
unlessM (boolSystem editor [File f]) $
|
||||
error "Editor failed; aborting."
|
||||
readFile f
|
||||
setPrivDataTo field context v'
|
||||
|
||||
listPrivDataFields :: [Host] -> IO ()
|
||||
listPrivDataFields hosts = do
|
||||
m <- decryptPrivData
|
||||
showtable "Currently set data:" $
|
||||
map mkrow (M.keys m)
|
||||
showtable "Data that would be used if set:" $
|
||||
map mkrow (M.keys $ M.difference wantedmap m)
|
||||
where
|
||||
header = ["Field", "Context", "Used by"]
|
||||
mkrow k@(field, (Context context)) =
|
||||
[ shellEscape $ show field
|
||||
, shellEscape context
|
||||
, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
|
||||
]
|
||||
mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $
|
||||
S.toList $ _privDataFields $ hostInfo host
|
||||
usedby = M.unionsWith (++) $ map mkhostmap hosts
|
||||
wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
|
||||
showtable desc rows = do
|
||||
putStrLn $ "\n" ++ desc
|
||||
putStr $ unlines $ formatTable $ tableWithHeader header rows
|
||||
|
||||
setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
|
||||
setPrivDataTo field context value = do
|
||||
makePrivDataDir
|
||||
m <- decryptPrivData
|
||||
let m' = M.insert (field, context) (chomp value) m
|
||||
gpgEncrypt privDataFile (show m')
|
||||
putStrLn "Private data set."
|
||||
void $ boolSystem "git" [Param "add", File privDataFile]
|
||||
where
|
||||
chomp s
|
||||
| end s == "\n" = chomp (beginning s)
|
||||
| otherwise = s
|
||||
|
||||
decryptPrivData :: IO PrivMap
|
||||
decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
|
||||
|
||||
makePrivDataDir :: IO ()
|
||||
makePrivDataDir = createDirectoryIfMissing False privDataDir
|
||||
|
||||
privDataDir :: FilePath
|
||||
privDataDir = "privdata"
|
||||
|
||||
privDataFile :: FilePath
|
||||
privDataFile = privDataDir </> "privdata.gpg"
|
||||
|
||||
privDataLocal :: FilePath
|
||||
privDataLocal = privDataDir </> "local"
|
||||
|
||||
gpgDecrypt :: FilePath -> IO String
|
||||
gpgDecrypt f = ifM (doesFileExist f)
|
||||
( readProcess "gpg" ["--decrypt", f]
|
||||
, return ""
|
||||
)
|
||||
|
||||
gpgEncrypt :: FilePath -> String -> IO ()
|
||||
gpgEncrypt f s = do
|
||||
encrypted <- writeReadProcessEnv "gpg"
|
||||
[ "--default-recipient-self"
|
||||
, "--armor"
|
||||
, "--encrypt"
|
||||
]
|
||||
Nothing
|
||||
(Just $ flip hPutStr s)
|
||||
Nothing
|
||||
viaTmp writeFile f encrypted
|
|
@ -0,0 +1,163 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Property where
|
||||
|
||||
import System.Directory
|
||||
import Control.Monad
|
||||
import Data.Monoid
|
||||
import Control.Monad.IfElse
|
||||
import "mtl" Control.Monad.Reader
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Info
|
||||
import Propellor.Engine
|
||||
import Utility.Monad
|
||||
import System.FilePath
|
||||
|
||||
-- Constructs a Property.
|
||||
property :: Desc -> Propellor Result -> Property
|
||||
property d s = Property d s mempty
|
||||
|
||||
-- | Combines a list of properties, resulting in a single property
|
||||
-- that when run will run each property in the list in turn,
|
||||
-- and print out the description of each as it's run. Does not stop
|
||||
-- on failure; does propigate overall success/failure.
|
||||
propertyList :: Desc -> [Property] -> Property
|
||||
propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)
|
||||
|
||||
-- | Combines a list of properties, resulting in one property that
|
||||
-- ensures each in turn. Does not stop on failure; does propigate
|
||||
-- overall success/failure.
|
||||
combineProperties :: Desc -> [Property] -> Property
|
||||
combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)
|
||||
where
|
||||
go [] rs = return rs
|
||||
go (l:ls) rs = do
|
||||
r <- ensureProperty l
|
||||
case r of
|
||||
FailedChange -> return FailedChange
|
||||
_ -> go ls (r <> rs)
|
||||
|
||||
-- | Combines together two properties, resulting in one property
|
||||
-- that ensures the first, and if the first succeeds, ensures the second.
|
||||
-- The property uses the description of the first property.
|
||||
before :: Property -> Property -> Property
|
||||
p1 `before` p2 = p2 `requires` p1
|
||||
`describe` (propertyDesc p1)
|
||||
|
||||
-- | Makes a perhaps non-idempotent Property be idempotent by using a flag
|
||||
-- file to indicate whether it has run before.
|
||||
-- Use with caution.
|
||||
flagFile :: Property -> FilePath -> Property
|
||||
flagFile p = flagFile' p . return
|
||||
|
||||
flagFile' :: Property -> IO FilePath -> Property
|
||||
flagFile' p getflagfile = adjustProperty p $ \satisfy -> do
|
||||
flagfile <- liftIO getflagfile
|
||||
go satisfy flagfile =<< liftIO (doesFileExist flagfile)
|
||||
where
|
||||
go _ _ True = return NoChange
|
||||
go satisfy flagfile False = do
|
||||
r <- satisfy
|
||||
when (r == MadeChange) $ liftIO $
|
||||
unlessM (doesFileExist flagfile) $ do
|
||||
createDirectoryIfMissing True (takeDirectory flagfile)
|
||||
writeFile flagfile ""
|
||||
return r
|
||||
|
||||
--- | Whenever a change has to be made for a Property, causes a hook
|
||||
-- Property to also be run, but not otherwise.
|
||||
onChange :: Property -> Property -> Property
|
||||
p `onChange` hook = Property (propertyDesc p) satisfy (combineInfo p hook)
|
||||
where
|
||||
satisfy = do
|
||||
r <- ensureProperty p
|
||||
case r of
|
||||
MadeChange -> do
|
||||
r' <- ensureProperty hook
|
||||
return $ r <> r'
|
||||
_ -> return r
|
||||
|
||||
(==>) :: Desc -> Property -> Property
|
||||
(==>) = flip describe
|
||||
infixl 1 ==>
|
||||
|
||||
-- | Makes a Property only need to do anything when a test succeeds.
|
||||
check :: IO Bool -> Property -> Property
|
||||
check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)
|
||||
( satisfy
|
||||
, return NoChange
|
||||
)
|
||||
|
||||
-- | Marks a Property as trivial. It can only return FailedChange or
|
||||
-- NoChange.
|
||||
--
|
||||
-- Useful when it's just as expensive to check if a change needs
|
||||
-- to be made as it is to just idempotently assure the property is
|
||||
-- satisfied. For example, chmodding a file.
|
||||
trivial :: Property -> Property
|
||||
trivial p = adjustProperty p $ \satisfy -> do
|
||||
r <- satisfy
|
||||
if r == MadeChange
|
||||
then return NoChange
|
||||
else return r
|
||||
|
||||
doNothing :: Property
|
||||
doNothing = property "noop property" noChange
|
||||
|
||||
-- | Makes a property that is satisfied differently depending on the host's
|
||||
-- operating system.
|
||||
--
|
||||
-- Note that the operating system may not be declared for some hosts.
|
||||
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
|
||||
withOS desc a = property desc $ a =<< getOS
|
||||
|
||||
boolProperty :: Desc -> IO Bool -> Property
|
||||
boolProperty desc a = property desc $ ifM (liftIO a)
|
||||
( return MadeChange
|
||||
, return FailedChange
|
||||
)
|
||||
|
||||
-- | Undoes the effect of a property.
|
||||
revert :: RevertableProperty -> RevertableProperty
|
||||
revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
|
||||
|
||||
-- | Starts accumulating the properties of a Host.
|
||||
--
|
||||
-- > host "example.com"
|
||||
-- > & someproperty
|
||||
-- > ! oldproperty
|
||||
-- > & otherproperty
|
||||
host :: HostName -> Host
|
||||
host hn = Host hn [] mempty
|
||||
|
||||
-- | Adds a property to a Host
|
||||
--
|
||||
-- Can add Properties and RevertableProperties
|
||||
(&) :: IsProp p => Host -> p -> Host
|
||||
(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getInfo p)
|
||||
|
||||
infixl 1 &
|
||||
|
||||
-- | Adds a property to the Host in reverted form.
|
||||
(!) :: Host -> RevertableProperty -> Host
|
||||
h ! p = h & revert p
|
||||
|
||||
infixl 1 !
|
||||
|
||||
-- Changes the action that is performed to satisfy a property.
|
||||
adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property
|
||||
adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }
|
||||
|
||||
-- Combines the Info of two properties.
|
||||
combineInfo :: (IsProp p, IsProp q) => p -> q -> Info
|
||||
combineInfo p q = getInfo p <> getInfo q
|
||||
|
||||
combineInfos :: IsProp p => [p] -> Info
|
||||
combineInfos = mconcat . map getInfo
|
||||
|
||||
makeChange :: IO () -> Propellor Result
|
||||
makeChange a = liftIO a >> return MadeChange
|
||||
|
||||
noChange :: Propellor Result
|
||||
noChange = return NoChange
|
|
@ -0,0 +1,62 @@
|
|||
module Propellor.Property.Apache where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Service as Service
|
||||
|
||||
type ConfigFile = [String]
|
||||
|
||||
siteEnabled :: HostName -> ConfigFile -> RevertableProperty
|
||||
siteEnabled hn cf = RevertableProperty enable disable
|
||||
where
|
||||
enable = trivial $ cmdProperty "a2ensite" ["--quiet", hn]
|
||||
`describe` ("apache site enabled " ++ hn)
|
||||
`requires` siteAvailable hn cf
|
||||
`requires` installed
|
||||
`onChange` reloaded
|
||||
disable = trivial $ File.notPresent (siteCfg hn)
|
||||
`describe` ("apache site disabled " ++ hn)
|
||||
`onChange` cmdProperty "a2dissite" ["--quiet", hn]
|
||||
`requires` installed
|
||||
`onChange` reloaded
|
||||
|
||||
siteAvailable :: HostName -> ConfigFile -> Property
|
||||
siteAvailable hn cf = siteCfg hn `File.hasContent` (comment:cf)
|
||||
`describe` ("apache site available " ++ hn)
|
||||
where
|
||||
comment = "# deployed with propellor, do not modify"
|
||||
|
||||
modEnabled :: String -> RevertableProperty
|
||||
modEnabled modname = RevertableProperty enable disable
|
||||
where
|
||||
enable = trivial $ cmdProperty "a2enmod" ["--quiet", modname]
|
||||
`describe` ("apache module enabled " ++ modname)
|
||||
`requires` installed
|
||||
`onChange` reloaded
|
||||
disable = trivial $ cmdProperty "a2dismod" ["--quiet", modname]
|
||||
`describe` ("apache module disabled " ++ modname)
|
||||
`requires` installed
|
||||
`onChange` reloaded
|
||||
|
||||
siteCfg :: HostName -> FilePath
|
||||
siteCfg hn = "/etc/apache2/sites-available/" ++ hn
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.installed ["apache2"]
|
||||
|
||||
restarted :: Property
|
||||
restarted = cmdProperty "service" ["apache2", "restart"]
|
||||
|
||||
reloaded :: Property
|
||||
reloaded = Service.reloaded "apache2"
|
||||
|
||||
-- | Configure apache to use SNI to differentiate between
|
||||
-- https hosts.
|
||||
multiSSL :: Property
|
||||
multiSSL = "/etc/apache2/conf.d/ssl" `File.hasContent`
|
||||
[ "NameVirtualHost *:443"
|
||||
, "SSLStrictSNIVHostCheck off"
|
||||
]
|
||||
`describe` "apache SNI enabled"
|
||||
`onChange` reloaded
|
|
@ -0,0 +1,269 @@
|
|||
module Propellor.Property.Apt where
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Applicative
|
||||
import Data.List
|
||||
import System.IO
|
||||
import Control.Monad
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Service as Service
|
||||
import Propellor.Property.File (Line)
|
||||
|
||||
sourcesList :: FilePath
|
||||
sourcesList = "/etc/apt/sources.list"
|
||||
|
||||
type Url = String
|
||||
type Section = String
|
||||
|
||||
type SourcesGenerator = DebianSuite -> [Line]
|
||||
|
||||
showSuite :: DebianSuite -> String
|
||||
showSuite Stable = "stable"
|
||||
showSuite Testing = "testing"
|
||||
showSuite Unstable = "unstable"
|
||||
showSuite Experimental = "experimental"
|
||||
showSuite (DebianRelease r) = r
|
||||
|
||||
backportSuite :: String
|
||||
backportSuite = showSuite stableRelease ++ "-backports"
|
||||
|
||||
debLine :: String -> Url -> [Section] -> Line
|
||||
debLine suite mirror sections = unwords $
|
||||
["deb", mirror, suite] ++ sections
|
||||
|
||||
srcLine :: Line -> Line
|
||||
srcLine l = case words l of
|
||||
("deb":rest) -> unwords $ "deb-src" : rest
|
||||
_ -> ""
|
||||
|
||||
stdSections :: [Section]
|
||||
stdSections = ["main", "contrib", "non-free"]
|
||||
|
||||
binandsrc :: String -> SourcesGenerator
|
||||
binandsrc url suite
|
||||
| isStable suite = [l, srcLine l, bl, srcLine bl]
|
||||
| otherwise = [l, srcLine l]
|
||||
where
|
||||
l = debLine (showSuite suite) url stdSections
|
||||
bl = debLine backportSuite url stdSections
|
||||
|
||||
debCdn :: SourcesGenerator
|
||||
debCdn = binandsrc "http://cdn.debian.net/debian"
|
||||
|
||||
kernelOrg :: SourcesGenerator
|
||||
kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
|
||||
|
||||
-- | Only available for Stable and Testing
|
||||
securityUpdates :: SourcesGenerator
|
||||
securityUpdates suite
|
||||
| isStable suite || suite == Testing =
|
||||
let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections
|
||||
in [l, srcLine l]
|
||||
| otherwise = []
|
||||
|
||||
-- | Makes sources.list have a standard content using the mirror CDN,
|
||||
-- with the Debian suite configured by the os.
|
||||
--
|
||||
-- Since the CDN is sometimes unreliable, also adds backup lines using
|
||||
-- kernel.org.
|
||||
stdSourcesList :: Property
|
||||
stdSourcesList = withOS ("standard sources.list") $ \o ->
|
||||
case o of
|
||||
(Just (System (Debian suite) _)) ->
|
||||
ensureProperty $ stdSourcesListFor suite
|
||||
_ -> error "os is not declared to be Debian"
|
||||
|
||||
stdSourcesListFor :: DebianSuite -> Property
|
||||
stdSourcesListFor suite = stdSourcesList' suite []
|
||||
|
||||
-- | Adds additional sources.list generators.
|
||||
--
|
||||
-- Note that if a Property needs to enable an apt source, it's better
|
||||
-- to do so via a separate file in /etc/apt/sources.list.d/
|
||||
stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property
|
||||
stdSourcesList' suite more = setSourcesList
|
||||
(concatMap (\gen -> gen suite) generators)
|
||||
`describe` ("standard sources.list for " ++ show suite)
|
||||
where
|
||||
generators = [debCdn, kernelOrg, securityUpdates] ++ more
|
||||
|
||||
setSourcesList :: [Line] -> Property
|
||||
setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
|
||||
|
||||
setSourcesListD :: [Line] -> FilePath -> Property
|
||||
setSourcesListD ls basename = f `File.hasContent` ls `onChange` update
|
||||
where
|
||||
f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"
|
||||
|
||||
runApt :: [String] -> Property
|
||||
runApt ps = cmdProperty' "apt-get" ps noninteractiveEnv
|
||||
|
||||
noninteractiveEnv :: [(String, String)]
|
||||
noninteractiveEnv =
|
||||
[ ("DEBIAN_FRONTEND", "noninteractive")
|
||||
, ("APT_LISTCHANGES_FRONTEND", "none")
|
||||
]
|
||||
|
||||
update :: Property
|
||||
update = runApt ["update"]
|
||||
`describe` "apt update"
|
||||
|
||||
upgrade :: Property
|
||||
upgrade = runApt ["-y", "dist-upgrade"]
|
||||
`describe` "apt dist-upgrade"
|
||||
|
||||
type Package = String
|
||||
|
||||
installed :: [Package] -> Property
|
||||
installed = installed' ["-y"]
|
||||
|
||||
installed' :: [String] -> [Package] -> Property
|
||||
installed' params ps = robustly $ check (isInstallable ps) go
|
||||
`describe` (unwords $ "apt installed":ps)
|
||||
where
|
||||
go = runApt $ params ++ ["install"] ++ ps
|
||||
|
||||
installedBackport :: [Package] -> Property
|
||||
installedBackport ps = trivial $ withOS desc $ \o -> case o of
|
||||
Nothing -> error "cannot install backports; os not declared"
|
||||
(Just (System (Debian suite) _))
|
||||
| isStable suite ->
|
||||
ensureProperty $ runApt $
|
||||
["install", "-t", backportSuite, "-y"] ++ ps
|
||||
_ -> error $ "backports not supported on " ++ show o
|
||||
where
|
||||
desc = (unwords $ "apt installed backport":ps)
|
||||
|
||||
-- | Minimal install of package, without recommends.
|
||||
installedMin :: [Package] -> Property
|
||||
installedMin = installed' ["--no-install-recommends", "-y"]
|
||||
|
||||
removed :: [Package] -> Property
|
||||
removed ps = check (or <$> isInstalled' ps) go
|
||||
`describe` (unwords $ "apt removed":ps)
|
||||
where
|
||||
go = runApt $ ["-y", "remove"] ++ ps
|
||||
|
||||
buildDep :: [Package] -> Property
|
||||
buildDep ps = robustly go
|
||||
`describe` (unwords $ "apt build-dep":ps)
|
||||
where
|
||||
go = runApt $ ["-y", "build-dep"] ++ ps
|
||||
|
||||
-- | Installs the build deps for the source package unpacked
|
||||
-- in the specifed directory, with a dummy package also
|
||||
-- installed so that autoRemove won't remove them.
|
||||
buildDepIn :: FilePath -> Property
|
||||
buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
|
||||
where
|
||||
go = cmdProperty' "sh" ["-c", "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"]
|
||||
noninteractiveEnv
|
||||
|
||||
-- | Package installation may fail becuse the archive has changed.
|
||||
-- Run an update in that case and retry.
|
||||
robustly :: Property -> Property
|
||||
robustly p = adjustProperty p $ \satisfy -> do
|
||||
r <- satisfy
|
||||
if r == FailedChange
|
||||
then ensureProperty $ p `requires` update
|
||||
else return r
|
||||
|
||||
isInstallable :: [Package] -> IO Bool
|
||||
isInstallable ps = do
|
||||
l <- isInstalled' ps
|
||||
return $ any (== False) l && not (null l)
|
||||
|
||||
isInstalled :: Package -> IO Bool
|
||||
isInstalled p = (== [True]) <$> isInstalled' [p]
|
||||
|
||||
-- | Note that the order of the returned list will not always
|
||||
-- correspond to the order of the input list. The number of items may
|
||||
-- even vary. If apt does not know about a package at all, it will not
|
||||
-- be included in the result list.
|
||||
isInstalled' :: [Package] -> IO [Bool]
|
||||
isInstalled' ps = catMaybes . map parse . lines
|
||||
<$> readProcess "apt-cache" ("policy":ps)
|
||||
where
|
||||
parse l
|
||||
| "Installed: (none)" `isInfixOf` l = Just False
|
||||
| "Installed: " `isInfixOf` l = Just True
|
||||
| otherwise = Nothing
|
||||
|
||||
autoRemove :: Property
|
||||
autoRemove = runApt ["-y", "autoremove"]
|
||||
`describe` "apt autoremove"
|
||||
|
||||
-- | Enables unattended upgrades. Revert to disable.
|
||||
unattendedUpgrades :: RevertableProperty
|
||||
unattendedUpgrades = RevertableProperty enable disable
|
||||
where
|
||||
enable = setup True
|
||||
`before` Service.running "cron"
|
||||
`before` configure
|
||||
disable = setup False
|
||||
|
||||
setup enabled = (if enabled then installed else removed) ["unattended-upgrades"]
|
||||
`onChange` reConfigure "unattended-upgrades"
|
||||
[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
|
||||
`describe` ("unattended upgrades " ++ v)
|
||||
where
|
||||
v
|
||||
| enabled = "true"
|
||||
| otherwise = "false"
|
||||
|
||||
configure = withOS "unattended upgrades configured" $ \o ->
|
||||
case o of
|
||||
-- the package defaults to only upgrading stable
|
||||
(Just (System (Debian suite) _))
|
||||
| not (isStable suite) -> ensureProperty $
|
||||
"/etc/apt/apt.conf.d/50unattended-upgrades"
|
||||
`File.containsLine`
|
||||
("Unattended-Upgrade::Origins-Pattern { \"o=Debian,a="++showSuite suite++"\"; };")
|
||||
_ -> noChange
|
||||
|
||||
-- | Preseeds debconf values and reconfigures the package so it takes
|
||||
-- effect.
|
||||
reConfigure :: Package -> [(String, String, String)] -> Property
|
||||
reConfigure package vals = reconfigure `requires` setselections
|
||||
`describe` ("reconfigure " ++ package)
|
||||
where
|
||||
setselections = property "preseed" $ makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "debconf-set-selections" []) $ \h -> do
|
||||
forM_ vals $ \(tmpl, tmpltype, value) ->
|
||||
hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
|
||||
hClose h
|
||||
reconfigure = cmdProperty' "dpkg-reconfigure" ["-fnone", package] noninteractiveEnv
|
||||
|
||||
-- | Ensures that a service is installed and running.
|
||||
--
|
||||
-- Assumes that there is a 1:1 mapping between service names and apt
|
||||
-- package names.
|
||||
serviceInstalledRunning :: Package -> Property
|
||||
serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
|
||||
|
||||
data AptKey = AptKey
|
||||
{ keyname :: String
|
||||
, pubkey :: String
|
||||
}
|
||||
|
||||
trustsKey :: AptKey -> RevertableProperty
|
||||
trustsKey k = RevertableProperty trust untrust
|
||||
where
|
||||
desc = "apt trusts key " ++ keyname k
|
||||
f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"
|
||||
untrust = File.notPresent f
|
||||
trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do
|
||||
hPutStr h (pubkey k)
|
||||
hClose h
|
||||
nukeFile $ f ++ "~" -- gpg dropping
|
||||
|
||||
-- | Cleans apt's cache of downloaded packages to avoid using up disk
|
||||
-- space.
|
||||
cacheCleaned :: Property
|
||||
cacheCleaned = trivial $ cmdProperty "apt-get" ["clean"]
|
||||
`describe` "apt cache cleaned"
|
|
@ -0,0 +1,49 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
|
||||
module Propellor.Property.Cmd (
|
||||
cmdProperty,
|
||||
cmdProperty',
|
||||
scriptProperty,
|
||||
userScriptProperty,
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.List
|
||||
import "mtl" Control.Monad.Reader
|
||||
|
||||
import Propellor.Types
|
||||
import Propellor.Property
|
||||
import Utility.Monad
|
||||
import Utility.SafeCommand
|
||||
import Utility.Env
|
||||
|
||||
-- | A property that can be satisfied by running a command.
|
||||
--
|
||||
-- The command must exit 0 on success.
|
||||
cmdProperty :: String -> [String] -> Property
|
||||
cmdProperty cmd params = cmdProperty' cmd params []
|
||||
|
||||
-- | A property that can be satisfied by running a command,
|
||||
-- with added environment.
|
||||
cmdProperty' :: String -> [String] -> [(String, String)] -> Property
|
||||
cmdProperty' cmd params env = property desc $ liftIO $ do
|
||||
env' <- addEntries env <$> getEnvironment
|
||||
ifM (boolSystemEnv cmd (map Param params) (Just env'))
|
||||
( return MadeChange
|
||||
, return FailedChange
|
||||
)
|
||||
where
|
||||
desc = unwords $ cmd : params
|
||||
|
||||
-- | A property that can be satisfied by running a series of shell commands.
|
||||
scriptProperty :: [String] -> Property
|
||||
scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
|
||||
where
|
||||
shellcmd = intercalate " ; " ("set -e" : script)
|
||||
|
||||
-- | A property that can satisfied by running a series of shell commands,
|
||||
-- as user (cd'd to their home directory).
|
||||
userScriptProperty :: UserName -> [String] -> Property
|
||||
userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
|
||||
where
|
||||
shellcmd = intercalate " ; " ("set -e" : "cd" : script)
|
|
@ -0,0 +1,49 @@
|
|||
module Propellor.Property.Cron where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import Utility.SafeCommand
|
||||
|
||||
import Data.Char
|
||||
|
||||
type CronTimes = String
|
||||
|
||||
-- | Installs a cron job, run as a specified user, in a particular
|
||||
-- directory. Note that the Desc must be unique, as it is used for the
|
||||
-- cron.d/ 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.
|
||||
--
|
||||
-- The cron job's output will only be emailed if it exits nonzero.
|
||||
job :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
|
||||
job desc times user cddir command = cronjobfile `File.hasContent`
|
||||
[ "# Generated by propellor"
|
||||
, ""
|
||||
, "SHELL=/bin/sh"
|
||||
, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
|
||||
, ""
|
||||
, times ++ "\t" ++ user ++ "\t"
|
||||
++ "chronic flock -n " ++ shellEscape cronjobfile
|
||||
++ " sh -c " ++ shellEscape cmdline
|
||||
]
|
||||
`requires` Apt.serviceInstalledRunning "cron"
|
||||
`requires` Apt.installed ["util-linux", "moreutils"]
|
||||
`describe` ("cronned " ++ desc)
|
||||
where
|
||||
cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )"
|
||||
cronjobfile = "/etc/cron.d/" ++ map sanitize desc
|
||||
sanitize c
|
||||
| isAlphaNum c = c
|
||||
| otherwise = '_'
|
||||
|
||||
-- | Installs a cron job, and runs it niced and ioniced.
|
||||
niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
|
||||
niceJob desc times user cddir command = job desc times user cddir
|
||||
("nice ionice -c 3 " ++ command)
|
||||
|
||||
-- | Installs a cron job to run propellor.
|
||||
runPropellor :: CronTimes -> Property
|
||||
runPropellor times = niceJob "propellor" times "root" localdir "make"
|
|
@ -0,0 +1,426 @@
|
|||
module Propellor.Property.Dns (
|
||||
module Propellor.Types.Dns,
|
||||
primary,
|
||||
secondary,
|
||||
secondaryFor,
|
||||
mkSOA,
|
||||
writeZoneFile,
|
||||
nextSerialNumber,
|
||||
adjustSerialNumber,
|
||||
serialNumberOffset,
|
||||
WarningMessage,
|
||||
genZone,
|
||||
) where
|
||||
|
||||
import Propellor
|
||||
import Propellor.Types.Dns
|
||||
import Propellor.Property.File
|
||||
import Propellor.Types.Info
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Service as Service
|
||||
import Utility.Applicative
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Data.List
|
||||
|
||||
-- | Primary dns server for a domain.
|
||||
--
|
||||
-- Most of the content of the zone file is configured by setting properties
|
||||
-- of hosts. For example,
|
||||
--
|
||||
-- > host "foo.example.com"
|
||||
-- > & ipv4 "192.168.1.1"
|
||||
-- > & alias "mail.exmaple.com"
|
||||
--
|
||||
-- Will cause that hostmame and its alias to appear in the zone file,
|
||||
-- with the configured IP address.
|
||||
--
|
||||
-- The [(BindDomain, Record)] list can be used for additional records
|
||||
-- that cannot be configured elsewhere. This often includes NS records,
|
||||
-- TXT records and perhaps CNAMEs pointing at hosts that propellor does
|
||||
-- not control.
|
||||
--
|
||||
-- The primary server is configured to only allow zone transfers to
|
||||
-- secondary dns servers. These are determined in two ways:
|
||||
--
|
||||
-- 1. By looking at the properties of other hosts, to find hosts that
|
||||
-- are configured as the secondary dns server.
|
||||
--
|
||||
-- 2. By looking for NS Records in the passed list of records.
|
||||
--
|
||||
-- In either case, the secondary dns server Host should have an ipv4 and/or
|
||||
-- ipv6 property defined.
|
||||
primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
|
||||
primary hosts domain soa rs = RevertableProperty setup cleanup
|
||||
where
|
||||
setup = withwarnings (check needupdate baseprop)
|
||||
`requires` servingZones
|
||||
`onChange` Service.reloaded "bind9"
|
||||
cleanup = check (doesFileExist zonefile) $
|
||||
property ("removed dns primary for " ++ domain)
|
||||
(makeChange $ removeZoneFile zonefile)
|
||||
`requires` namedConfWritten
|
||||
`onChange` Service.reloaded "bind9"
|
||||
|
||||
(partialzone, zonewarnings) = genZone hosts domain soa
|
||||
zone = partialzone { zHosts = zHosts partialzone ++ rs }
|
||||
zonefile = "/etc/bind/propellor/db." ++ domain
|
||||
baseprop = Property ("dns primary for " ++ domain)
|
||||
(makeChange $ writeZoneFile zone zonefile)
|
||||
(addNamedConf conf)
|
||||
withwarnings p = adjustProperty p $ \satisfy -> do
|
||||
mapM_ warningMessage $ zonewarnings ++ secondarywarnings
|
||||
satisfy
|
||||
conf = NamedConf
|
||||
{ confDomain = domain
|
||||
, confDnsServerType = Master
|
||||
, confFile = zonefile
|
||||
, confMasters = []
|
||||
, confAllowTransfer = nub $
|
||||
concatMap (\h -> hostAddresses h hosts) $
|
||||
secondaries ++ nssecondaries
|
||||
, confLines = []
|
||||
}
|
||||
secondaries = otherServers Secondary hosts domain
|
||||
secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
|
||||
filter (\h -> null (hostAddresses h hosts)) secondaries
|
||||
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
|
||||
rootRecords = map snd $
|
||||
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
|
||||
needupdate = do
|
||||
v <- readZonePropellorFile zonefile
|
||||
return $ case v of
|
||||
Nothing -> True
|
||||
Just oldzone ->
|
||||
-- compare everything except serial
|
||||
let oldserial = sSerial (zSOA oldzone)
|
||||
z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
|
||||
in z /= oldzone || oldserial < sSerial (zSOA zone)
|
||||
|
||||
-- | Secondary dns server for a domain.
|
||||
--
|
||||
-- The primary server is determined by looking at the properties of other
|
||||
-- hosts to find which one is configured as the primary.
|
||||
--
|
||||
-- Note that if a host is declared to be a primary and a secondary dns
|
||||
-- server for the same domain, the primary server config always wins.
|
||||
secondary :: [Host] -> Domain -> RevertableProperty
|
||||
secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
|
||||
|
||||
-- | This variant is useful if the primary server does not have its DNS
|
||||
-- configured via propellor.
|
||||
secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
|
||||
secondaryFor masters hosts domain = RevertableProperty setup cleanup
|
||||
where
|
||||
setup = pureInfoProperty desc (addNamedConf conf)
|
||||
`requires` servingZones
|
||||
cleanup = namedConfWritten
|
||||
|
||||
desc = "dns secondary for " ++ domain
|
||||
conf = NamedConf
|
||||
{ confDomain = domain
|
||||
, confDnsServerType = Secondary
|
||||
, confFile = "db." ++ domain
|
||||
, confMasters = concatMap (\m -> hostAddresses m hosts) masters
|
||||
, confAllowTransfer = []
|
||||
, confLines = []
|
||||
}
|
||||
|
||||
otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
|
||||
otherServers wantedtype hosts domain =
|
||||
M.keys $ M.filter wanted $ hostMap hosts
|
||||
where
|
||||
wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostInfo h) of
|
||||
Nothing -> False
|
||||
Just conf -> confDnsServerType conf == wantedtype
|
||||
&& confDomain conf == domain
|
||||
|
||||
-- | Rewrites the whole named.conf.local file to serve the zones
|
||||
-- configured by `primary` and `secondary`, and ensures that bind9 is
|
||||
-- running.
|
||||
servingZones :: Property
|
||||
servingZones = namedConfWritten
|
||||
`onChange` Service.reloaded "bind9"
|
||||
`requires` Apt.serviceInstalledRunning "bind9"
|
||||
|
||||
namedConfWritten :: Property
|
||||
namedConfWritten = property "named.conf configured" $ do
|
||||
zs <- getNamedConf
|
||||
ensureProperty $
|
||||
hasContent namedConfFile $
|
||||
concatMap confStanza $ M.elems zs
|
||||
|
||||
confStanza :: NamedConf -> [Line]
|
||||
confStanza c =
|
||||
[ "// automatically generated by propellor"
|
||||
, "zone \"" ++ confDomain c ++ "\" {"
|
||||
, cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
|
||||
, cfgline "file" ("\"" ++ confFile c ++ "\"")
|
||||
] ++
|
||||
mastersblock ++
|
||||
allowtransferblock ++
|
||||
(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
|
||||
[ "};"
|
||||
, ""
|
||||
]
|
||||
where
|
||||
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
|
||||
ipblock name l =
|
||||
[ "\t" ++ name ++ " {" ] ++
|
||||
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
|
||||
[ "\t};" ]
|
||||
mastersblock
|
||||
| null (confMasters c) = []
|
||||
| otherwise = ipblock "masters" (confMasters c)
|
||||
-- an empty block prohibits any transfers
|
||||
allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
|
||||
|
||||
namedConfFile :: FilePath
|
||||
namedConfFile = "/etc/bind/named.conf.local"
|
||||
|
||||
-- | Generates a SOA with some fairly sane numbers in it.
|
||||
--
|
||||
-- The Domain is the domain to use in the SOA record. Typically
|
||||
-- something like ns1.example.com. So, not the domain that this is the SOA
|
||||
-- record for.
|
||||
--
|
||||
-- The SerialNumber can be whatever serial number was used by the domain
|
||||
-- before propellor started managing it. Or 0 if the domain has only ever
|
||||
-- been managed by propellor.
|
||||
--
|
||||
-- You do not need to increment the SerialNumber when making changes!
|
||||
-- Propellor will automatically add the number of commits in the git
|
||||
-- repository to the SerialNumber.
|
||||
mkSOA :: Domain -> SerialNumber -> SOA
|
||||
mkSOA d sn = SOA
|
||||
{ sDomain = AbsDomain d
|
||||
, sSerial = sn
|
||||
, sRefresh = hours 4
|
||||
, sRetry = hours 1
|
||||
, sExpire = 2419200 -- 4 weeks
|
||||
, sNegativeCacheTTL = hours 8
|
||||
}
|
||||
where
|
||||
hours n = n * 60 * 60
|
||||
|
||||
dValue :: BindDomain -> String
|
||||
dValue (RelDomain d) = d
|
||||
dValue (AbsDomain d) = d ++ "."
|
||||
dValue (RootDomain) = "@"
|
||||
|
||||
rField :: Record -> String
|
||||
rField (Address (IPv4 _)) = "A"
|
||||
rField (Address (IPv6 _)) = "AAAA"
|
||||
rField (CNAME _) = "CNAME"
|
||||
rField (MX _ _) = "MX"
|
||||
rField (NS _) = "NS"
|
||||
rField (TXT _) = "TXT"
|
||||
rField (SRV _ _ _ _) = "SRV"
|
||||
|
||||
rValue :: Record -> String
|
||||
rValue (Address (IPv4 addr)) = addr
|
||||
rValue (Address (IPv6 addr)) = addr
|
||||
rValue (CNAME d) = dValue d
|
||||
rValue (MX pri d) = show pri ++ " " ++ dValue d
|
||||
rValue (NS d) = dValue d
|
||||
rValue (SRV priority weight port target) = unwords
|
||||
[ show priority
|
||||
, show weight
|
||||
, show port
|
||||
, dValue target
|
||||
]
|
||||
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
|
||||
where
|
||||
q = '"'
|
||||
|
||||
-- | Adjusts the serial number of the zone to always be larger
|
||||
-- than the serial number in the Zone record,
|
||||
-- and always be larger than the passed SerialNumber.
|
||||
nextSerialNumber :: Zone -> SerialNumber -> Zone
|
||||
nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
|
||||
|
||||
adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
|
||||
adjustSerialNumber (Zone d soa l) f = Zone d soa' l
|
||||
where
|
||||
soa' = soa { sSerial = f (sSerial soa) }
|
||||
|
||||
-- | Count the number of git commits made to the current branch.
|
||||
serialNumberOffset :: IO SerialNumber
|
||||
serialNumberOffset = fromIntegral . length . lines
|
||||
<$> readProcess "git" ["log", "--pretty=%H"]
|
||||
|
||||
-- | Write a Zone out to a to a file.
|
||||
--
|
||||
-- The serial number in the Zone automatically has the serialNumberOffset
|
||||
-- added to it. Also, just in case, the old serial number used in the zone
|
||||
-- file is checked, and if it is somehow larger, its succ is used.
|
||||
writeZoneFile :: Zone -> FilePath -> IO ()
|
||||
writeZoneFile z f = do
|
||||
oldserial <- oldZoneFileSerialNumber f
|
||||
offset <- serialNumberOffset
|
||||
let z' = nextSerialNumber
|
||||
(adjustSerialNumber z (+ offset))
|
||||
oldserial
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
writeFile f (genZoneFile z')
|
||||
writeZonePropellorFile f z'
|
||||
|
||||
removeZoneFile :: FilePath -> IO ()
|
||||
removeZoneFile f = do
|
||||
nukeFile f
|
||||
nukeFile (zonePropellorFile f)
|
||||
|
||||
-- | Next to the zone file, is a ".propellor" file, which contains
|
||||
-- the serialized Zone. This saves the bother of parsing
|
||||
-- the horrible bind zone file format.
|
||||
zonePropellorFile :: FilePath -> FilePath
|
||||
zonePropellorFile f = f ++ ".propellor"
|
||||
|
||||
oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
|
||||
oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
|
||||
|
||||
writeZonePropellorFile :: FilePath -> Zone -> IO ()
|
||||
writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
|
||||
|
||||
readZonePropellorFile :: FilePath -> IO (Maybe Zone)
|
||||
readZonePropellorFile f = catchDefaultIO Nothing $
|
||||
readish <$> readFileStrict (zonePropellorFile f)
|
||||
|
||||
-- | Generating a zone file.
|
||||
genZoneFile :: Zone -> String
|
||||
genZoneFile (Zone zdomain soa rs) = unlines $
|
||||
header : genSOA soa ++ map (genRecord zdomain) rs
|
||||
where
|
||||
header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
|
||||
|
||||
genRecord :: Domain -> (BindDomain, Record) -> String
|
||||
genRecord zdomain (domain, record) = intercalate "\t"
|
||||
[ domainHost zdomain domain
|
||||
, "IN"
|
||||
, rField record
|
||||
, rValue record
|
||||
]
|
||||
|
||||
genSOA :: SOA -> [String]
|
||||
genSOA soa =
|
||||
-- "@ IN SOA ns1.example.com. root ("
|
||||
[ intercalate "\t"
|
||||
[ dValue RootDomain
|
||||
, "IN"
|
||||
, "SOA"
|
||||
, dValue (sDomain soa)
|
||||
, "root"
|
||||
, "("
|
||||
]
|
||||
, headerline sSerial "Serial"
|
||||
, headerline sRefresh "Refresh"
|
||||
, headerline sRetry "Retry"
|
||||
, headerline sExpire "Expire"
|
||||
, headerline sNegativeCacheTTL "Negative Cache TTL"
|
||||
, inheader ")"
|
||||
]
|
||||
where
|
||||
headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment
|
||||
inheader l = "\t\t\t" ++ l
|
||||
|
||||
-- | Comment line in a zone file.
|
||||
com :: String -> String
|
||||
com s = "; " ++ s
|
||||
|
||||
type WarningMessage = String
|
||||
|
||||
-- | Generates a Zone for a particular Domain from the DNS properies of all
|
||||
-- hosts that propellor knows about that are in that Domain.
|
||||
genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
|
||||
genZone hosts zdomain soa =
|
||||
let (warnings, zhosts) = partitionEithers $ concat $ map concat
|
||||
[ map hostips inzdomain
|
||||
, map hostrecords inzdomain
|
||||
, map addcnames (M.elems m)
|
||||
]
|
||||
in (Zone zdomain soa (simplify zhosts), warnings)
|
||||
where
|
||||
m = hostMap hosts
|
||||
-- Known hosts with hostname located in the zone's domain.
|
||||
inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
|
||||
|
||||
-- Each host with a hostname located in the zdomain
|
||||
-- should have 1 or more IPAddrs in its Info.
|
||||
--
|
||||
-- If a host lacks any IPAddr, it's probably a misconfiguration,
|
||||
-- so warn.
|
||||
hostips :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||
hostips h
|
||||
| null l = [Left $ "no IP address defined for host " ++ hostName h]
|
||||
| otherwise = map Right l
|
||||
where
|
||||
info = hostInfo h
|
||||
l = zip (repeat $ AbsDomain $ hostName h)
|
||||
(map Address $ getAddresses info)
|
||||
|
||||
-- Any host, whether its hostname is in the zdomain or not,
|
||||
-- may have cnames which are in the zdomain. The cname may even be
|
||||
-- the same as the root of the zdomain, which is a nice way to
|
||||
-- specify IP addresses for a SOA record.
|
||||
--
|
||||
-- Add Records for those.. But not actually, usually, cnames!
|
||||
-- Why not? Well, using cnames doesn't allow doing some things,
|
||||
-- including MX and round robin DNS, and certianly CNAMES
|
||||
-- shouldn't be used in SOA records.
|
||||
--
|
||||
-- We typically know the host's IPAddrs anyway.
|
||||
-- So we can just use the IPAddrs.
|
||||
addcnames :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||
addcnames h = concatMap gen $ filter (inDomain zdomain) $
|
||||
mapMaybe getCNAME $ S.toList (_dns info)
|
||||
where
|
||||
info = hostInfo h
|
||||
gen c = case getAddresses info of
|
||||
[] -> [ret (CNAME c)]
|
||||
l -> map (ret . Address) l
|
||||
where
|
||||
ret record = Right (c, record)
|
||||
|
||||
-- Adds any other DNS records for a host located in the zdomain.
|
||||
hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)]
|
||||
hostrecords h = map Right l
|
||||
where
|
||||
info = hostInfo h
|
||||
l = zip (repeat $ AbsDomain $ hostName h)
|
||||
(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns info))
|
||||
|
||||
-- Simplifies the list of hosts. Remove duplicate entries.
|
||||
-- Also, filter out any CHAMES where the same domain has an
|
||||
-- IP address, since that's not legal.
|
||||
simplify :: [(BindDomain, Record)] -> [(BindDomain, Record)]
|
||||
simplify l = nub $ filter (not . dupcname ) l
|
||||
where
|
||||
dupcname (d, CNAME _) | any (matchingaddr d) l = True
|
||||
dupcname _ = False
|
||||
matchingaddr d (d', (Address _)) | d == d' = True
|
||||
matchingaddr _ _ = False
|
||||
|
||||
inDomain :: Domain -> BindDomain -> Bool
|
||||
inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d
|
||||
inDomain _ _ = False -- can't tell, so assume not
|
||||
|
||||
-- | Gets the hostname of the second domain, relative to the first domain,
|
||||
-- suitable for using in a zone file.
|
||||
domainHost :: Domain -> BindDomain -> String
|
||||
domainHost _ (RelDomain d) = d
|
||||
domainHost _ RootDomain = "@"
|
||||
domainHost base (AbsDomain d)
|
||||
| dotbase `isSuffixOf` d = take (length d - length dotbase) d
|
||||
| base == d = "@"
|
||||
| otherwise = d
|
||||
where
|
||||
dotbase = '.':base
|
||||
|
||||
addNamedConf :: NamedConf -> Info
|
||||
addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }
|
||||
where
|
||||
domain = confDomain conf
|
||||
|
||||
getNamedConf :: Propellor (M.Map Domain NamedConf)
|
||||
getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo
|
|
@ -0,0 +1,529 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
-- | Docker support for propellor
|
||||
--
|
||||
-- The existance of a docker container is just another Property of a system,
|
||||
-- which propellor can set up. See config.hs for an example.
|
||||
|
||||
module Propellor.Property.Docker (
|
||||
-- * Host properties
|
||||
installed,
|
||||
configured,
|
||||
container,
|
||||
docked,
|
||||
memoryLimited,
|
||||
garbageCollected,
|
||||
Image,
|
||||
ContainerName,
|
||||
-- * Container configuration
|
||||
dns,
|
||||
hostname,
|
||||
name,
|
||||
publish,
|
||||
expose,
|
||||
user,
|
||||
volume,
|
||||
volumes_from,
|
||||
workdir,
|
||||
memory,
|
||||
cpuShares,
|
||||
link,
|
||||
ContainerAlias,
|
||||
-- * Internal use
|
||||
chain,
|
||||
) where
|
||||
|
||||
import Propellor
|
||||
import Propellor.SimpleSh
|
||||
import Propellor.Types.Info
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Docker.Shim as Shim
|
||||
import Utility.SafeCommand
|
||||
import Utility.Path
|
||||
|
||||
import Control.Concurrent.Async hiding (link)
|
||||
import System.Posix.Directory
|
||||
import System.Posix.Process
|
||||
import Data.List
|
||||
import Data.List.Utils
|
||||
import qualified Data.Set as S
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.installed ["docker.io"]
|
||||
|
||||
-- | Configures docker with an authentication file, so that images can be
|
||||
-- pushed to index.docker.io. Optional.
|
||||
configured :: Property
|
||||
configured = prop `requires` installed
|
||||
where
|
||||
prop = withPrivData DockerAuthentication anyContext $ \getcfg ->
|
||||
property "docker configured" $ getcfg $ \cfg -> ensureProperty $
|
||||
"/root/.dockercfg" `File.hasContent` (lines cfg)
|
||||
|
||||
-- | A short descriptive name for a container.
|
||||
-- Should not contain whitespace or other unusual characters,
|
||||
-- only [a-zA-Z0-9_-] are allowed
|
||||
type ContainerName = String
|
||||
|
||||
-- | Starts accumulating the properties of a Docker container.
|
||||
--
|
||||
-- > container "web-server" "debian"
|
||||
-- > & publish "80:80"
|
||||
-- > & Apt.installed {"apache2"]
|
||||
-- > & ...
|
||||
container :: ContainerName -> Image -> Host
|
||||
container cn image = Host hn [] info
|
||||
where
|
||||
info = dockerInfo $ mempty { _dockerImage = Val image }
|
||||
hn = cn2hn cn
|
||||
|
||||
cn2hn :: ContainerName -> HostName
|
||||
cn2hn cn = cn ++ ".docker"
|
||||
|
||||
-- | Ensures that a docker container is set up and running, finding
|
||||
-- its configuration in the passed list of hosts.
|
||||
--
|
||||
-- The container has its own Properties which are handled by running
|
||||
-- propellor inside the container.
|
||||
--
|
||||
-- When the container's Properties include DNS info, such as a CNAME,
|
||||
-- that is propigated to the Info of the host(s) it's docked in.
|
||||
--
|
||||
-- Reverting this property ensures that the container is stopped and
|
||||
-- removed.
|
||||
docked
|
||||
:: [Host]
|
||||
-> ContainerName
|
||||
-> RevertableProperty
|
||||
docked hosts cn = RevertableProperty
|
||||
((maybe id propigateInfo mhost) (go "docked" setup))
|
||||
(go "undocked" teardown)
|
||||
where
|
||||
go desc a = property (desc ++ " " ++ cn) $ do
|
||||
hn <- asks hostName
|
||||
let cid = ContainerId hn cn
|
||||
ensureProperties [findContainer mhost cid cn $ a cid]
|
||||
|
||||
mhost = findHost hosts (cn2hn cn)
|
||||
|
||||
setup cid (Container image runparams) =
|
||||
provisionContainer cid
|
||||
`requires`
|
||||
runningContainer cid image runparams
|
||||
`requires`
|
||||
installed
|
||||
|
||||
teardown cid (Container image _runparams) =
|
||||
combineProperties ("undocked " ++ fromContainerId cid)
|
||||
[ stoppedContainer cid
|
||||
, property ("cleaned up " ++ fromContainerId cid) $
|
||||
liftIO $ report <$> mapM id
|
||||
[ removeContainer cid
|
||||
, removeImage image
|
||||
]
|
||||
]
|
||||
|
||||
propigateInfo :: Host -> Property -> Property
|
||||
propigateInfo (Host _ _ containerinfo) p =
|
||||
combineProperties (propertyDesc p) $ p : dnsprops ++ privprops
|
||||
where
|
||||
dnsprops = map addDNS (S.toList $ _dns containerinfo)
|
||||
privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo)
|
||||
|
||||
findContainer
|
||||
:: Maybe Host
|
||||
-> ContainerId
|
||||
-> ContainerName
|
||||
-> (Container -> Property)
|
||||
-> Property
|
||||
findContainer mhost cid cn mk = case mhost of
|
||||
Nothing -> cantfind
|
||||
Just h -> maybe cantfind mk (mkContainer cid h)
|
||||
where
|
||||
cantfind = containerDesc cid $ property "" $ do
|
||||
liftIO $ warningMessage $
|
||||
"missing definition for docker container \"" ++ cn2hn cn
|
||||
return FailedChange
|
||||
|
||||
mkContainer :: ContainerId -> Host -> Maybe Container
|
||||
mkContainer cid@(ContainerId hn _cn) h = Container
|
||||
<$> fromVal (_dockerImage info)
|
||||
<*> pure (map (\a -> a hn) (_dockerRunParams info))
|
||||
where
|
||||
info = _dockerinfo $ hostInfo h'
|
||||
h' = h
|
||||
-- expose propellor directory inside the container
|
||||
& volume (localdir++":"++localdir)
|
||||
-- name the container in a predictable way so we
|
||||
-- and the user can easily find it later
|
||||
& name (fromContainerId cid)
|
||||
|
||||
-- | Causes *any* docker images that are not in use by running containers to
|
||||
-- be deleted. And deletes any containers that propellor has set up
|
||||
-- before that are not currently running. Does not delete any containers
|
||||
-- that were not set up using propellor.
|
||||
--
|
||||
-- Generally, should come after the properties for the desired containers.
|
||||
garbageCollected :: Property
|
||||
garbageCollected = propertyList "docker garbage collected"
|
||||
[ gccontainers
|
||||
, gcimages
|
||||
]
|
||||
where
|
||||
gccontainers = property "docker containers garbage collected" $
|
||||
liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
|
||||
gcimages = property "docker images garbage collected" $ do
|
||||
liftIO $ report <$> (mapM removeImage =<< listImages)
|
||||
|
||||
-- | 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.
|
||||
--
|
||||
-- Only takes effect after reboot. (Not automated.)
|
||||
memoryLimited :: Property
|
||||
memoryLimited = "/etc/default/grub" `File.containsLine` cfg
|
||||
`describe` "docker memory limited"
|
||||
`onChange` cmdProperty "update-grub" []
|
||||
where
|
||||
cmdline = "cgroup_enable=memory swapaccount=1"
|
||||
cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\""
|
||||
|
||||
data Container = Container Image [RunParam]
|
||||
|
||||
-- | Parameters to pass to `docker run` when creating a container.
|
||||
type RunParam = String
|
||||
|
||||
-- | A docker image, that can be used to run a container.
|
||||
type Image = String
|
||||
|
||||
-- | Set custom dns server for container.
|
||||
dns :: String -> Property
|
||||
dns = runProp "dns"
|
||||
|
||||
-- | Set container host name.
|
||||
hostname :: String -> Property
|
||||
hostname = runProp "hostname"
|
||||
|
||||
-- | Set name for container. (Normally done automatically.)
|
||||
name :: String -> Property
|
||||
name = runProp "name"
|
||||
|
||||
-- | Publish a container's port to the host
|
||||
-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
|
||||
publish :: String -> Property
|
||||
publish = runProp "publish"
|
||||
|
||||
-- | Expose a container's port without publishing it.
|
||||
expose :: String -> Property
|
||||
expose = runProp "expose"
|
||||
|
||||
-- | Username or UID for container.
|
||||
user :: String -> Property
|
||||
user = runProp "user"
|
||||
|
||||
-- | Mount a volume
|
||||
-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
|
||||
-- With just a directory, creates a volume in the container.
|
||||
volume :: String -> Property
|
||||
volume = runProp "volume"
|
||||
|
||||
-- | Mount a volume from the specified container into the current
|
||||
-- container.
|
||||
volumes_from :: ContainerName -> Property
|
||||
volumes_from cn = genProp "volumes-from" $ \hn ->
|
||||
fromContainerId (ContainerId hn cn)
|
||||
|
||||
-- | Work dir inside the container.
|
||||
workdir :: String -> Property
|
||||
workdir = runProp "workdir"
|
||||
|
||||
-- | Memory limit for container.
|
||||
-- Format: <number><optional unit>, where unit = b, k, m or g
|
||||
--
|
||||
-- Note: Only takes effect when the host has the memoryLimited property
|
||||
-- enabled.
|
||||
memory :: String -> Property
|
||||
memory = runProp "memory"
|
||||
|
||||
-- | CPU shares (relative weight).
|
||||
--
|
||||
-- By default, all containers run at the same priority, but you can tell
|
||||
-- the kernel to give more CPU time to a container using this property.
|
||||
cpuShares :: Int -> Property
|
||||
cpuShares = runProp "cpu-shares" . show
|
||||
|
||||
-- | Link with another container on the same host.
|
||||
link :: ContainerName -> ContainerAlias -> Property
|
||||
link linkwith calias = genProp "link" $ \hn ->
|
||||
fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias
|
||||
|
||||
-- | A short alias for a linked container.
|
||||
-- Each container has its own alias namespace.
|
||||
type ContainerAlias = String
|
||||
|
||||
-- | A container is identified by its name, and the host
|
||||
-- on which it's deployed.
|
||||
data ContainerId = ContainerId HostName ContainerName
|
||||
deriving (Eq, Read, Show)
|
||||
|
||||
-- | Two containers with the same ContainerIdent were started from
|
||||
-- the same base image (possibly a different version though), and
|
||||
-- with the same RunParams.
|
||||
data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
toContainerId :: String -> Maybe ContainerId
|
||||
toContainerId s
|
||||
| myContainerSuffix `isSuffixOf` s = case separate (== '.') (desuffix s) of
|
||||
(cn, hn)
|
||||
| null hn || null cn -> Nothing
|
||||
| otherwise -> Just $ ContainerId hn cn
|
||||
| otherwise = Nothing
|
||||
where
|
||||
desuffix = reverse . drop len . reverse
|
||||
len = length myContainerSuffix
|
||||
|
||||
fromContainerId :: ContainerId -> String
|
||||
fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
|
||||
|
||||
containerHostName :: ContainerId -> HostName
|
||||
containerHostName (ContainerId _ cn) = cn2hn cn
|
||||
|
||||
myContainerSuffix :: String
|
||||
myContainerSuffix = ".propellor"
|
||||
|
||||
containerDesc :: ContainerId -> Property -> Property
|
||||
containerDesc cid p = p `describe` desc
|
||||
where
|
||||
desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
|
||||
|
||||
runningContainer :: ContainerId -> Image -> [RunParam] -> Property
|
||||
runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
|
||||
l <- liftIO $ listContainers RunningContainers
|
||||
if cid `elem` l
|
||||
then do
|
||||
-- Check if the ident has changed; if so the
|
||||
-- parameters of the container differ and it must
|
||||
-- be restarted.
|
||||
runningident <- liftIO $ getrunningident
|
||||
if runningident == Just ident
|
||||
then noChange
|
||||
else do
|
||||
void $ liftIO $ stopContainer cid
|
||||
restartcontainer
|
||||
else ifM (liftIO $ elem cid <$> listContainers AllContainers)
|
||||
( restartcontainer
|
||||
, go image
|
||||
)
|
||||
where
|
||||
ident = ContainerIdent image hn cn runps
|
||||
|
||||
restartcontainer = do
|
||||
oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
|
||||
void $ liftIO $ removeContainer cid
|
||||
go oldimage
|
||||
|
||||
getrunningident :: IO (Maybe ContainerIdent)
|
||||
getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
|
||||
let !v = extractident rs
|
||||
return v
|
||||
|
||||
extractident :: [Resp] -> Maybe ContainerIdent
|
||||
extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
|
||||
|
||||
go img = do
|
||||
liftIO $ do
|
||||
clearProvisionedFlag cid
|
||||
createDirectoryIfMissing True (takeDirectory $ identFile cid)
|
||||
shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
liftIO $ writeFile (identFile cid) (show ident)
|
||||
ensureProperty $ boolProperty "run" $ runContainer img
|
||||
(runps ++ ["-i", "-d", "-t"])
|
||||
[shim, "--docker", fromContainerId cid]
|
||||
|
||||
-- | Called when propellor is running inside a docker container.
|
||||
-- The string should be the container's ContainerId.
|
||||
--
|
||||
-- This process is effectively init inside the container.
|
||||
-- It even needs to wait on zombie processes!
|
||||
--
|
||||
-- Fork a thread to run the SimpleSh server in the background.
|
||||
-- In the foreground, run an interactive bash (or sh) shell,
|
||||
-- so that the user can interact with it when attached to the container.
|
||||
--
|
||||
-- When the system reboots, docker restarts the container, and this is run
|
||||
-- again. So, to make the necessary services get started on boot, this needs
|
||||
-- to provision the container then. However, if the container is already
|
||||
-- being provisioned by the calling propellor, it would be redundant and
|
||||
-- problimatic to also provisoon it here.
|
||||
--
|
||||
-- The solution is a flag file. If the flag file exists, then the container
|
||||
-- was already provisioned. So, it must be a reboot, and time to provision
|
||||
-- again. If the flag file doesn't exist, don't provision here.
|
||||
chain :: String -> IO ()
|
||||
chain s = case toContainerId s of
|
||||
Nothing -> error $ "Invalid ContainerId: " ++ s
|
||||
Just cid -> do
|
||||
changeWorkingDirectory localdir
|
||||
writeFile propellorIdent . show =<< readIdentFile cid
|
||||
-- Run boot provisioning before starting simpleSh,
|
||||
-- to avoid ever provisioning twice at the same time.
|
||||
whenM (checkProvisionedFlag cid) $ do
|
||||
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ containerHostName cid]) $
|
||||
warningMessage "Boot provision failed!"
|
||||
void $ async $ job reapzombies
|
||||
void $ async $ job $ simpleSh $ namedPipe cid
|
||||
job $ do
|
||||
void $ tryIO $ ifM (inPath "bash")
|
||||
( boolSystem "bash" [Param "-l"]
|
||||
, boolSystem "/bin/sh" []
|
||||
)
|
||||
putStrLn "Container is still running. Press ^P^Q to detach."
|
||||
where
|
||||
job = forever . void . tryIO
|
||||
reapzombies = void $ getAnyProcessStatus True False
|
||||
|
||||
-- | Once a container is running, propellor can be run inside
|
||||
-- it to provision it.
|
||||
--
|
||||
-- Note that there is a race here, between the simplesh
|
||||
-- server starting up in the container, and this property
|
||||
-- being run. So, retry connections to the client for up to
|
||||
-- 1 minute.
|
||||
provisionContainer :: ContainerId -> Property
|
||||
provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
|
||||
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
|
||||
r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
|
||||
when (r /= FailedChange) $
|
||||
setProvisionedFlag cid
|
||||
return r
|
||||
where
|
||||
params = ["--continue", show $ Chain $ containerHostName cid]
|
||||
|
||||
go lastline (v:rest) = case v of
|
||||
StdoutLine s -> do
|
||||
maybe noop putStrLn lastline
|
||||
hFlush stdout
|
||||
go (Just s) rest
|
||||
StderrLine s -> do
|
||||
maybe noop putStrLn lastline
|
||||
hFlush stdout
|
||||
hPutStrLn stderr s
|
||||
hFlush stderr
|
||||
go Nothing rest
|
||||
Done -> ret lastline
|
||||
go lastline [] = ret lastline
|
||||
|
||||
ret lastline = pure $ fromMaybe FailedChange $ readish =<< lastline
|
||||
|
||||
stopContainer :: ContainerId -> IO Bool
|
||||
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
|
||||
|
||||
stoppedContainer :: ContainerId -> Property
|
||||
stoppedContainer cid = containerDesc cid $ property desc $
|
||||
ifM (liftIO $ elem cid <$> listContainers RunningContainers)
|
||||
( liftIO cleanup `after` ensureProperty
|
||||
(boolProperty desc $ stopContainer cid)
|
||||
, return NoChange
|
||||
)
|
||||
where
|
||||
desc = "stopped"
|
||||
cleanup = do
|
||||
nukeFile $ namedPipe cid
|
||||
nukeFile $ identFile cid
|
||||
removeDirectoryRecursive $ shimdir cid
|
||||
clearProvisionedFlag cid
|
||||
|
||||
removeContainer :: ContainerId -> IO Bool
|
||||
removeContainer cid = catchBoolIO $
|
||||
snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
|
||||
|
||||
removeImage :: Image -> IO Bool
|
||||
removeImage image = catchBoolIO $
|
||||
snd <$> processTranscript dockercmd ["rmi", image ] Nothing
|
||||
|
||||
runContainer :: Image -> [RunParam] -> [String] -> IO Bool
|
||||
runContainer image ps cmd = boolSystem dockercmd $ map Param $
|
||||
"run" : (ps ++ image : cmd)
|
||||
|
||||
commitContainer :: ContainerId -> IO (Maybe Image)
|
||||
commitContainer cid = catchMaybeIO $
|
||||
takeWhile (/= '\n')
|
||||
<$> readProcess dockercmd ["commit", fromContainerId cid]
|
||||
|
||||
data ContainerFilter = RunningContainers | AllContainers
|
||||
deriving (Eq)
|
||||
|
||||
-- | Only lists propellor managed containers.
|
||||
listContainers :: ContainerFilter -> IO [ContainerId]
|
||||
listContainers status =
|
||||
catMaybes . map toContainerId . concat . map (split ",")
|
||||
. catMaybes . map (lastMaybe . words) . lines
|
||||
<$> readProcess dockercmd ps
|
||||
where
|
||||
ps
|
||||
| status == AllContainers = baseps ++ ["--all"]
|
||||
| otherwise = baseps
|
||||
baseps = ["ps", "--no-trunc"]
|
||||
|
||||
listImages :: IO [Image]
|
||||
listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
|
||||
|
||||
runProp :: String -> RunParam -> Property
|
||||
runProp field val = pureInfoProperty (param) $ dockerInfo $
|
||||
mempty { _dockerRunParams = [\_ -> "--"++param] }
|
||||
where
|
||||
param = field++"="++val
|
||||
|
||||
genProp :: String -> (HostName -> RunParam) -> Property
|
||||
genProp field mkval = pureInfoProperty field $ dockerInfo $
|
||||
mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] }
|
||||
|
||||
dockerInfo :: DockerInfo -> Info
|
||||
dockerInfo i = mempty { _dockerinfo = i }
|
||||
|
||||
-- | The ContainerIdent of a container is written to
|
||||
-- /.propellor-ident inside it. This can be checked to see if
|
||||
-- the container has the same ident later.
|
||||
propellorIdent :: FilePath
|
||||
propellorIdent = "/.propellor-ident"
|
||||
|
||||
-- | Named pipe used for communication with the container.
|
||||
namedPipe :: ContainerId -> FilePath
|
||||
namedPipe cid = "docker" </> fromContainerId cid
|
||||
|
||||
provisionedFlag :: ContainerId -> FilePath
|
||||
provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
|
||||
|
||||
clearProvisionedFlag :: ContainerId -> IO ()
|
||||
clearProvisionedFlag = nukeFile . provisionedFlag
|
||||
|
||||
setProvisionedFlag :: ContainerId -> IO ()
|
||||
setProvisionedFlag cid = do
|
||||
createDirectoryIfMissing True (takeDirectory (provisionedFlag cid))
|
||||
writeFile (provisionedFlag cid) "1"
|
||||
|
||||
checkProvisionedFlag :: ContainerId -> IO Bool
|
||||
checkProvisionedFlag = doesFileExist . provisionedFlag
|
||||
|
||||
shimdir :: ContainerId -> FilePath
|
||||
shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
|
||||
|
||||
identFile :: ContainerId -> FilePath
|
||||
identFile cid = "docker" </> fromContainerId cid ++ ".ident"
|
||||
|
||||
readIdentFile :: ContainerId -> IO ContainerIdent
|
||||
readIdentFile cid = fromMaybe (error "bad ident in identFile")
|
||||
. readish <$> readFile (identFile cid)
|
||||
|
||||
dockercmd :: String
|
||||
dockercmd = "docker.io"
|
||||
|
||||
report :: [Bool] -> Result
|
||||
report rmed
|
||||
| or rmed = MadeChange
|
||||
| otherwise = NoChange
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
-- | Support for running propellor, as built outside a docker container,
|
||||
-- inside the container.
|
||||
--
|
||||
-- Note: This is currently Debian specific, due to glibcLibs.
|
||||
|
||||
module Propellor.Property.Docker.Shim (setup, cleanEnv, file) where
|
||||
|
||||
import Propellor
|
||||
import Utility.LinuxMkLibs
|
||||
import Utility.SafeCommand
|
||||
import Utility.Path
|
||||
import Utility.FileMode
|
||||
|
||||
import Data.List
|
||||
import System.Posix.Files
|
||||
|
||||
-- | Sets up a shimmed version of the program, in a directory, and
|
||||
-- returns its path.
|
||||
setup :: FilePath -> FilePath -> IO FilePath
|
||||
setup propellorbin dest = do
|
||||
createDirectoryIfMissing True dest
|
||||
|
||||
libs <- parseLdd <$> readProcess "ldd" [propellorbin]
|
||||
glibclibs <- glibcLibs
|
||||
let libs' = nub $ libs ++ glibclibs
|
||||
libdirs <- map (dest ++) . nub . catMaybes
|
||||
<$> mapM (installLib installFile dest) libs'
|
||||
|
||||
let linker = (dest ++) $
|
||||
fromMaybe (error "cannot find ld-linux linker") $
|
||||
headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
|
||||
let gconvdir = (dest ++) $ parentDir $
|
||||
fromMaybe (error "cannot find gconv directory") $
|
||||
headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
|
||||
let linkerparams = ["--library-path", intercalate ":" libdirs ]
|
||||
let shim = file propellorbin dest
|
||||
writeFile shim $ unlines
|
||||
[ "#!/bin/sh"
|
||||
, "GCONV_PATH=" ++ shellEscape gconvdir
|
||||
, "export GCONV_PATH"
|
||||
, "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
|
||||
" " ++ shellEscape propellorbin ++ " \"$@\""
|
||||
]
|
||||
modifyFileMode shim (addModes executeModes)
|
||||
return shim
|
||||
|
||||
cleanEnv :: IO ()
|
||||
cleanEnv = void $ unsetEnv "GCONV_PATH"
|
||||
|
||||
file :: FilePath -> FilePath -> FilePath
|
||||
file propellorbin dest = dest </> takeFileName propellorbin
|
||||
|
||||
installFile :: FilePath -> FilePath -> IO ()
|
||||
installFile top f = do
|
||||
createDirectoryIfMissing True destdir
|
||||
nukeFile dest
|
||||
createLink f dest `catchIO` (const copy)
|
||||
where
|
||||
copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
|
||||
destdir = inTop top $ parentDir f
|
||||
dest = inTop top f
|
|
@ -0,0 +1,95 @@
|
|||
module Propellor.Property.File where
|
||||
|
||||
import Propellor
|
||||
import Utility.FileMode
|
||||
|
||||
import System.Posix.Files
|
||||
import System.PosixCompat.Types
|
||||
|
||||
type Line = String
|
||||
|
||||
-- | Replaces all the content of a file.
|
||||
hasContent :: FilePath -> [Line] -> Property
|
||||
f `hasContent` newcontent = fileProperty ("replace " ++ f)
|
||||
(\_oldcontent -> newcontent) f
|
||||
|
||||
-- | Ensures a file has contents that comes from PrivData.
|
||||
--
|
||||
-- The file's permissions are preserved if the file already existed.
|
||||
-- Otherwise, they're set to 600.
|
||||
hasPrivContent :: FilePath -> Context -> Property
|
||||
hasPrivContent f context = withPrivData (PrivFile f) context $ \getcontent ->
|
||||
property desc $ getcontent $ \privcontent ->
|
||||
ensureProperty $ fileProperty' writeFileProtected desc
|
||||
(\_oldcontent -> lines privcontent) f
|
||||
where
|
||||
desc = "privcontent " ++ f
|
||||
|
||||
-- | Leaves the file world-readable.
|
||||
hasPrivContentExposed :: FilePath -> Context -> Property
|
||||
hasPrivContentExposed f context = hasPrivContent f context `onChange`
|
||||
mode f (combineModes (ownerWriteMode:readModes))
|
||||
|
||||
-- | Ensures that a line is present in a file, adding it to the end if not.
|
||||
containsLine :: FilePath -> Line -> Property
|
||||
f `containsLine` l = f `containsLines` [l]
|
||||
|
||||
containsLines :: FilePath -> [Line] -> Property
|
||||
f `containsLines` l = fileProperty (f ++ " contains:" ++ show l) go f
|
||||
where
|
||||
go ls
|
||||
| all (`elem` ls) l = ls
|
||||
| otherwise = ls++l
|
||||
|
||||
-- | Ensures that a line is not present in a file.
|
||||
-- Note that the file is ensured to exist, so if it doesn't, an empty
|
||||
-- file will be written.
|
||||
lacksLine :: FilePath -> Line -> Property
|
||||
f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
|
||||
|
||||
-- | Removes a file. Does not remove symlinks or non-plain-files.
|
||||
notPresent :: FilePath -> Property
|
||||
notPresent f = check (doesFileExist f) $ property (f ++ " not present") $
|
||||
makeChange $ nukeFile f
|
||||
|
||||
fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
|
||||
fileProperty = fileProperty' writeFile
|
||||
fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property
|
||||
fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
|
||||
where
|
||||
go True = do
|
||||
ls <- liftIO $ lines <$> readFile f
|
||||
let ls' = a ls
|
||||
if ls' == ls
|
||||
then noChange
|
||||
else makeChange $ viaTmp updatefile f (unlines ls')
|
||||
go False = makeChange $ writer f (unlines $ a [])
|
||||
|
||||
-- viaTmp makes the temp file mode 600.
|
||||
-- Replicate the original file's owner and mode.
|
||||
updatefile f' content = do
|
||||
writer f' content
|
||||
s <- getFileStatus f
|
||||
setFileMode f' (fileMode s)
|
||||
setOwnerAndGroup f' (fileOwner s) (fileGroup s)
|
||||
|
||||
-- | Ensures a directory exists.
|
||||
dirExists :: FilePath -> Property
|
||||
dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
|
||||
makeChange $ createDirectoryIfMissing True d
|
||||
|
||||
-- | Ensures that a file/dir has the specified owner and group.
|
||||
ownerGroup :: FilePath -> UserName -> GroupName -> Property
|
||||
ownerGroup f owner group = property (f ++ " owner " ++ og) $ do
|
||||
r <- ensureProperty $ cmdProperty "chown" [og, f]
|
||||
if r == FailedChange
|
||||
then return r
|
||||
else noChange
|
||||
where
|
||||
og = owner ++ ":" ++ group
|
||||
|
||||
-- | Ensures that a file/dir has the specfied mode.
|
||||
mode :: FilePath -> FileMode -> Property
|
||||
mode f v = property (f ++ " mode " ++ show v) $ do
|
||||
liftIO $ modifyFileMode f (\_old -> v)
|
||||
noChange
|
|
@ -0,0 +1,93 @@
|
|||
module Propellor.Property.Git where
|
||||
|
||||
import Propellor
|
||||
import Propellor.Property.File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Service as Service
|
||||
import Utility.SafeCommand
|
||||
|
||||
import Data.List
|
||||
|
||||
-- | Exports all git repos in a directory (that user nobody can read)
|
||||
-- using git-daemon, run from inetd.
|
||||
--
|
||||
-- Note that reverting this property does not remove or stop inetd.
|
||||
daemonRunning :: FilePath -> RevertableProperty
|
||||
daemonRunning exportdir = RevertableProperty setup unsetup
|
||||
where
|
||||
setup = containsLine conf (mkl "tcp4")
|
||||
`requires`
|
||||
containsLine conf (mkl "tcp6")
|
||||
`requires`
|
||||
dirExists exportdir
|
||||
`requires`
|
||||
Apt.serviceInstalledRunning "openbsd-inetd"
|
||||
`onChange`
|
||||
Service.running "openbsd-inetd"
|
||||
`describe` ("git-daemon exporting " ++ exportdir)
|
||||
unsetup = lacksLine conf (mkl "tcp4")
|
||||
`requires`
|
||||
lacksLine conf (mkl "tcp6")
|
||||
`onChange`
|
||||
Service.reloaded "openbsd-inetd"
|
||||
|
||||
conf = "/etc/inetd.conf"
|
||||
|
||||
mkl tcpv = intercalate "\t"
|
||||
[ "git"
|
||||
, "stream"
|
||||
, tcpv
|
||||
, "nowait"
|
||||
, "nobody"
|
||||
, "/usr/bin/git"
|
||||
, "git"
|
||||
, "daemon"
|
||||
, "--inetd"
|
||||
, "--export-all"
|
||||
, "--base-path=" ++ exportdir
|
||||
, exportdir
|
||||
]
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.installed ["git"]
|
||||
|
||||
type RepoUrl = String
|
||||
|
||||
type Branch = String
|
||||
|
||||
-- | Specified git repository is cloned to the specified directory.
|
||||
--
|
||||
-- If the firectory exists with some other content, it will be recursively
|
||||
-- deleted.
|
||||
--
|
||||
-- A branch can be specified, to check out.
|
||||
cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
|
||||
cloned owner url dir mbranch = check originurl (property desc checkout)
|
||||
`requires` installed
|
||||
where
|
||||
desc = "git cloned " ++ url ++ " to " ++ dir
|
||||
gitconfig = dir </> ".git/config"
|
||||
originurl = ifM (doesFileExist gitconfig)
|
||||
( do
|
||||
v <- catchDefaultIO Nothing $ headMaybe . lines <$>
|
||||
readProcess "git" ["config", "--file", gitconfig, "remote.origin.url"]
|
||||
return (v /= Just url)
|
||||
, return True
|
||||
)
|
||||
checkout = do
|
||||
liftIO $ do
|
||||
whenM (doesDirectoryExist dir) $
|
||||
removeDirectoryRecursive dir
|
||||
createDirectoryIfMissing True (takeDirectory dir)
|
||||
ensureProperty $ userScriptProperty owner $ catMaybes
|
||||
-- The </dev/null fixes an intermittent
|
||||
-- "fatal: read error: Bad file descriptor"
|
||||
-- when run across ssh with propellor --spin
|
||||
[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
|
||||
, Just $ "cd " ++ shellEscape dir
|
||||
, ("git checkout " ++) <$> mbranch
|
||||
-- In case this repo is exposted via the web,
|
||||
-- although the hook to do this ongoing is not
|
||||
-- installed here.
|
||||
, Just "git update-server-info"
|
||||
]
|
|
@ -0,0 +1,44 @@
|
|||
module Propellor.Property.Gpg where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import Utility.FileSystemEncoding
|
||||
|
||||
import System.PosixCompat
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.installed ["gnupg"]
|
||||
|
||||
type GpgKeyId = String
|
||||
|
||||
-- | Sets up a user with a gpg key from the privdata.
|
||||
--
|
||||
-- Note that if a secret key is exported using gpg -a --export-secret-key,
|
||||
-- the public key is also included. Or just a public key could be
|
||||
-- exported, and this would set it up just as well.
|
||||
--
|
||||
-- Recommend only using this for low-value dedicated role keys.
|
||||
-- No attempt has been made to scrub the key out of memory once it's used.
|
||||
--
|
||||
-- The GpgKeyId does not have to be a numeric id; it can just as easily
|
||||
-- be a description of the key.
|
||||
keyImported :: GpgKeyId -> UserName -> Property
|
||||
keyImported keyid user = flagFile' prop genflag
|
||||
`requires` installed
|
||||
where
|
||||
desc = user ++ " has gpg key " ++ show keyid
|
||||
genflag = do
|
||||
d <- dotDir user
|
||||
return $ d </> ".propellor-imported-keyid-" ++ keyid
|
||||
prop = withPrivData GpgKey (Context keyid) $ \getkey ->
|
||||
property desc $ getkey $ \key -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "su" ["-c", "gpg --import", user]) $ \h -> do
|
||||
fileEncoding h
|
||||
hPutStr h key
|
||||
hClose h
|
||||
|
||||
dotDir :: UserName -> IO FilePath
|
||||
dotDir user = do
|
||||
home <- homeDirectory <$> getUserEntryForName user
|
||||
return $ home </> ".gnupg"
|
|
@ -0,0 +1,39 @@
|
|||
module Propellor.Property.Grub where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
|
||||
-- | Eg, hd0,0 or xen/xvda1
|
||||
type GrubDevice = String
|
||||
|
||||
type TimeoutSecs = Int
|
||||
|
||||
-- | Use PV-grub chaining to boot
|
||||
--
|
||||
-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
|
||||
--
|
||||
-- http://notes.pault.ag/linode-pv-grub-chainning/
|
||||
--
|
||||
-- The rootdev should be in the form "hd0", while the bootdev is in the form
|
||||
-- "xen/xvda".
|
||||
chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property
|
||||
chainPVGrub rootdev bootdev timeout = combineProperties desc
|
||||
[ File.dirExists "/boot/grub"
|
||||
, "/boot/grub/menu.lst" `File.hasContent`
|
||||
[ "default 1"
|
||||
, "timeout " ++ show timeout
|
||||
, ""
|
||||
, "title grub-xen shim"
|
||||
, "root (" ++ rootdev ++ ")"
|
||||
, "kernel /boot/xen-shim"
|
||||
, "boot"
|
||||
]
|
||||
, "/boot/load.cf" `File.hasContent`
|
||||
[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
|
||||
, Apt.installed ["grub-xen"]
|
||||
, flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
|
||||
`describe` "/boot-xen-shim"
|
||||
]
|
||||
where
|
||||
desc = "chain PV-grub"
|
|
@ -0,0 +1,24 @@
|
|||
module Propellor.Property.HostingProvider.CloudAtCost where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Hostname as Hostname
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Ssh as Ssh
|
||||
import qualified Propellor.Property.User as User
|
||||
|
||||
-- Clean up a system as installed by cloudatcost.com
|
||||
decruft :: Property
|
||||
decruft = propertyList "cloudatcost cleanup"
|
||||
[ Hostname.sane
|
||||
, Ssh.randomHostKeys
|
||||
, "worked around grub/lvm boot bug #743126" ==>
|
||||
"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
|
||||
`onChange` cmdProperty "update-grub" []
|
||||
`onChange` cmdProperty "update-initramfs" ["-u"]
|
||||
, combineProperties "nuked cloudatcost cruft"
|
||||
[ File.notPresent "/etc/rc.local"
|
||||
, File.notPresent "/etc/init.d/S97-setup.sh"
|
||||
, User.nuked "user" User.YesReallyDeleteHome
|
||||
]
|
||||
]
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
module Propellor.Property.HostingProvider.DigitalOcean where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.File as File
|
||||
|
||||
-- Digital Ocean does not provide any way to boot
|
||||
-- the kernel provided by the distribution, except using kexec.
|
||||
-- Without this, some old, and perhaps insecure kernel will be used.
|
||||
--
|
||||
-- Note that this only causes the new kernel to be loaded on reboot.
|
||||
-- If the power is cycled, the old kernel still boots up.
|
||||
-- TODO: detect this and reboot immediately?
|
||||
distroKernel :: Property
|
||||
distroKernel = propertyList "digital ocean distro kernel hack"
|
||||
[ Apt.installed ["grub-pc", "kexec-tools"]
|
||||
, "/etc/default/kexec" `File.containsLines`
|
||||
[ "LOAD_KEXEC=true"
|
||||
, "USE_GRUB_CONFIG=true"
|
||||
] `describe` "kexec configured"
|
||||
]
|
|
@ -0,0 +1,10 @@
|
|||
module Propellor.Property.HostingProvider.Linode where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Grub as Grub
|
||||
|
||||
-- | Linode's pv-grub-x86_64 does not currently support booting recent
|
||||
-- Debian kernels compressed with xz. This sets up pv-grub chaing to enable
|
||||
-- it.
|
||||
chainPVGrub :: Grub.TimeoutSecs -> Property
|
||||
chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
|
|
@ -0,0 +1,39 @@
|
|||
module Propellor.Property.Hostname where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
|
||||
-- | Ensures that the hostname is set using best practices.
|
||||
--
|
||||
-- Configures /etc/hostname and the current hostname.
|
||||
--
|
||||
-- /etc/hosts is also configured, with an entry for 127.0.1.1, which is
|
||||
-- standard at least on Debian to set the FDQN.
|
||||
--
|
||||
-- Also, the /etc/hosts 127.0.0.1 line is set to localhost. Putting any
|
||||
-- other hostnames there is not best practices and can lead to annoying
|
||||
-- messages from eg, apache.
|
||||
sane :: Property
|
||||
sane = property ("sane hostname") (ensureProperty . setTo =<< asks hostName)
|
||||
|
||||
setTo :: HostName -> Property
|
||||
setTo hn = combineProperties desc go
|
||||
where
|
||||
desc = "hostname " ++ hn
|
||||
(basehost, domain) = separate (== '.') hn
|
||||
|
||||
go = catMaybes
|
||||
[ Just $ "/etc/hostname" `File.hasContent` [basehost]
|
||||
, if null domain
|
||||
then Nothing
|
||||
else Just $ trivial $ hostsline "127.0.1.1" [hn, basehost]
|
||||
, Just $ trivial $ hostsline "127.0.0.1" ["localhost"]
|
||||
, Just $ trivial $ cmdProperty "hostname" [basehost]
|
||||
]
|
||||
|
||||
hostsline ip names = File.fileProperty desc
|
||||
(addhostsline ip names)
|
||||
"/etc/hosts"
|
||||
addhostsline ip names ls =
|
||||
(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
|
||||
hasip ip l = headMaybe (words l) == Just ip
|
|
@ -0,0 +1,30 @@
|
|||
module Propellor.Property.Network where
|
||||
|
||||
import Propellor
|
||||
import Propellor.Property.File
|
||||
|
||||
interfaces :: FilePath
|
||||
interfaces = "/etc/network/interfaces"
|
||||
|
||||
-- | 6to4 ipv6 connection, should work anywhere
|
||||
ipv6to4 :: Property
|
||||
ipv6to4 = fileProperty "ipv6to4" go interfaces
|
||||
`onChange` ifUp "sit0"
|
||||
where
|
||||
go ls
|
||||
| all (`elem` ls) stanza = ls
|
||||
| otherwise = ls ++ stanza
|
||||
stanza =
|
||||
[ "# Automatically added by propeller"
|
||||
, "iface sit0 inet6 static"
|
||||
, "\taddress 2002:5044:5531::1"
|
||||
, "\tnetmask 64"
|
||||
, "\tgateway ::192.88.99.1"
|
||||
, "auto sit0"
|
||||
, "# End automatically added by propeller"
|
||||
]
|
||||
|
||||
type Interface = String
|
||||
|
||||
ifUp :: Interface -> Property
|
||||
ifUp iface = cmdProperty "ifup" [iface]
|
|
@ -0,0 +1,159 @@
|
|||
module Propellor.Property.Obnam where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Cron as Cron
|
||||
import Utility.SafeCommand
|
||||
|
||||
import Data.List
|
||||
|
||||
type ObnamParam = String
|
||||
|
||||
-- | An obnam repository can be used by multiple clients. Obnam uses
|
||||
-- locking to allow only one client to write at a time. Since stale lock
|
||||
-- files can prevent backups from happening, it's more robust, if you know
|
||||
-- a repository has only one client, to force the lock before starting a
|
||||
-- backup. Using OnlyClient allows propellor to do so when running obnam.
|
||||
data NumClients = OnlyClient | MultipleClients
|
||||
deriving (Eq)
|
||||
|
||||
-- | Installs a cron job that causes a given directory to be backed
|
||||
-- up, by running obnam with some parameters.
|
||||
--
|
||||
-- If the directory does not exist, or exists but is completely empty,
|
||||
-- this Property will immediately restore it from an existing backup.
|
||||
--
|
||||
-- So, this property can be used to deploy a directory of content
|
||||
-- to a host, while also ensuring any changes made to it get backed up.
|
||||
-- And since Obnam encrypts, just make this property depend on a gpg
|
||||
-- key, and tell obnam to use the key, and your data will be backed
|
||||
-- up securely. For example:
|
||||
--
|
||||
-- > & Obnam.backup "/srv/git" "33 3 * * *"
|
||||
-- > [ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam"
|
||||
-- > , "--encrypt-with=1B169BE1"
|
||||
-- > ] Obnam.OnlyClient
|
||||
-- > `requires` Gpg.keyImported "1B169BE1" "root"
|
||||
-- > `requires` Ssh.keyImported SshRsa "root"
|
||||
--
|
||||
-- How awesome is that?
|
||||
backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
|
||||
backup dir crontimes params numclients = backup' dir crontimes params numclients
|
||||
`requires` restored dir params
|
||||
|
||||
-- | Does a backup, but does not automatically restore.
|
||||
backup' :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
|
||||
backup' dir crontimes params numclients = cronjob `describe` desc
|
||||
where
|
||||
desc = dir ++ " backed up by obnam"
|
||||
cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $
|
||||
intercalate ";" $ catMaybes
|
||||
[ if numclients == OnlyClient
|
||||
then Just $ unwords $
|
||||
[ "obnam"
|
||||
, "force-lock"
|
||||
] ++ map shellEscape params
|
||||
else Nothing
|
||||
, Just $ unwords $
|
||||
[ "obnam"
|
||||
, "backup"
|
||||
, shellEscape dir
|
||||
] ++ map shellEscape params
|
||||
]
|
||||
|
||||
-- | Restores a directory from an obnam backup.
|
||||
--
|
||||
-- Only does anything if the directory does not exist, or exists,
|
||||
-- but is completely empty.
|
||||
--
|
||||
-- The restore is performed atomically; restoring to a temp directory
|
||||
-- and then moving it to the directory.
|
||||
restored :: FilePath -> [ObnamParam] -> Property
|
||||
restored dir params = property (dir ++ " restored by obnam") go
|
||||
`requires` installed
|
||||
where
|
||||
go = ifM (liftIO needsRestore)
|
||||
( do
|
||||
warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
|
||||
liftIO restore
|
||||
, noChange
|
||||
)
|
||||
|
||||
needsRestore = null <$> catchDefaultIO [] (dirContents dir)
|
||||
|
||||
restore = withTmpDirIn (takeDirectory dir) "obnam-restore" $ \tmpdir -> do
|
||||
ok <- boolSystem "obnam" $
|
||||
[ Param "restore"
|
||||
, Param "--to"
|
||||
, Param tmpdir
|
||||
] ++ map Param params
|
||||
let restoreddir = tmpdir ++ "/" ++ dir
|
||||
ifM (pure ok <&&> doesDirectoryExist restoreddir)
|
||||
( do
|
||||
void $ tryIO $ removeDirectory dir
|
||||
renameDirectory restoreddir dir
|
||||
return MadeChange
|
||||
, return FailedChange
|
||||
)
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.installed ["obnam"]
|
||||
|
||||
-- | Ensures that a recent version of obnam gets installed.
|
||||
--
|
||||
-- Only does anything for Debian Stable.
|
||||
latestVersion :: Property
|
||||
latestVersion = withOS "obnam latest version" $ \o -> case o of
|
||||
(Just (System (Debian suite) _)) | isStable suite -> ensureProperty $
|
||||
Apt.setSourcesListD stablesources "obnam"
|
||||
`requires` toProp (Apt.trustsKey key)
|
||||
_ -> noChange
|
||||
where
|
||||
stablesources =
|
||||
[ "deb http://code.liw.fi/debian " ++ Apt.showSuite stableRelease ++ " main"
|
||||
]
|
||||
-- gpg key used by the code.liw.fi repository.
|
||||
key = Apt.AptKey "obnam" $ unlines
|
||||
[ "-----BEGIN PGP PUBLIC KEY BLOCK-----"
|
||||
, "Version: GnuPG v1.4.9 (GNU/Linux)"
|
||||
, ""
|
||||
, "mQGiBEfzuTgRBACcVNG/H6QJqLx5qiQs2zmPe6D6BWOWHfgNgG4IWzNstm21YDxb"
|
||||
, "KqwFG0gxcnZJGHkXAhkSfqTokYd0lc5eBemcA1pkceNjzMEX8wwiZ810HzJD4eEH"
|
||||
, "sjoWR8+qKrZeixzZqReAfqztcXoBGKQ0u1R1vpg1txUa75OM4BUqaUbsmwCgmS4x"
|
||||
, "DjMxSaUSPuu6vQ7ZGZBXSP0D/RQw8DBHMfsv3DiaqFqk8tkuUkpMFPIekHidSHlO"
|
||||
, "EACbncqbbyHksyCpFNVNcQIDHrOLjOZK9BAXkSd8I3ww7U+nLdDcCblrW8CZnJtm"
|
||||
, "ZYrxfaXaHZ/It9/RCAsQ+c8xtmyUPjsf//4Vf8olxNQHzgBSe5/LJRi4Vd53he+K"
|
||||
, "YP4LA/9IZbjvVmm8+8Y0pQrTHlI6nTImtzdBXHc4+T3lLBj9XODHLozC2kSBOQky"
|
||||
, "q/EisTITHTXL8vYg4NsKm5RTbPAuBwdtxcny8CXfOqKtGOdrebmKotGllTozzdPv"
|
||||
, "9p53cuce6oJ2oMUodc074JOGTWwDSgLiJX4nViGcU1wy/vtQnrQkY29kZS5saXcu"
|
||||
, "ZmkgYXJjaGl2ZSBrZXkgPGxpd0BsaXcuZmk+iGAEExECACAFAkfzuTgCGwMGCwkI"
|
||||
, "BwMCBBUCCAMEFgIDAQIeAQIXgAAKCRBG53tJR95LscKrAJ0ZtKqa2x6Kplwa2mzx"
|
||||
, "ItImbIGMJACdETqofDYzUN91yLAFlOnxAyrE+UyIRgQQEQIABgUCSFd5GgAKCRAf"
|
||||
, "u5W/LZrMjqr8AJ4xPVHpW8ZNlgMwDSVb075RnA2DiACgg2SR69jAHFQOWV6xfLRr"
|
||||
, "vh0bLKGJAhwEEAEIAAYFAktEyIwACgkQ61zh116FEfm7Lg//Wiy3TjWAk8YHUddv"
|
||||
, "zOioYzCxQ985GsVhJGAVPqSGOc9vfTWBJZ8J3l0NnYTRpEGucmbF9G+mAt9iGXu6"
|
||||
, "7yZkxyFdvbo7EDsqMU1wLOM6PiU+Un63MKlbTNmFn7OKE8aXPRAFgcyUO/qjdqoD"
|
||||
, "sa9FgU5Z0f60m9qah6BPXH6IzMLHYoiP7t8rCBIwLgyl3w2w+Fjt1DFpbW9Kb7jz"
|
||||
, "i8jFvC8jPmxV8xh2OSgVZyNk4qg6hIV8GVQY7AJt8OurZSckgQd7ifHK9JTGohtF"
|
||||
, "tXCiqeDEvnMF4A9HI/TcXJBzonZ8ds1JCq42nSSKmL+8TyjtUSD/xHygazuc0CK0"
|
||||
, "hFnQWBub60IfyV6F0oTagJ8cmARv2sezHAeHDkzPHE8RdjgktazH1eJrA4LheEd6"
|
||||
, "KeSnVtYWpw8dgMv5PleFyQiAj/t3C/N50fd15tUyfnH15G7nFjMQV2Yx35uwSxOj"
|
||||
, "376OWnDN/YGTNk283XXULbyVJYR8Q2unso20XQ94yQ2A5EpHHPrHoLxrL/ydM08d"
|
||||
, "nvKstLZIZtal1seiMkymtlSiGz25A5oqsclwS6VZCKdWA8HO/wlElOMcaHyl6Y1y"
|
||||
, "gYP7y9O5yFYKFOrCH0nFjJbwmkRiBLsxuuWsYgJigVGq/atSrtawkHdshpCw0HCY"
|
||||
, "N/RFcWkJ864BdsO0C0sDzueNkQO5Ag0ER/O5RBAIAJiwPH9tyJTgXcC2Y4XWboOq"
|
||||
, "rx5CkOnr5b45oS9cK2eIJ8TKxE3XgKLxUr3mIH0QR2kZgDOwNl0WY+7/CXjn+Spn"
|
||||
, "BokPg54rafEUePodGpGdUXdgrHhAMHYjh8fXFJ1SlQcg46/zc1wDI7jBCkGrK3V8"
|
||||
, "5cXDqwTFTN5LcjoSRWeM4Voa6pEfDdL3rMlnOw9R9gDHRBBb6CDSjWXqM86pR889"
|
||||
, "5QrR0SDwiJNrMoyxSjMXFKGBQAsYHJ82myZrlbuZbroZjVp5Uh7eB1ZiPljNVtcr"
|
||||
, "sksACIWBCo1rvLzrPXsLYOeV3cDDtYAkSwGfuzC1Etbe+qgfIroFTOqdefMw4s8A"
|
||||
, "AwUH/0KLXm4MS54QQspg3evu4Q4U/E8Hem5/FqB0GhBCitQ4rUsucKyY8/ItpUn5"
|
||||
, "ismLE60bQqka+Mzd/Zw18TCTzImv0ozAaZ2sNtBado7f6jcC8EDfY5zzK1ukcsAr"
|
||||
, "Qc5hdLHYuTQW5KpA6fKaW969OUzIwPbdVaCOLOBpxKC6N6iBspQYd6uiQtLw6EUO"
|
||||
, "50oQqUiJABf0eOocvdw5e2KQQpuC3205+VMYtyl4w3pdJihK8NK0AikGXzDVsbQt"
|
||||
, "l8kmB5ZrN4WIKhMke1FxbqQC5Q3XATvYRzpzzisZb/HYGNti8W6du5EUwJ0D2NRh"
|
||||
, "cu+twocOzW0VKfmrDApfifJ9OsSISQQYEQIACQUCR/O5RAIbDAAKCRBG53tJR95L"
|
||||
, "seQOAJ95KUyzjRjdYgZkDC69Mgu25L86UACdGduINUaRly43ag4kwUXxpqswBBM="
|
||||
, "=i2c3"
|
||||
, "-----END PGP PUBLIC KEY BLOCK-----"
|
||||
]
|
|
@ -0,0 +1,30 @@
|
|||
module Propellor.Property.OpenId where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.Service as Service
|
||||
|
||||
import Data.List
|
||||
|
||||
providerFor :: [UserName] -> String -> Property
|
||||
providerFor users baseurl = propertyList desc $
|
||||
[ Apt.serviceInstalledRunning "apache2"
|
||||
, Apt.installed ["simpleid"]
|
||||
`onChange` Service.restarted "apache2"
|
||||
, File.fileProperty (desc ++ " configured")
|
||||
(map setbaseurl) "/etc/simpleid/config.inc"
|
||||
] ++ map identfile users
|
||||
where
|
||||
url = "http://"++baseurl++"/simpleid"
|
||||
desc = "openid provider " ++ url
|
||||
setbaseurl l
|
||||
| "SIMPLEID_BASE_URL" `isInfixOf` l =
|
||||
"define('SIMPLEID_BASE_URL', '"++url++"');"
|
||||
| otherwise = l
|
||||
|
||||
-- the identitites directory controls access, so open up
|
||||
-- file mode
|
||||
identfile u = File.hasPrivContentExposed
|
||||
(concat [ "/var/lib/simpleid/identities/", u, ".identity" ])
|
||||
(Context baseurl)
|
|
@ -0,0 +1,25 @@
|
|||
module Propellor.Property.Postfix where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
|
||||
installed :: Property
|
||||
installed = Apt.serviceInstalledRunning "postfix"
|
||||
|
||||
-- | Configures postfix as a satellite system, which
|
||||
-- relats all mail through a relay host, which defaults to smtp.domain.
|
||||
--
|
||||
-- The smarthost may refuse to relay mail on to other domains, without
|
||||
-- futher coniguration/keys. But this should be enough to get cron job
|
||||
-- mail flowing to a place where it will be seen.
|
||||
satellite :: Property
|
||||
satellite = setup `requires` installed
|
||||
where
|
||||
setup = trivial $ property "postfix satellite system" $ do
|
||||
hn <- asks hostName
|
||||
ensureProperty $ Apt.reConfigure "postfix"
|
||||
[ ("postfix/main_mailer_type", "select", "Satellite system")
|
||||
, ("postfix/root_address", "string", "root")
|
||||
, ("postfix/destinations", "string", " ")
|
||||
, ("postfix/mailname", "string", hn)
|
||||
]
|
|
@ -0,0 +1,7 @@
|
|||
module Propellor.Property.Reboot where
|
||||
|
||||
import Propellor
|
||||
|
||||
now :: Property
|
||||
now = cmdProperty "reboot" []
|
||||
`describe` "reboot now"
|
|
@ -0,0 +1,67 @@
|
|||
module Propellor.Property.Scheduled
|
||||
( period
|
||||
, periodParse
|
||||
, Recurrance(..)
|
||||
, WeekDay
|
||||
, MonthDay
|
||||
, YearDay
|
||||
) where
|
||||
|
||||
import Propellor
|
||||
import Utility.Scheduled
|
||||
|
||||
import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- | Makes a Property only be checked every so often.
|
||||
--
|
||||
-- This uses the description of the Property to keep track of when it was
|
||||
-- last run.
|
||||
period :: Property -> Recurrance -> Property
|
||||
period prop recurrance = flip describe desc $ adjustProperty prop $ \satisfy -> do
|
||||
lasttime <- liftIO $ getLastChecked (propertyDesc prop)
|
||||
nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
|
||||
t <- liftIO localNow
|
||||
if Just t >= nexttime
|
||||
then do
|
||||
r <- satisfy
|
||||
liftIO $ setLastChecked t (propertyDesc prop)
|
||||
return r
|
||||
else noChange
|
||||
where
|
||||
schedule = Schedule recurrance AnyTime
|
||||
desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
|
||||
|
||||
-- | Like period, but parse a human-friendly string.
|
||||
periodParse :: Property -> String -> Property
|
||||
periodParse prop s = case toRecurrance s of
|
||||
Just recurrance -> period prop recurrance
|
||||
Nothing -> property "periodParse" $ do
|
||||
liftIO $ warningMessage $ "failed periodParse: " ++ s
|
||||
noChange
|
||||
|
||||
lastCheckedFile :: FilePath
|
||||
lastCheckedFile = localdir </> ".lastchecked"
|
||||
|
||||
getLastChecked :: Desc -> IO (Maybe LocalTime)
|
||||
getLastChecked desc = M.lookup desc <$> readLastChecked
|
||||
|
||||
localNow :: IO LocalTime
|
||||
localNow = do
|
||||
now <- getCurrentTime
|
||||
tz <- getTimeZone now
|
||||
return $ utcToLocalTime tz now
|
||||
|
||||
setLastChecked :: LocalTime -> Desc -> IO ()
|
||||
setLastChecked time desc = do
|
||||
m <- readLastChecked
|
||||
writeLastChecked (M.insert desc time m)
|
||||
|
||||
readLastChecked :: IO (M.Map Desc LocalTime)
|
||||
readLastChecked = fromMaybe M.empty <$> catchDefaultIO Nothing go
|
||||
where
|
||||
go = readish <$> readFileStrict lastCheckedFile
|
||||
|
||||
writeLastChecked :: M.Map Desc LocalTime -> IO ()
|
||||
writeLastChecked = writeFile lastCheckedFile . show
|
|
@ -0,0 +1,31 @@
|
|||
module Propellor.Property.Service where
|
||||
|
||||
import Propellor
|
||||
import Utility.SafeCommand
|
||||
|
||||
type ServiceName = String
|
||||
|
||||
-- | Ensures that a service is running. Does not ensure that
|
||||
-- any package providing that service is installed. See
|
||||
-- Apt.serviceInstalledRunning
|
||||
--
|
||||
-- Note that due to the general poor state of init scripts, the best
|
||||
-- we can do is try to start the service, and if it fails, assume
|
||||
-- this means it's already running.
|
||||
running :: ServiceName -> Property
|
||||
running svc = property ("running " ++ svc) $ do
|
||||
void $ ensureProperty $
|
||||
scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
|
||||
return NoChange
|
||||
|
||||
restarted :: ServiceName -> Property
|
||||
restarted svc = property ("restarted " ++ svc) $ do
|
||||
void $ ensureProperty $
|
||||
scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"]
|
||||
return NoChange
|
||||
|
||||
reloaded :: ServiceName -> Property
|
||||
reloaded svc = property ("reloaded " ++ svc) $ do
|
||||
void $ ensureProperty $
|
||||
scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"]
|
||||
return NoChange
|
|
@ -0,0 +1,178 @@
|
|||
module Propellor.Property.SiteSpecific.GitAnnexBuilder where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.User as User
|
||||
import qualified Propellor.Property.Cron as Cron
|
||||
import qualified Propellor.Property.Ssh as Ssh
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Docker as Docker
|
||||
import Propellor.Property.Cron (CronTimes)
|
||||
|
||||
builduser :: UserName
|
||||
builduser = "builder"
|
||||
|
||||
homedir :: FilePath
|
||||
homedir = "/home/builder"
|
||||
|
||||
gitbuilderdir :: FilePath
|
||||
gitbuilderdir = homedir </> "gitbuilder"
|
||||
|
||||
builddir :: FilePath
|
||||
builddir = gitbuilderdir </> "build"
|
||||
|
||||
type TimeOut = String -- eg, 5h
|
||||
|
||||
autobuilder :: Architecture -> CronTimes -> TimeOut -> Property
|
||||
autobuilder arch crontimes timeout = combineProperties "gitannexbuilder"
|
||||
[ Apt.serviceInstalledRunning "cron"
|
||||
, Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $
|
||||
"git pull ; timeout " ++ timeout ++ " ./autobuild"
|
||||
-- The builduser account does not have a password set,
|
||||
-- instead use the password privdata to hold the rsync server
|
||||
-- password used to upload the built image.
|
||||
, withPrivData (Password builduser) context $ \getpw ->
|
||||
property "rsync password" $ getpw $ \pw -> do
|
||||
oldpw <- liftIO $ catchDefaultIO "" $
|
||||
readFileStrict pwfile
|
||||
if pw /= oldpw
|
||||
then makeChange $ writeFile pwfile pw
|
||||
else noChange
|
||||
]
|
||||
where
|
||||
context = Context ("gitannexbuilder " ++ arch)
|
||||
pwfile = homedir </> "rsyncpassword"
|
||||
|
||||
tree :: Architecture -> Property
|
||||
tree buildarch = combineProperties "gitannexbuilder tree"
|
||||
[ Apt.installed ["git"]
|
||||
-- gitbuilderdir directory already exists when docker volume is used,
|
||||
-- but with wrong owner.
|
||||
, File.dirExists gitbuilderdir
|
||||
, File.ownerGroup gitbuilderdir builduser builduser
|
||||
, check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
|
||||
userScriptProperty builduser
|
||||
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
|
||||
, "cd " ++ gitbuilderdir
|
||||
, "git checkout " ++ buildarch
|
||||
]
|
||||
`describe` "gitbuilder setup"
|
||||
, check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser
|
||||
[ "git clone git://git-annex.branchable.com/ " ++ builddir
|
||||
]
|
||||
]
|
||||
|
||||
buildDepsApt :: Property
|
||||
buildDepsApt = combineProperties "gitannexbuilder build deps"
|
||||
[ Apt.buildDep ["git-annex"]
|
||||
, buildDepsNoHaskellLibs
|
||||
, "git-annex source build deps installed" ==> Apt.buildDepIn builddir
|
||||
]
|
||||
|
||||
buildDepsNoHaskellLibs :: Property
|
||||
buildDepsNoHaskellLibs = Apt.installed
|
||||
["git", "rsync", "moreutils", "ca-certificates",
|
||||
"debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt",
|
||||
"liblockfile-simple-perl", "cabal-install", "vim", "less",
|
||||
-- needed by haskell libs
|
||||
"libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls-dev",
|
||||
"alex", "happy", "c2hs"
|
||||
]
|
||||
|
||||
-- Installs current versions of git-annex's deps from cabal, but only
|
||||
-- does so once.
|
||||
cabalDeps :: Property
|
||||
cabalDeps = flagFile go cabalupdated
|
||||
where
|
||||
go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"]
|
||||
cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache"
|
||||
|
||||
standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host
|
||||
standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder")
|
||||
(dockerImage $ System (Debian Testing) arch)
|
||||
& os (System (Debian Testing) arch)
|
||||
& Apt.stdSourcesList
|
||||
& Apt.installed ["systemd"]
|
||||
& Apt.unattendedUpgrades
|
||||
& User.accountFor builduser
|
||||
& tree arch
|
||||
& buildDepsApt
|
||||
& autobuilder arch (show buildminute ++ " * * * *") timeout
|
||||
|
||||
androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
|
||||
androidAutoBuilderContainer dockerImage crontimes timeout =
|
||||
androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir
|
||||
& Apt.unattendedUpgrades
|
||||
& autobuilder "android" crontimes timeout
|
||||
|
||||
-- Android is cross-built in a Debian i386 container, using the Android NDK.
|
||||
androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host
|
||||
androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name
|
||||
(dockerImage $ System (Debian Stable) "i386")
|
||||
& os (System (Debian Stable) "i386")
|
||||
& Apt.stdSourcesList
|
||||
& Apt.installed ["systemd"]
|
||||
& User.accountFor builduser
|
||||
& File.dirExists gitbuilderdir
|
||||
& File.ownerGroup homedir builduser builduser
|
||||
& buildDepsNoHaskellLibs
|
||||
& flagFile chrootsetup ("/chrootsetup")
|
||||
`requires` setupgitannexdir
|
||||
-- TODO: automate installing haskell libs
|
||||
-- (Currently have to run
|
||||
-- git-annex/standalone/android/install-haskell-packages
|
||||
-- which is not fully automated.)
|
||||
where
|
||||
-- Use git-annex's android chroot setup script, which will install
|
||||
-- ghc-android and the NDK, all build deps, etc, in the home
|
||||
-- directory of the builder user.
|
||||
chrootsetup = scriptProperty
|
||||
[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot"
|
||||
]
|
||||
|
||||
-- armel builder has a companion container using amd64 that
|
||||
-- runs the build first to get TH splices. They need
|
||||
-- to have the same versions of all haskell libraries installed.
|
||||
armelCompanionContainer :: (System -> Docker.Image) -> Host
|
||||
armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion"
|
||||
(dockerImage $ System (Debian Unstable) "amd64")
|
||||
& os (System (Debian Testing) "amd64")
|
||||
& Apt.stdSourcesList
|
||||
& Apt.installed ["systemd"]
|
||||
& Apt.unattendedUpgrades
|
||||
-- This volume is shared with the armel builder.
|
||||
& Docker.volume gitbuilderdir
|
||||
& User.accountFor builduser
|
||||
-- Install current versions of build deps from cabal.
|
||||
& tree "armel"
|
||||
& buildDepsNoHaskellLibs
|
||||
& cabalDeps
|
||||
-- The armel builder can ssh to this companion.
|
||||
& Docker.expose "22"
|
||||
& Apt.serviceInstalledRunning "ssh"
|
||||
& Ssh.authorizedKeys builduser (Context "armel-git-annex-builder")
|
||||
|
||||
armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host
|
||||
armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder"
|
||||
(dockerImage $ System (Debian Unstable) "armel")
|
||||
& os (System (Debian Testing) "armel")
|
||||
& Apt.stdSourcesList
|
||||
& Apt.unattendedUpgrades
|
||||
& Apt.installed ["systemd"]
|
||||
& Apt.installed ["openssh-client"]
|
||||
& Docker.link "armel-git-annex-builder-companion" "companion"
|
||||
& Docker.volumes_from "armel-git-annex-builder-companion"
|
||||
& User.accountFor builduser
|
||||
-- TODO: automate installing haskell libs
|
||||
-- (Currently have to run
|
||||
-- git-annex/standalone/linux/install-haskell-packages
|
||||
-- which is not fully automated.)
|
||||
& buildDepsNoHaskellLibs
|
||||
& autobuilder "armel" crontimes timeout
|
||||
`requires` tree "armel"
|
||||
& Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder")
|
||||
& trivial writecompanionaddress
|
||||
where
|
||||
writecompanionaddress = scriptProperty
|
||||
[ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir </> "companion_address"
|
||||
] `describe` "companion_address file"
|
|
@ -0,0 +1,34 @@
|
|||
module Propellor.Property.SiteSpecific.GitHome where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import Propellor.Property.User
|
||||
import Utility.SafeCommand
|
||||
|
||||
-- | Clones Joey Hess's git home directory, and runs its fixups script.
|
||||
installedFor :: UserName -> Property
|
||||
installedFor user = check (not <$> hasGitDir user) $
|
||||
property ("githome " ++ user) (go =<< liftIO (homedir user))
|
||||
`requires` Apt.installed ["git"]
|
||||
where
|
||||
go home = do
|
||||
let tmpdir = home </> "githome"
|
||||
ensureProperty $ combineProperties "githome setup"
|
||||
[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
|
||||
, property "moveout" $ makeChange $ void $
|
||||
moveout tmpdir home
|
||||
, property "rmdir" $ makeChange $ void $
|
||||
catchMaybeIO $ removeDirectory tmpdir
|
||||
, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
|
||||
]
|
||||
moveout tmpdir home = do
|
||||
fs <- dirContents tmpdir
|
||||
forM fs $ \f -> boolSystem "mv" [File f, File home]
|
||||
|
||||
url :: String
|
||||
url = "git://git.kitenet.net/joey/home"
|
||||
|
||||
hasGitDir :: UserName -> IO Bool
|
||||
hasGitDir user = go =<< homedir user
|
||||
where
|
||||
go home = doesDirectoryExist (home </> ".git")
|
|
@ -0,0 +1,362 @@
|
|||
-- | Specific configuation for Joey Hess's sites. Probably not useful to
|
||||
-- others except as an example.
|
||||
|
||||
module Propellor.Property.SiteSpecific.JoeySites where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Gpg as Gpg
|
||||
import qualified Propellor.Property.Ssh as Ssh
|
||||
import qualified Propellor.Property.Git as Git
|
||||
import qualified Propellor.Property.Cron as Cron
|
||||
import qualified Propellor.Property.Service as Service
|
||||
import qualified Propellor.Property.User as User
|
||||
import qualified Propellor.Property.Obnam as Obnam
|
||||
import qualified Propellor.Property.Apache as Apache
|
||||
import Utility.SafeCommand
|
||||
import Utility.FileMode
|
||||
import Utility.Path
|
||||
|
||||
import Data.List
|
||||
import System.Posix.Files
|
||||
|
||||
oldUseNetServer :: [Host] -> Property
|
||||
oldUseNetServer hosts = propertyList ("olduse.net server")
|
||||
[ oldUseNetInstalled "oldusenet-server"
|
||||
, Obnam.latestVersion
|
||||
, Obnam.backup datadir "33 4 * * *"
|
||||
[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"
|
||||
, "--client-name=spool"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context "olduse.net")
|
||||
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
|
||||
, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $
|
||||
property "olduse.net spool in place" $ makeChange $ do
|
||||
removeDirectoryRecursive newsspool
|
||||
createSymbolicLink (datadir </> "news") newsspool
|
||||
, Apt.installed ["leafnode"]
|
||||
, "/etc/news/leafnode/config" `File.hasContent`
|
||||
[ "# olduse.net configuration (deployed by propellor)"
|
||||
, "expire = 1000000" -- no expiry via texpire
|
||||
, "server = " -- no upstream server
|
||||
, "debugmode = 1"
|
||||
, "allowSTRANGERS = 42" -- lets anyone connect
|
||||
, "nopost = 1" -- no new posting (just gather them)
|
||||
]
|
||||
, "/etc/hosts.deny" `File.lacksLine` "leafnode: ALL"
|
||||
, Apt.serviceInstalledRunning "openbsd-inetd"
|
||||
, File.notPresent "/etc/cron.daily/leafnode"
|
||||
, File.notPresent "/etc/cron.d/leafnode"
|
||||
, Cron.niceJob "oldusenet-expire" "11 1 * * *" "news" newsspool $ intercalate ";"
|
||||
[ "find \\( -path ./out.going -or -path ./interesting.groups -or -path './*/.overview' \\) -prune -or -type f -ctime +60 -print | xargs --no-run-if-empty rm"
|
||||
, "find -type d -empty | xargs --no-run-if-empty rmdir"
|
||||
]
|
||||
, Cron.niceJob "oldusenet-uucp" "*/5 * * * *" "news" "/" $
|
||||
"/usr/bin/uucp " ++ datadir
|
||||
, toProp $ Apache.siteEnabled "nntp.olduse.net" $ apachecfg "nntp.olduse.net" False
|
||||
[ " DocumentRoot " ++ datadir ++ "/"
|
||||
, " <Directory " ++ datadir ++ "/>"
|
||||
, " Options Indexes FollowSymlinks"
|
||||
, " AllowOverride None"
|
||||
-- I had this in the file before.
|
||||
-- This may be needed by a newer version of apache?
|
||||
--, " Require all granted"
|
||||
, " </Directory>"
|
||||
]
|
||||
]
|
||||
where
|
||||
newsspool = "/var/spool/news"
|
||||
datadir = "/var/spool/oldusenet"
|
||||
|
||||
oldUseNetShellBox :: Property
|
||||
oldUseNetShellBox = oldUseNetInstalled "oldusenet"
|
||||
|
||||
oldUseNetInstalled :: Apt.Package -> Property
|
||||
oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
|
||||
propertyList ("olduse.net " ++ pkg)
|
||||
[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
|
||||
`describe` "olduse.net build deps"
|
||||
, scriptProperty
|
||||
[ "rm -rf /root/tmp/oldusenet" -- idenpotency
|
||||
, "git clone git://olduse.net/ /root/tmp/oldusenet/source"
|
||||
, "cd /root/tmp/oldusenet/source/"
|
||||
, "dpkg-buildpackage -us -uc"
|
||||
, "dpkg -i ../" ++ pkg ++ "_*.deb || true"
|
||||
, "apt-get -fy install" -- dependencies
|
||||
, "rm -rf /root/tmp/oldusenet"
|
||||
-- screen fails unless the directory has this mode.
|
||||
-- not sure what's going on.
|
||||
, "chmod 777 /var/run/screen"
|
||||
] `describe` "olduse.net built"
|
||||
]
|
||||
|
||||
|
||||
kgbServer :: Property
|
||||
kgbServer = propertyList desc
|
||||
[ withOS desc $ \o -> case o of
|
||||
(Just (System (Debian Unstable) _)) ->
|
||||
ensureProperty $ propertyList desc
|
||||
[ Apt.serviceInstalledRunning "kgb-bot"
|
||||
, "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
|
||||
`describe` "kgb bot enabled"
|
||||
`onChange` Service.running "kgb-bot"
|
||||
]
|
||||
_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
|
||||
, File.hasPrivContent "/etc/kgb-bot/kgb.conf" anyContext
|
||||
`onChange` Service.restarted "kgb-bot"
|
||||
]
|
||||
where
|
||||
desc = "kgb.kitenet.net setup"
|
||||
|
||||
mumbleServer :: [Host] -> Property
|
||||
mumbleServer hosts = combineProperties hn
|
||||
[ Apt.serviceInstalledRunning "mumble-server"
|
||||
, Obnam.latestVersion
|
||||
, Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
|
||||
[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
|
||||
, "--client-name=mumble"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context hn)
|
||||
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
|
||||
, trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
|
||||
]
|
||||
where
|
||||
hn = "mumble.debian.net"
|
||||
|
||||
obnamLowMem :: Property
|
||||
obnamLowMem = combineProperties "obnam tuned for low memory use"
|
||||
[ Obnam.latestVersion
|
||||
, "/etc/obnam.conf" `File.containsLines`
|
||||
[ "[config]"
|
||||
, "# Suggested by liw to keep Obnam memory consumption down (at some speed cost)."
|
||||
, "upload-queue-size = 128"
|
||||
, "lru-size = 128"
|
||||
]
|
||||
]
|
||||
|
||||
-- git.kitenet.net and git.joeyh.name
|
||||
gitServer :: [Host] -> Property
|
||||
gitServer hosts = propertyList "git.kitenet.net setup"
|
||||
[ Obnam.latestVersion
|
||||
, Obnam.backup "/srv/git" "33 3 * * *"
|
||||
[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
|
||||
, "--encrypt-with=1B169BE1"
|
||||
, "--client-name=wren"
|
||||
] Obnam.OnlyClient
|
||||
`requires` Gpg.keyImported "1B169BE1" "root"
|
||||
`requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
|
||||
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"
|
||||
`requires` Ssh.authorizedKeys "family" (Context "git.kitenet.net")
|
||||
`requires` User.accountFor "family"
|
||||
, Apt.installed ["git", "rsync", "gitweb"]
|
||||
-- backport avoids channel flooding on branch merge
|
||||
, Apt.installedBackport ["kgb-client"]
|
||||
-- backport supports ssh event notification
|
||||
, Apt.installedBackport ["git-annex"]
|
||||
, File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" anyContext
|
||||
, toProp $ Git.daemonRunning "/srv/git"
|
||||
, "/etc/gitweb.conf" `File.containsLines`
|
||||
[ "$projectroot = '/srv/git';"
|
||||
, "@git_base_url_list = ('git://git.kitenet.net', 'http://git.kitenet.net/git', 'https://git.kitenet.net/git', 'ssh://git.kitenet.net/srv/git');"
|
||||
, "# disable snapshot download; overloads server"
|
||||
, "$feature{'snapshot'}{'default'} = [];"
|
||||
]
|
||||
`describe` "gitweb configured"
|
||||
-- Repos push on to github.
|
||||
, Ssh.knownHost hosts "github.com" "joey"
|
||||
-- I keep the website used for gitweb checked into git..
|
||||
, Git.cloned "root" "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing
|
||||
, website "git.kitenet.net"
|
||||
, website "git.joeyh.name"
|
||||
, toProp $ Apache.modEnabled "cgi"
|
||||
]
|
||||
where
|
||||
website hn = toProp $ Apache.siteEnabled hn $ apachecfg hn True
|
||||
[ " DocumentRoot /srv/web/git.kitenet.net/"
|
||||
, " <Directory /srv/web/git.kitenet.net/>"
|
||||
, " Options Indexes ExecCGI FollowSymlinks"
|
||||
, " AllowOverride None"
|
||||
, " AddHandler cgi-script .cgi"
|
||||
, " DirectoryIndex index.cgi"
|
||||
, " </Directory>"
|
||||
, ""
|
||||
, " ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
|
||||
, " <Directory /usr/lib/cgi-bin>"
|
||||
, " SetHandler cgi-script"
|
||||
, " Options ExecCGI"
|
||||
, " </Directory>"
|
||||
]
|
||||
|
||||
type AnnexUUID = String
|
||||
|
||||
-- | A website, with files coming from a git-annex repository.
|
||||
annexWebSite :: [Host] -> Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property
|
||||
annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using git-annex")
|
||||
[ Git.cloned "joey" origin dir Nothing
|
||||
`onChange` setup
|
||||
, postupdatehook `File.hasContent`
|
||||
[ "#!/bin/sh"
|
||||
, "exec git update-server-info"
|
||||
] `onChange`
|
||||
(postupdatehook `File.mode` (combineModes (ownerWriteMode:readModes ++ executeModes)))
|
||||
, setupapache
|
||||
]
|
||||
where
|
||||
dir = "/srv/web/" ++ hn
|
||||
postupdatehook = dir </> ".git/hooks/post-update"
|
||||
setup = userScriptProperty "joey" setupscript
|
||||
`requires` Ssh.keyImported SshRsa "joey" (Context hn)
|
||||
`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
|
||||
setupscript =
|
||||
[ "cd " ++ shellEscape dir
|
||||
, "git config annex.uuid " ++ shellEscape uuid
|
||||
] ++ map addremote remotes ++
|
||||
[ "git annex get"
|
||||
]
|
||||
addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url
|
||||
setupapache = toProp $ Apache.siteEnabled hn $ apachecfg hn True $
|
||||
[ " ServerAlias www."++hn
|
||||
, ""
|
||||
, " DocumentRoot /srv/web/"++hn
|
||||
, " <Directory /srv/web/"++hn++">"
|
||||
, " Options FollowSymLinks"
|
||||
, " AllowOverride None"
|
||||
, " </Directory>"
|
||||
, " <Directory /srv/web/"++hn++">"
|
||||
, " Options Indexes FollowSymLinks ExecCGI"
|
||||
, " AllowOverride None"
|
||||
, " AddHandler cgi-script .cgi"
|
||||
, " DirectoryIndex index.html index.cgi"
|
||||
, " Order allow,deny"
|
||||
, " allow from all"
|
||||
, " </Directory>"
|
||||
]
|
||||
|
||||
apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
|
||||
apachecfg hn withssl middle
|
||||
| withssl = vhost False ++ vhost True
|
||||
| otherwise = vhost False
|
||||
where
|
||||
vhost ssl =
|
||||
[ "<VirtualHost *:"++show port++">"
|
||||
, " ServerAdmin grue@joeyh.name"
|
||||
, " ServerName "++hn++":"++show port
|
||||
]
|
||||
++ mainhttpscert ssl
|
||||
++ middle ++
|
||||
[ ""
|
||||
, " ErrorLog /var/log/apache2/error.log"
|
||||
, " LogLevel warn"
|
||||
, " CustomLog /var/log/apache2/access.log combined"
|
||||
, " ServerSignature On"
|
||||
, " "
|
||||
, " <Directory \"/usr/share/apache2/icons\">"
|
||||
, " Options Indexes MultiViews"
|
||||
, " AllowOverride None"
|
||||
, " Order allow,deny"
|
||||
, " Allow from all"
|
||||
, " </Directory>"
|
||||
, "</VirtualHost>"
|
||||
]
|
||||
where
|
||||
port = if ssl then 443 else 80 :: Int
|
||||
|
||||
mainhttpscert :: Bool -> Apache.ConfigFile
|
||||
mainhttpscert False = []
|
||||
mainhttpscert True =
|
||||
[ " SSLEngine on"
|
||||
, " SSLCertificateFile /etc/ssl/certs/web.pem"
|
||||
, " SSLCertificateKeyFile /etc/ssl/private/web.pem"
|
||||
, " SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
|
||||
]
|
||||
|
||||
gitAnnexDistributor :: Property
|
||||
gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
|
||||
[ Apt.installed ["rsync"]
|
||||
, File.hasPrivContent "/etc/rsyncd.conf" (Context "git-annex distributor")
|
||||
`onChange` Service.restarted "rsync"
|
||||
, File.hasPrivContent "/etc/rsyncd.secrets" (Context "git-annex distributor")
|
||||
`onChange` Service.restarted "rsync"
|
||||
, "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
|
||||
`onChange` Service.running "rsync"
|
||||
, endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild"
|
||||
, endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks"
|
||||
-- git-annex distribution signing key
|
||||
, Gpg.keyImported "89C809CB" "joey"
|
||||
]
|
||||
where
|
||||
endpoint d = combineProperties ("endpoint " ++ d)
|
||||
[ File.dirExists d
|
||||
, File.ownerGroup d "joey" "joey"
|
||||
]
|
||||
|
||||
-- Twitter, you kill us.
|
||||
twitRss :: Property
|
||||
twitRss = combineProperties "twitter rss"
|
||||
[ Git.cloned "joey" "git://git.kitenet.net/twitrss.git" dir Nothing
|
||||
, check (not <$> doesFileExist (dir </> "twitRss")) $
|
||||
userScriptProperty "joey"
|
||||
[ "cd " ++ dir
|
||||
, "ghc --make twitRss"
|
||||
]
|
||||
`requires` Apt.installed
|
||||
[ "libghc-xml-dev"
|
||||
, "libghc-feed-dev"
|
||||
, "libghc-tagsoup-dev"
|
||||
]
|
||||
, feed "http://twitter.com/search/realtime?q=git-annex" "git-annex-twitter"
|
||||
, feed "http://twitter.com/search/realtime?q=olduse+OR+git-annex+OR+debhelper+OR+etckeeper+OR+ikiwiki+-ashley_ikiwiki" "twittergrep"
|
||||
]
|
||||
where
|
||||
dir = "/srv/web/tmp.kitenet.net/twitrss"
|
||||
crontime = "15 * * * *"
|
||||
feed url desc = Cron.job desc crontime "joey" dir $
|
||||
"./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss")
|
||||
|
||||
ircBouncer :: Property
|
||||
ircBouncer = propertyList "IRC bouncer"
|
||||
[ Apt.installed ["znc"]
|
||||
, User.accountFor "znc"
|
||||
, File.dirExists (parentDir conf)
|
||||
, File.hasPrivContent conf anyContext
|
||||
, File.ownerGroup conf "znc" "znc"
|
||||
, Cron.job "znconboot" "@reboot" "znc" "~" "znc"
|
||||
-- ensure running if it was not already
|
||||
, trivial $ userScriptProperty "znc" ["znc || true"]
|
||||
`describe` "znc running"
|
||||
]
|
||||
where
|
||||
conf = "/home/znc/.znc/configs/znc.conf"
|
||||
|
||||
kiteShellBox :: Property
|
||||
kiteShellBox = propertyList "kitenet.net shellinabox"
|
||||
[ Apt.installed ["shellinabox"]
|
||||
, File.hasContent "/etc/default/shellinabox"
|
||||
[ "# Deployed by propellor"
|
||||
, "SHELLINABOX_DAEMON_START=1"
|
||||
, "SHELLINABOX_PORT=443"
|
||||
, "SHELLINABOX_ARGS=\"--no-beep --service=/:SSH:kitenet.net\""
|
||||
]
|
||||
`onChange` Service.restarted "shellinabox"
|
||||
, Service.running "shellinabox"
|
||||
]
|
||||
|
||||
githubBackup :: Property
|
||||
githubBackup = propertyList "github-backup box"
|
||||
[ Apt.installed ["github-backup", "moreutils"]
|
||||
, let f = "/home/joey/.github-keys"
|
||||
in File.hasPrivContent f anyContext
|
||||
`onChange` File.ownerGroup f "joey" "joey"
|
||||
]
|
||||
|
||||
obnamRepos :: [String] -> Property
|
||||
obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
|
||||
(mkbase : map mkrepo rs)
|
||||
where
|
||||
mkbase = mkdir "/home/joey/lib/backup"
|
||||
`requires` mkdir "/home/joey/lib"
|
||||
mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam")
|
||||
mkdir d = File.dirExists d
|
||||
`before` File.ownerGroup d "joey" "joey"
|
||||
|
|
@ -0,0 +1,166 @@
|
|||
module Propellor.Property.Ssh (
|
||||
setSshdConfig,
|
||||
permitRootLogin,
|
||||
passwordAuthentication,
|
||||
hasAuthorizedKeys,
|
||||
restartSshd,
|
||||
randomHostKeys,
|
||||
hostKeys,
|
||||
hostKey,
|
||||
keyImported,
|
||||
knownHost,
|
||||
authorizedKeys
|
||||
) where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import Propellor.Property.User
|
||||
import Utility.SafeCommand
|
||||
import Utility.FileMode
|
||||
|
||||
import System.PosixCompat
|
||||
|
||||
sshBool :: Bool -> String
|
||||
sshBool True = "yes"
|
||||
sshBool False = "no"
|
||||
|
||||
sshdConfig :: FilePath
|
||||
sshdConfig = "/etc/ssh/sshd_config"
|
||||
|
||||
setSshdConfig :: String -> Bool -> Property
|
||||
setSshdConfig setting allowed = combineProperties "sshd config"
|
||||
[ sshdConfig `File.lacksLine` (sshline $ not allowed)
|
||||
, sshdConfig `File.containsLine` (sshline allowed)
|
||||
]
|
||||
`onChange` restartSshd
|
||||
`describe` unwords [ "ssh config:", setting, sshBool allowed ]
|
||||
where
|
||||
sshline v = setting ++ " " ++ sshBool v
|
||||
|
||||
permitRootLogin :: Bool -> Property
|
||||
permitRootLogin = setSshdConfig "PermitRootLogin"
|
||||
|
||||
passwordAuthentication :: Bool -> Property
|
||||
passwordAuthentication = setSshdConfig "PasswordAuthentication"
|
||||
|
||||
dotDir :: UserName -> IO FilePath
|
||||
dotDir user = do
|
||||
h <- homedir user
|
||||
return $ h </> ".ssh"
|
||||
|
||||
dotFile :: FilePath -> UserName -> IO FilePath
|
||||
dotFile f user = do
|
||||
d <- dotDir user
|
||||
return $ d </> f
|
||||
|
||||
hasAuthorizedKeys :: UserName -> IO Bool
|
||||
hasAuthorizedKeys = go <=< dotFile "authorized_keys"
|
||||
where
|
||||
go f = not . null <$> catchDefaultIO "" (readFile f)
|
||||
|
||||
restartSshd :: Property
|
||||
restartSshd = cmdProperty "service" ["ssh", "restart"]
|
||||
|
||||
-- | Blows away existing host keys and make new ones.
|
||||
-- Useful for systems installed from an image that might reuse host keys.
|
||||
-- A flag file is used to only ever do this once.
|
||||
randomHostKeys :: Property
|
||||
randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
|
||||
`onChange` restartSshd
|
||||
where
|
||||
prop = property "ssh random host keys" $ do
|
||||
void $ liftIO $ boolSystem "sh"
|
||||
[ Param "-c"
|
||||
, Param "rm -f /etc/ssh/ssh_host_*"
|
||||
]
|
||||
ensureProperty $ scriptProperty
|
||||
[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
|
||||
|
||||
-- | Sets all types of ssh host keys from the privdata.
|
||||
hostKeys :: Context -> Property
|
||||
hostKeys ctx = propertyList "known ssh host keys"
|
||||
[ hostKey SshDsa ctx
|
||||
, hostKey SshRsa ctx
|
||||
, hostKey SshEcdsa ctx
|
||||
]
|
||||
|
||||
-- | Sets a single ssh host key from the privdata.
|
||||
hostKey :: SshKeyType -> Context -> Property
|
||||
hostKey keytype context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype "") (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype "") (install writeFileProtected "")
|
||||
]
|
||||
`onChange` restartSshd
|
||||
where
|
||||
desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
|
||||
installkey p a = withPrivData p context $ \getkey ->
|
||||
property desc $ getkey a
|
||||
install writer ext key = do
|
||||
let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
|
||||
s <- liftIO $ readFileStrict f
|
||||
if s == key
|
||||
then noChange
|
||||
else makeChange $ writer f key
|
||||
|
||||
-- | Sets up a user with a ssh private key and public key pair from the
|
||||
-- PrivData.
|
||||
keyImported :: SshKeyType -> UserName -> Context -> Property
|
||||
keyImported keytype user context = combineProperties desc
|
||||
[ installkey (SshPubKey keytype user) (install writeFile ".pub")
|
||||
, installkey (SshPrivKey keytype user) (install writeFileProtected "")
|
||||
]
|
||||
where
|
||||
desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
|
||||
installkey p a = withPrivData p context $ \getkey ->
|
||||
property desc $ getkey a
|
||||
install writer ext key = do
|
||||
f <- liftIO $ keyfile ext
|
||||
ifM (liftIO $ doesFileExist f)
|
||||
( noChange
|
||||
, ensureProperties
|
||||
[ property desc $ makeChange $ do
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
writer f key
|
||||
, File.ownerGroup f user user
|
||||
, File.ownerGroup (takeDirectory f) user user
|
||||
]
|
||||
)
|
||||
keyfile ext = do
|
||||
home <- homeDirectory <$> getUserEntryForName user
|
||||
return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
|
||||
|
||||
fromKeyType :: SshKeyType -> String
|
||||
fromKeyType SshRsa = "rsa"
|
||||
fromKeyType SshDsa = "dsa"
|
||||
fromKeyType SshEcdsa = "ecdsa"
|
||||
fromKeyType SshEd25519 = "ed25519"
|
||||
|
||||
-- | Puts some host's ssh public key into the known_hosts file for a user.
|
||||
knownHost :: [Host] -> HostName -> UserName -> Property
|
||||
knownHost hosts hn user = property desc $
|
||||
go =<< fromHost hosts hn getSshPubKey
|
||||
where
|
||||
desc = user ++ " knows ssh key for " ++ hn
|
||||
go (Just (Just k)) = do
|
||||
f <- liftIO $ dotFile "known_hosts" user
|
||||
ensureProperty $ combineProperties desc
|
||||
[ File.dirExists (takeDirectory f)
|
||||
, f `File.containsLine` (hn ++ " " ++ k)
|
||||
, File.ownerGroup f user user
|
||||
]
|
||||
go _ = do
|
||||
warningMessage $ "no configred sshPubKey for " ++ hn
|
||||
return FailedChange
|
||||
|
||||
-- | Makes a user have authorized_keys from the PrivData
|
||||
authorizedKeys :: UserName -> Context -> Property
|
||||
authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get ->
|
||||
property (user ++ " has authorized_keys") $ get $ \v -> do
|
||||
f <- liftIO $ dotFile "authorized_keys" user
|
||||
liftIO $ do
|
||||
createDirectoryIfMissing True (takeDirectory f)
|
||||
writeFileProtected f v
|
||||
ensureProperties
|
||||
[ File.ownerGroup f user user
|
||||
, File.ownerGroup (takeDirectory f) user user
|
||||
]
|
|
@ -0,0 +1,32 @@
|
|||
module Propellor.Property.Sudo where
|
||||
|
||||
import Data.List
|
||||
|
||||
import Propellor
|
||||
import Propellor.Property.File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
import Propellor.Property.User
|
||||
|
||||
-- | Allows a user to sudo. If the user has a password, sudo is configured
|
||||
-- to require it. If not, NOPASSWORD is enabled for the user.
|
||||
enabledFor :: UserName -> Property
|
||||
enabledFor user = property desc go `requires` Apt.installed ["sudo"]
|
||||
where
|
||||
go = do
|
||||
locked <- liftIO $ isLockedPassword user
|
||||
ensureProperty $
|
||||
fileProperty desc
|
||||
(modify locked . filter (wanted locked))
|
||||
"/etc/sudoers"
|
||||
desc = user ++ " is sudoer"
|
||||
sudobaseline = user ++ " ALL=(ALL:ALL)"
|
||||
sudoline True = sudobaseline ++ " NOPASSWD:ALL"
|
||||
sudoline False = sudobaseline ++ " ALL"
|
||||
wanted locked l
|
||||
-- TOOD: Full sudoers file format parse..
|
||||
| not (sudobaseline `isPrefixOf` l) = True
|
||||
| "NOPASSWD" `isInfixOf` l = locked
|
||||
| otherwise = True
|
||||
modify locked ls
|
||||
| sudoline locked `elem` ls = ls
|
||||
| otherwise = ls ++ [sudoline locked]
|
|
@ -0,0 +1,19 @@
|
|||
module Propellor.Property.Tor where
|
||||
|
||||
import Propellor
|
||||
import qualified Propellor.Property.File as File
|
||||
import qualified Propellor.Property.Apt as Apt
|
||||
|
||||
isBridge :: Property
|
||||
isBridge = setup `requires` Apt.installed ["tor"]
|
||||
`describe` "tor bridge"
|
||||
where
|
||||
setup = "/etc/tor/torrc" `File.hasContent`
|
||||
[ "SocksPort 0"
|
||||
, "ORPort 443"
|
||||
, "BridgeRelay 1"
|
||||
, "Exitpolicy reject *:*"
|
||||
] `onChange` restartTor
|
||||
|
||||
restartTor :: Property
|
||||
restartTor = cmdProperty "service" ["tor", "restart"]
|
|
@ -0,0 +1,62 @@
|
|||
module Propellor.Property.User where
|
||||
|
||||
import System.Posix
|
||||
|
||||
import Propellor
|
||||
|
||||
data Eep = YesReallyDeleteHome
|
||||
|
||||
accountFor :: UserName -> Property
|
||||
accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser"
|
||||
[ "--disabled-password"
|
||||
, "--gecos", ""
|
||||
, user
|
||||
]
|
||||
`describe` ("account for " ++ user)
|
||||
|
||||
-- | Removes user home directory!! Use with caution.
|
||||
nuked :: UserName -> Eep -> Property
|
||||
nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel"
|
||||
[ "-r"
|
||||
, user
|
||||
]
|
||||
`describe` ("nuked user " ++ user)
|
||||
|
||||
-- | Only ensures that the user has some password set. It may or may
|
||||
-- not be the password from the PrivData.
|
||||
hasSomePassword :: UserName -> Context -> Property
|
||||
hasSomePassword user context = check ((/= HasPassword) <$> getPasswordStatus user) $
|
||||
hasPassword user context
|
||||
|
||||
hasPassword :: UserName -> Context -> Property
|
||||
hasPassword user context = withPrivData (Password user) context $ \getpassword ->
|
||||
property (user ++ " has password") $
|
||||
getpassword $ \password -> makeChange $
|
||||
withHandle StdinHandle createProcessSuccess
|
||||
(proc "chpasswd" []) $ \h -> do
|
||||
hPutStrLn h $ user ++ ":" ++ password
|
||||
hClose h
|
||||
|
||||
lockedPassword :: UserName -> Property
|
||||
lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
|
||||
[ "--lock"
|
||||
, user
|
||||
]
|
||||
`describe` ("locked " ++ user ++ " password")
|
||||
|
||||
data PasswordStatus = NoPassword | LockedPassword | HasPassword
|
||||
deriving (Eq)
|
||||
|
||||
getPasswordStatus :: UserName -> IO PasswordStatus
|
||||
getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
|
||||
where
|
||||
parse (_:"L":_) = LockedPassword
|
||||
parse (_:"NP":_) = NoPassword
|
||||
parse (_:"P":_) = HasPassword
|
||||
parse _ = NoPassword
|
||||
|
||||
isLockedPassword :: UserName -> IO Bool
|
||||
isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
|
||||
|
||||
homedir :: UserName -> IO FilePath
|
||||
homedir user = homeDirectory <$> getUserEntryForName user
|
|
@ -0,0 +1,101 @@
|
|||
-- | Simple server, using a named pipe. Client connects, sends a command,
|
||||
-- and gets back all the output from the command, in a stream.
|
||||
--
|
||||
-- This is useful for eg, docker.
|
||||
|
||||
module Propellor.SimpleSh where
|
||||
|
||||
import Network.Socket
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async
|
||||
import System.Process (std_in, std_out, std_err)
|
||||
|
||||
import Propellor
|
||||
import Utility.FileMode
|
||||
import Utility.ThreadScheduler
|
||||
|
||||
data Cmd = Cmd String [String]
|
||||
deriving (Read, Show)
|
||||
|
||||
data Resp = StdoutLine String | StderrLine String | Done
|
||||
deriving (Read, Show)
|
||||
|
||||
simpleSh :: FilePath -> IO ()
|
||||
simpleSh namedpipe = do
|
||||
nukeFile namedpipe
|
||||
let dir = takeDirectory namedpipe
|
||||
createDirectoryIfMissing True dir
|
||||
modifyFileMode dir (removeModes otherGroupModes)
|
||||
s <- socket AF_UNIX Stream defaultProtocol
|
||||
bindSocket s (SockAddrUnix namedpipe)
|
||||
listen s 2
|
||||
forever $ do
|
||||
(client, _addr) <- accept s
|
||||
forkIO $ do
|
||||
h <- socketToHandle client ReadWriteMode
|
||||
maybe noop (run h) . readish =<< hGetLine h
|
||||
where
|
||||
run h (Cmd cmd params) = do
|
||||
chan <- newChan
|
||||
let runwriter = do
|
||||
v <- readChan chan
|
||||
hPutStrLn h (show v)
|
||||
hFlush h
|
||||
case v of
|
||||
Done -> noop
|
||||
_ -> runwriter
|
||||
writer <- async runwriter
|
||||
|
||||
flip catchIO (\_e -> writeChan chan Done) $ do
|
||||
let p = (proc cmd params)
|
||||
{ std_in = Inherit
|
||||
, std_out = CreatePipe
|
||||
, std_err = CreatePipe
|
||||
}
|
||||
(Nothing, Just outh, Just errh, pid) <- createProcess p
|
||||
|
||||
let mkreader t from = maybe noop (const $ mkreader t from)
|
||||
=<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
|
||||
void $ concurrently
|
||||
(mkreader StdoutLine outh)
|
||||
(mkreader StderrLine errh)
|
||||
|
||||
void $ tryIO $ waitForProcess pid
|
||||
|
||||
writeChan chan Done
|
||||
|
||||
hClose outh
|
||||
hClose errh
|
||||
|
||||
wait writer
|
||||
hClose h
|
||||
|
||||
simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
|
||||
simpleShClient namedpipe cmd params handler = do
|
||||
s <- socket AF_UNIX Stream defaultProtocol
|
||||
connect s (SockAddrUnix namedpipe)
|
||||
h <- socketToHandle s ReadWriteMode
|
||||
hPutStrLn h $ show $ Cmd cmd params
|
||||
hFlush h
|
||||
resps <- catMaybes . map readish . lines <$> hGetContents h
|
||||
v <- hClose h `after` handler resps
|
||||
return v
|
||||
|
||||
simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
|
||||
simpleShClientRetry retries namedpipe cmd params handler = go retries
|
||||
where
|
||||
run = simpleShClient namedpipe cmd params handler
|
||||
go n
|
||||
| n < 1 = run
|
||||
| otherwise = do
|
||||
v <- tryIO run
|
||||
case v of
|
||||
Right r -> return r
|
||||
Left e -> do
|
||||
debug ["simplesh connection retry", show e]
|
||||
threadDelaySeconds (Seconds 1)
|
||||
go (n - 1)
|
||||
|
||||
getStdout :: Resp -> Maybe String
|
||||
getStdout (StdoutLine s) = Just s
|
||||
getStdout _ = Nothing
|
|
@ -0,0 +1,149 @@
|
|||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Propellor.Types
|
||||
( Host(..)
|
||||
, Info
|
||||
, getInfo
|
||||
, Propellor(..)
|
||||
, Property(..)
|
||||
, RevertableProperty(..)
|
||||
, IsProp
|
||||
, describe
|
||||
, toProp
|
||||
, requires
|
||||
, Desc
|
||||
, Result(..)
|
||||
, ActionResult(..)
|
||||
, CmdLine(..)
|
||||
, PrivDataField(..)
|
||||
, PrivData
|
||||
, Context(..)
|
||||
, anyContext
|
||||
, SshKeyType(..)
|
||||
, module Propellor.Types.OS
|
||||
, module Propellor.Types.Dns
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
import Control.Applicative
|
||||
import System.Console.ANSI
|
||||
import "mtl" Control.Monad.Reader
|
||||
import "MonadCatchIO-transformers" Control.Monad.CatchIO
|
||||
|
||||
import Propellor.Types.Info
|
||||
import Propellor.Types.OS
|
||||
import Propellor.Types.Dns
|
||||
import Propellor.Types.PrivData
|
||||
|
||||
-- | Everything Propellor knows about a system: Its hostname,
|
||||
-- properties and other info.
|
||||
data Host = Host
|
||||
{ hostName :: HostName
|
||||
, hostProperties :: [Property]
|
||||
, hostInfo :: Info
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- | Propellor's monad provides read-only access to info about the host
|
||||
-- it's running on.
|
||||
newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p }
|
||||
deriving
|
||||
( Monad
|
||||
, Functor
|
||||
, Applicative
|
||||
, MonadReader Host
|
||||
, MonadIO
|
||||
, MonadCatchIO
|
||||
)
|
||||
|
||||
-- | The core data type of Propellor, this represents a property
|
||||
-- that the system should have, and an action to ensure it has the
|
||||
-- property.
|
||||
data Property = Property
|
||||
{ propertyDesc :: Desc
|
||||
, propertySatisfy :: Propellor Result
|
||||
-- ^ must be idempotent; may run repeatedly
|
||||
, propertyInfo :: Info
|
||||
-- ^ a property can add info to the host.
|
||||
}
|
||||
|
||||
instance Show Property where
|
||||
show p = "property " ++ show (propertyDesc p)
|
||||
|
||||
-- | A property that can be reverted.
|
||||
data RevertableProperty = RevertableProperty Property Property
|
||||
|
||||
class IsProp p where
|
||||
-- | Sets description.
|
||||
describe :: p -> Desc -> p
|
||||
toProp :: p -> Property
|
||||
-- | Indicates that the first property can only be satisfied
|
||||
-- once the second one is.
|
||||
requires :: p -> Property -> p
|
||||
getInfo :: p -> Info
|
||||
|
||||
instance IsProp Property where
|
||||
describe p d = p { propertyDesc = d }
|
||||
toProp p = p
|
||||
getInfo = propertyInfo
|
||||
x `requires` y = Property (propertyDesc x) satisfy info
|
||||
where
|
||||
info = getInfo y <> getInfo x
|
||||
satisfy = do
|
||||
r <- propertySatisfy y
|
||||
case r of
|
||||
FailedChange -> return FailedChange
|
||||
_ -> propertySatisfy x
|
||||
|
||||
|
||||
instance IsProp RevertableProperty where
|
||||
-- | Sets the description of both sides.
|
||||
describe (RevertableProperty p1 p2) d =
|
||||
RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
|
||||
toProp (RevertableProperty p1 _) = p1
|
||||
(RevertableProperty p1 p2) `requires` y =
|
||||
RevertableProperty (p1 `requires` y) p2
|
||||
-- | Return the Info of the currently active side.
|
||||
getInfo (RevertableProperty p1 _p2) = getInfo p1
|
||||
|
||||
type Desc = String
|
||||
|
||||
data Result = NoChange | MadeChange | FailedChange
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
instance Monoid Result where
|
||||
mempty = NoChange
|
||||
|
||||
mappend FailedChange _ = FailedChange
|
||||
mappend _ FailedChange = FailedChange
|
||||
mappend MadeChange _ = MadeChange
|
||||
mappend _ MadeChange = MadeChange
|
||||
mappend NoChange NoChange = NoChange
|
||||
|
||||
-- | Results of actions, with color.
|
||||
class ActionResult a where
|
||||
getActionResult :: a -> (String, ColorIntensity, Color)
|
||||
|
||||
instance ActionResult Bool where
|
||||
getActionResult False = ("failed", Vivid, Red)
|
||||
getActionResult True = ("done", Dull, Green)
|
||||
|
||||
instance ActionResult Result where
|
||||
getActionResult NoChange = ("ok", Dull, Green)
|
||||
getActionResult MadeChange = ("done", Vivid, Green)
|
||||
getActionResult FailedChange = ("failed", Vivid, Red)
|
||||
|
||||
data CmdLine
|
||||
= Run HostName
|
||||
| Spin HostName
|
||||
| Boot HostName
|
||||
| Set PrivDataField Context
|
||||
| Dump PrivDataField Context
|
||||
| Edit PrivDataField Context
|
||||
| ListFields
|
||||
| AddKey String
|
||||
| Continue CmdLine
|
||||
| Chain HostName
|
||||
| Docker HostName
|
||||
deriving (Read, Show, Eq)
|
|
@ -0,0 +1,112 @@
|
|||
module Propellor.Types.Dns where
|
||||
|
||||
import Propellor.Types.OS (HostName)
|
||||
|
||||
import Data.Word
|
||||
import Data.Monoid
|
||||
import qualified Data.Map as M
|
||||
|
||||
type Domain = String
|
||||
|
||||
data IPAddr = IPv4 String | IPv6 String
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
fromIPAddr :: IPAddr -> String
|
||||
fromIPAddr (IPv4 addr) = addr
|
||||
fromIPAddr (IPv6 addr) = addr
|
||||
|
||||
-- | Represents a bind 9 named.conf file.
|
||||
data NamedConf = NamedConf
|
||||
{ confDomain :: Domain
|
||||
, confDnsServerType :: DnsServerType
|
||||
, confFile :: FilePath
|
||||
, confMasters :: [IPAddr]
|
||||
, confAllowTransfer :: [IPAddr]
|
||||
, confLines :: [String]
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data DnsServerType = Master | Secondary
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
-- | Represents a bind 9 zone file.
|
||||
data Zone = Zone
|
||||
{ zDomain :: Domain
|
||||
, zSOA :: SOA
|
||||
, zHosts :: [(BindDomain, Record)]
|
||||
}
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
-- | Every domain has a SOA record, which is big and complicated.
|
||||
data SOA = SOA
|
||||
{ sDomain :: BindDomain
|
||||
-- ^ Typically ns1.your.domain
|
||||
, sSerial :: SerialNumber
|
||||
-- ^ The most important parameter is the serial number,
|
||||
-- which must increase after each change.
|
||||
, sRefresh :: Integer
|
||||
, sRetry :: Integer
|
||||
, sExpire :: Integer
|
||||
, sNegativeCacheTTL :: Integer
|
||||
}
|
||||
deriving (Read, Show, Eq)
|
||||
|
||||
-- | Types of DNS records.
|
||||
--
|
||||
-- This is not a complete list, more can be added.
|
||||
data Record
|
||||
= Address IPAddr
|
||||
| CNAME BindDomain
|
||||
| MX Int BindDomain
|
||||
| NS BindDomain
|
||||
| TXT String
|
||||
| SRV Word16 Word16 Word16 BindDomain
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
getIPAddr :: Record -> Maybe IPAddr
|
||||
getIPAddr (Address addr) = Just addr
|
||||
getIPAddr _ = Nothing
|
||||
|
||||
getCNAME :: Record -> Maybe BindDomain
|
||||
getCNAME (CNAME d) = Just d
|
||||
getCNAME _ = Nothing
|
||||
|
||||
getNS :: Record -> Maybe BindDomain
|
||||
getNS (NS d) = Just d
|
||||
getNS _ = Nothing
|
||||
|
||||
-- | Bind serial numbers are unsigned, 32 bit integers.
|
||||
type SerialNumber = Word32
|
||||
|
||||
-- | Domains in the zone file must end with a period if they are absolute.
|
||||
--
|
||||
-- Let's use a type to keep absolute domains straight from relative
|
||||
-- domains.
|
||||
--
|
||||
-- The RootDomain refers to the top level of the domain, so can be used
|
||||
-- to add nameservers, MX's, etc to a domain.
|
||||
data BindDomain = RelDomain Domain | AbsDomain Domain | RootDomain
|
||||
deriving (Read, Show, Eq, Ord)
|
||||
|
||||
domainHostName :: BindDomain -> Maybe HostName
|
||||
domainHostName (RelDomain d) = Just d
|
||||
domainHostName (AbsDomain d) = Just d
|
||||
domainHostName RootDomain = Nothing
|
||||
|
||||
newtype NamedConfMap = NamedConfMap (M.Map Domain NamedConf)
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
-- | Adding a Master NamedConf stanza for a particulr domain always
|
||||
-- overrides an existing Secondary stanza for that domain, while a
|
||||
-- Secondary stanza is only added when there is no existing Master stanza.
|
||||
instance Monoid NamedConfMap where
|
||||
mempty = NamedConfMap M.empty
|
||||
mappend (NamedConfMap old) (NamedConfMap new) = NamedConfMap $
|
||||
M.unionWith combiner new old
|
||||
where
|
||||
combiner n o = case (confDnsServerType n, confDnsServerType o) of
|
||||
(Secondary, Master) -> o
|
||||
_ -> n
|
||||
|
||||
fromNamedConfMap :: NamedConfMap -> M.Map Domain NamedConf
|
||||
fromNamedConfMap (NamedConfMap m) = m
|
|
@ -0,0 +1,68 @@
|
|||
module Propellor.Types.Info where
|
||||
|
||||
import Propellor.Types.OS
|
||||
import Propellor.Types.PrivData
|
||||
import qualified Propellor.Types.Dns as Dns
|
||||
|
||||
import qualified Data.Set as S
|
||||
import Data.Monoid
|
||||
|
||||
-- | Information about a host.
|
||||
data Info = Info
|
||||
{ _os :: Val System
|
||||
, _privDataFields :: S.Set (PrivDataField, Context)
|
||||
, _sshPubKey :: Val String
|
||||
, _dns :: S.Set Dns.Record
|
||||
, _namedconf :: Dns.NamedConfMap
|
||||
, _dockerinfo :: DockerInfo
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Monoid Info where
|
||||
mempty = Info mempty mempty mempty mempty mempty mempty
|
||||
mappend old new = Info
|
||||
{ _os = _os old <> _os new
|
||||
, _privDataFields = _privDataFields old <> _privDataFields new
|
||||
, _sshPubKey = _sshPubKey old <> _sshPubKey new
|
||||
, _dns = _dns old <> _dns new
|
||||
, _namedconf = _namedconf old <> _namedconf new
|
||||
, _dockerinfo = _dockerinfo old <> _dockerinfo new
|
||||
}
|
||||
|
||||
data Val a = Val a | NoVal
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Monoid (Val a) where
|
||||
mempty = NoVal
|
||||
mappend old new = case new of
|
||||
NoVal -> old
|
||||
_ -> new
|
||||
|
||||
fromVal :: Val a -> Maybe a
|
||||
fromVal (Val a) = Just a
|
||||
fromVal NoVal = Nothing
|
||||
|
||||
data DockerInfo = DockerInfo
|
||||
{ _dockerImage :: Val String
|
||||
, _dockerRunParams :: [HostName -> String]
|
||||
}
|
||||
|
||||
instance Eq DockerInfo where
|
||||
x == y = and
|
||||
[ _dockerImage x == _dockerImage y
|
||||
, let simpl v = map (\a -> a "") (_dockerRunParams v)
|
||||
in simpl x == simpl y
|
||||
]
|
||||
|
||||
instance Monoid DockerInfo where
|
||||
mempty = DockerInfo mempty mempty
|
||||
mappend old new = DockerInfo
|
||||
{ _dockerImage = _dockerImage old <> _dockerImage new
|
||||
, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new
|
||||
}
|
||||
|
||||
instance Show DockerInfo where
|
||||
show a = unlines
|
||||
[ "docker image " ++ show (_dockerImage a)
|
||||
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
|
||||
]
|
|
@ -0,0 +1,27 @@
|
|||
module Propellor.Types.OS where
|
||||
|
||||
type HostName = String
|
||||
type UserName = String
|
||||
type GroupName = String
|
||||
|
||||
-- | High level descritption of a operating system.
|
||||
data System = System Distribution Architecture
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Distribution
|
||||
= Debian DebianSuite
|
||||
| Ubuntu Release
|
||||
deriving (Show, Eq)
|
||||
|
||||
data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | The release that currently corresponds to stable.
|
||||
stableRelease :: DebianSuite
|
||||
stableRelease = DebianRelease "wheezy"
|
||||
|
||||
isStable :: DebianSuite -> Bool
|
||||
isStable s = s == Stable || s == stableRelease
|
||||
|
||||
type Release = String
|
||||
type Architecture = String
|
|
@ -0,0 +1,34 @@
|
|||
module Propellor.Types.PrivData where
|
||||
|
||||
import Propellor.Types.OS
|
||||
|
||||
-- | Note that removing or changing field names will break the
|
||||
-- serialized privdata files, so don't do that!
|
||||
-- It's fine to add new fields.
|
||||
data PrivDataField
|
||||
= DockerAuthentication
|
||||
| SshPubKey SshKeyType UserName
|
||||
| SshPrivKey SshKeyType UserName
|
||||
| SshAuthorizedKeys UserName
|
||||
| Password UserName
|
||||
| PrivFile FilePath
|
||||
| GpgKey
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Context in which a PrivDataField is used.
|
||||
--
|
||||
-- Often this will be a domain name. For example,
|
||||
-- Context "www.example.com" could be used for the SSL cert
|
||||
-- for the web server serving that domain. Multiple hosts might
|
||||
-- use that privdata.
|
||||
newtype Context = Context String
|
||||
deriving (Read, Show, Ord, Eq)
|
||||
|
||||
-- | Use when a PrivDataField is not dependent on any paricular context.
|
||||
anyContext :: Context
|
||||
anyContext = Context "any"
|
||||
|
||||
type PrivData = String
|
||||
|
||||
data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519
|
||||
deriving (Read, Show, Ord, Eq)
|
|
@ -0,0 +1,16 @@
|
|||
{- applicative stuff
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.Applicative where
|
||||
|
||||
{- Like <$> , but supports one level of currying.
|
||||
-
|
||||
- foo v = bar <$> action v == foo = bar <$$> action
|
||||
-}
|
||||
(<$$>) :: Functor f => (a -> b) -> (c -> f a) -> c -> f b
|
||||
f <$$> v = fmap f . v
|
||||
infixr 4 <$$>
|
|
@ -0,0 +1,17 @@
|
|||
{- utilities for simple data types
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.Data where
|
||||
|
||||
{- First item in the list that is not Nothing. -}
|
||||
firstJust :: Eq a => [Maybe a] -> Maybe a
|
||||
firstJust ms = case dropWhile (== Nothing) ms of
|
||||
[] -> Nothing
|
||||
(md:_) -> md
|
||||
|
||||
eitherToMaybe :: Either a b -> Maybe b
|
||||
eitherToMaybe = either (const Nothing) Just
|
|
@ -0,0 +1,135 @@
|
|||
{- directory manipulation
|
||||
-
|
||||
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Directory where
|
||||
|
||||
import System.IO.Error
|
||||
import System.Directory
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
import System.FilePath
|
||||
import Control.Applicative
|
||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||
|
||||
import Utility.PosixFiles
|
||||
import Utility.SafeCommand
|
||||
import Utility.Tmp
|
||||
import Utility.Exception
|
||||
import Utility.Monad
|
||||
import Utility.Applicative
|
||||
|
||||
dirCruft :: FilePath -> Bool
|
||||
dirCruft "." = True
|
||||
dirCruft ".." = True
|
||||
dirCruft _ = False
|
||||
|
||||
{- Lists the contents of a directory.
|
||||
- Unlike getDirectoryContents, paths are not relative to the directory. -}
|
||||
dirContents :: FilePath -> IO [FilePath]
|
||||
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
|
||||
|
||||
{- Gets files in a directory, and then its subdirectories, recursively,
|
||||
- and lazily.
|
||||
-
|
||||
- Does not follow symlinks to other subdirectories.
|
||||
-
|
||||
- When the directory does not exist, no exception is thrown,
|
||||
- instead, [] is returned. -}
|
||||
dirContentsRecursive :: FilePath -> IO [FilePath]
|
||||
dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
|
||||
|
||||
{- Skips directories whose basenames match the skipdir. -}
|
||||
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]
|
||||
dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
|
||||
where
|
||||
go [] = return []
|
||||
go (dir:dirs)
|
||||
| skipdir (takeFileName dir) = go dirs
|
||||
| otherwise = unsafeInterleaveIO $ do
|
||||
(files, dirs') <- collect [] []
|
||||
=<< catchDefaultIO [] (dirContents dir)
|
||||
files' <- go (dirs' ++ dirs)
|
||||
return (files ++ files')
|
||||
collect files dirs' [] = return (reverse files, reverse dirs')
|
||||
collect files dirs' (entry:entries)
|
||||
| dirCruft entry = collect files dirs' entries
|
||||
| otherwise = do
|
||||
let skip = collect (entry:files) dirs' entries
|
||||
let recurse = collect files (entry:dirs') entries
|
||||
ms <- catchMaybeIO $ getSymbolicLinkStatus entry
|
||||
case ms of
|
||||
(Just s)
|
||||
| isDirectory s -> recurse
|
||||
| isSymbolicLink s && followsubdirsymlinks ->
|
||||
ifM (doesDirectoryExist entry)
|
||||
( recurse
|
||||
, skip
|
||||
)
|
||||
_ -> skip
|
||||
|
||||
{- Gets the directory tree from a point, recursively and lazily,
|
||||
- with leaf directories **first**, skipping any whose basenames
|
||||
- match the skipdir. Does not follow symlinks. -}
|
||||
dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
|
||||
dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
|
||||
where
|
||||
go c [] = return c
|
||||
go c (dir:dirs)
|
||||
| skipdir (takeFileName dir) = go c dirs
|
||||
| otherwise = unsafeInterleaveIO $ do
|
||||
subdirs <- go c
|
||||
=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
|
||||
=<< catchDefaultIO [] (dirContents dir)
|
||||
go (subdirs++[dir]) dirs
|
||||
|
||||
{- Moves one filename to another.
|
||||
- First tries a rename, but falls back to moving across devices if needed. -}
|
||||
moveFile :: FilePath -> FilePath -> IO ()
|
||||
moveFile src dest = tryIO (rename src dest) >>= onrename
|
||||
where
|
||||
onrename (Right _) = noop
|
||||
onrename (Left e)
|
||||
| isPermissionError e = rethrow
|
||||
| isDoesNotExistError e = rethrow
|
||||
| otherwise = do
|
||||
-- copyFile is likely not as optimised as
|
||||
-- the mv command, so we'll use the latter.
|
||||
-- But, mv will move into a directory if
|
||||
-- dest is one, which is not desired.
|
||||
whenM (isdir dest) rethrow
|
||||
viaTmp mv dest undefined
|
||||
where
|
||||
rethrow = throw e
|
||||
mv tmp _ = do
|
||||
ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
|
||||
unless ok $ do
|
||||
-- delete any partial
|
||||
_ <- tryIO $ removeFile tmp
|
||||
rethrow
|
||||
|
||||
isdir f = do
|
||||
r <- tryIO $ getFileStatus f
|
||||
case r of
|
||||
(Left _) -> return False
|
||||
(Right s) -> return $ isDirectory s
|
||||
|
||||
{- Removes a file, which may or may not exist, and does not have to
|
||||
- be a regular file.
|
||||
-
|
||||
- Note that an exception is thrown if the file exists but
|
||||
- cannot be removed. -}
|
||||
nukeFile :: FilePath -> IO ()
|
||||
nukeFile file = void $ tryWhenExists go
|
||||
where
|
||||
#ifndef mingw32_HOST_OS
|
||||
go = removeLink file
|
||||
#else
|
||||
go = removeFile file
|
||||
#endif
|
|
@ -0,0 +1,81 @@
|
|||
{- portable environment variables
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Env where
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
import Utility.Exception
|
||||
import Control.Applicative
|
||||
import Data.Maybe
|
||||
import qualified System.Environment as E
|
||||
#else
|
||||
import qualified System.Posix.Env as PE
|
||||
#endif
|
||||
|
||||
getEnv :: String -> IO (Maybe String)
|
||||
#ifndef mingw32_HOST_OS
|
||||
getEnv = PE.getEnv
|
||||
#else
|
||||
getEnv = catchMaybeIO . E.getEnv
|
||||
#endif
|
||||
|
||||
getEnvDefault :: String -> String -> IO String
|
||||
#ifndef mingw32_HOST_OS
|
||||
getEnvDefault = PE.getEnvDefault
|
||||
#else
|
||||
getEnvDefault var fallback = fromMaybe fallback <$> getEnv var
|
||||
#endif
|
||||
|
||||
getEnvironment :: IO [(String, String)]
|
||||
#ifndef mingw32_HOST_OS
|
||||
getEnvironment = PE.getEnvironment
|
||||
#else
|
||||
getEnvironment = E.getEnvironment
|
||||
#endif
|
||||
|
||||
{- Returns True if it could successfully set the environment variable.
|
||||
-
|
||||
- There is, apparently, no way to do this in Windows. Instead,
|
||||
- environment varuables must be provided when running a new process. -}
|
||||
setEnv :: String -> String -> Bool -> IO Bool
|
||||
#ifndef mingw32_HOST_OS
|
||||
setEnv var val overwrite = do
|
||||
PE.setEnv var val overwrite
|
||||
return True
|
||||
#else
|
||||
setEnv _ _ _ = return False
|
||||
#endif
|
||||
|
||||
{- Returns True if it could successfully unset the environment variable. -}
|
||||
unsetEnv :: String -> IO Bool
|
||||
#ifndef mingw32_HOST_OS
|
||||
unsetEnv var = do
|
||||
PE.unsetEnv var
|
||||
return True
|
||||
#else
|
||||
unsetEnv _ = return False
|
||||
#endif
|
||||
|
||||
{- Adds the environment variable to the input environment. If already
|
||||
- present in the list, removes the old value.
|
||||
-
|
||||
- This does not really belong here, but Data.AssocList is for some reason
|
||||
- buried inside hxt.
|
||||
-}
|
||||
addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)]
|
||||
addEntry k v l = ( (k,v) : ) $! delEntry k l
|
||||
|
||||
addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
|
||||
addEntries = foldr (.) id . map (uncurry addEntry) . reverse
|
||||
|
||||
delEntry :: Eq k => k -> [(k, v)] -> [(k, v)]
|
||||
delEntry _ [] = []
|
||||
delEntry k (x@(k1,_) : rest)
|
||||
| k == k1 = rest
|
||||
| otherwise = ( x : ) $! delEntry k rest
|
|
@ -0,0 +1,59 @@
|
|||
{- Simple IO exception handling (and some more)
|
||||
-
|
||||
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Utility.Exception where
|
||||
|
||||
import Control.Exception
|
||||
import qualified Control.Exception as E
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Utility.Data
|
||||
|
||||
{- Catches IO errors and returns a Bool -}
|
||||
catchBoolIO :: IO Bool -> IO Bool
|
||||
catchBoolIO = catchDefaultIO False
|
||||
|
||||
{- Catches IO errors and returns a Maybe -}
|
||||
catchMaybeIO :: IO a -> IO (Maybe a)
|
||||
catchMaybeIO a = catchDefaultIO Nothing $ Just <$> a
|
||||
|
||||
{- Catches IO errors and returns a default value. -}
|
||||
catchDefaultIO :: a -> IO a -> IO a
|
||||
catchDefaultIO def a = catchIO a (const $ return def)
|
||||
|
||||
{- Catches IO errors and returns the error message. -}
|
||||
catchMsgIO :: IO a -> IO (Either String a)
|
||||
catchMsgIO a = either (Left . show) Right <$> tryIO a
|
||||
|
||||
{- catch specialized for IO errors only -}
|
||||
catchIO :: IO a -> (IOException -> IO a) -> IO a
|
||||
catchIO = E.catch
|
||||
|
||||
{- try specialized for IO errors only -}
|
||||
tryIO :: IO a -> IO (Either IOException a)
|
||||
tryIO = try
|
||||
|
||||
{- Catches all exceptions except for async exceptions.
|
||||
- This is often better to use than catching them all, so that
|
||||
- ThreadKilled and UserInterrupt get through.
|
||||
-}
|
||||
catchNonAsync :: IO a -> (SomeException -> IO a) -> IO a
|
||||
catchNonAsync a onerr = a `catches`
|
||||
[ Handler (\ (e :: AsyncException) -> throw e)
|
||||
, Handler (\ (e :: SomeException) -> onerr e)
|
||||
]
|
||||
|
||||
tryNonAsync :: IO a -> IO (Either SomeException a)
|
||||
tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)
|
||||
|
||||
{- Catches only DoesNotExist exceptions, and lets all others through. -}
|
||||
tryWhenExists :: IO a -> IO (Maybe a)
|
||||
tryWhenExists a = eitherToMaybe <$>
|
||||
tryJust (guard . isDoesNotExistError) a
|
|
@ -0,0 +1,158 @@
|
|||
{- File mode utilities.
|
||||
-
|
||||
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.FileMode where
|
||||
|
||||
import System.IO
|
||||
import Control.Monad
|
||||
import Control.Exception (bracket)
|
||||
import System.PosixCompat.Types
|
||||
import Utility.PosixFiles
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Posix.Files
|
||||
#endif
|
||||
import Foreign (complement)
|
||||
|
||||
import Utility.Exception
|
||||
|
||||
{- Applies a conversion function to a file's mode. -}
|
||||
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
|
||||
modifyFileMode f convert = void $ modifyFileMode' f convert
|
||||
modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
|
||||
modifyFileMode' f convert = do
|
||||
s <- getFileStatus f
|
||||
let old = fileMode s
|
||||
let new = convert old
|
||||
when (new /= old) $
|
||||
setFileMode f new
|
||||
return old
|
||||
|
||||
{- Adds the specified FileModes to the input mode, leaving the rest
|
||||
- unchanged. -}
|
||||
addModes :: [FileMode] -> FileMode -> FileMode
|
||||
addModes ms m = combineModes (m:ms)
|
||||
|
||||
{- Removes the specified FileModes from the input mode. -}
|
||||
removeModes :: [FileMode] -> FileMode -> FileMode
|
||||
removeModes ms m = m `intersectFileModes` complement (combineModes ms)
|
||||
|
||||
{- Runs an action after changing a file's mode, then restores the old mode. -}
|
||||
withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
|
||||
withModifiedFileMode file convert a = bracket setup cleanup go
|
||||
where
|
||||
setup = modifyFileMode' file convert
|
||||
cleanup oldmode = modifyFileMode file (const oldmode)
|
||||
go _ = a
|
||||
|
||||
writeModes :: [FileMode]
|
||||
writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
|
||||
|
||||
readModes :: [FileMode]
|
||||
readModes = [ownerReadMode, groupReadMode, otherReadMode]
|
||||
|
||||
executeModes :: [FileMode]
|
||||
executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
|
||||
|
||||
otherGroupModes :: [FileMode]
|
||||
otherGroupModes =
|
||||
[ groupReadMode, otherReadMode
|
||||
, groupWriteMode, otherWriteMode
|
||||
]
|
||||
|
||||
{- Removes the write bits from a file. -}
|
||||
preventWrite :: FilePath -> IO ()
|
||||
preventWrite f = modifyFileMode f $ removeModes writeModes
|
||||
|
||||
{- Turns a file's owner write bit back on. -}
|
||||
allowWrite :: FilePath -> IO ()
|
||||
allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]
|
||||
|
||||
{- Turns a file's owner read bit back on. -}
|
||||
allowRead :: FilePath -> IO ()
|
||||
allowRead f = modifyFileMode f $ addModes [ownerReadMode]
|
||||
|
||||
{- Allows owner and group to read and write to a file. -}
|
||||
groupSharedModes :: [FileMode]
|
||||
groupSharedModes =
|
||||
[ ownerWriteMode, groupWriteMode
|
||||
, ownerReadMode, groupReadMode
|
||||
]
|
||||
|
||||
groupWriteRead :: FilePath -> IO ()
|
||||
groupWriteRead f = modifyFileMode f $ addModes groupSharedModes
|
||||
|
||||
checkMode :: FileMode -> FileMode -> Bool
|
||||
checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
|
||||
|
||||
{- Checks if a file mode indicates it's a symlink. -}
|
||||
isSymLink :: FileMode -> Bool
|
||||
#ifdef mingw32_HOST_OS
|
||||
isSymLink _ = False
|
||||
#else
|
||||
isSymLink = checkMode symbolicLinkMode
|
||||
#endif
|
||||
|
||||
{- Checks if a file has any executable bits set. -}
|
||||
isExecutable :: FileMode -> Bool
|
||||
isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
|
||||
|
||||
{- Runs an action without that pesky umask influencing it, unless the
|
||||
- passed FileMode is the standard one. -}
|
||||
noUmask :: FileMode -> IO a -> IO a
|
||||
#ifndef mingw32_HOST_OS
|
||||
noUmask mode a
|
||||
| mode == stdFileMode = a
|
||||
| otherwise = withUmask nullFileMode a
|
||||
#else
|
||||
noUmask _ a = a
|
||||
#endif
|
||||
|
||||
withUmask :: FileMode -> IO a -> IO a
|
||||
#ifndef mingw32_HOST_OS
|
||||
withUmask umask a = bracket setup cleanup go
|
||||
where
|
||||
setup = setFileCreationMask umask
|
||||
cleanup = setFileCreationMask
|
||||
go _ = a
|
||||
#else
|
||||
withUmask _ a = a
|
||||
#endif
|
||||
|
||||
combineModes :: [FileMode] -> FileMode
|
||||
combineModes [] = undefined
|
||||
combineModes [m] = m
|
||||
combineModes (m:ms) = foldl unionFileModes m ms
|
||||
|
||||
isSticky :: FileMode -> Bool
|
||||
#ifdef mingw32_HOST_OS
|
||||
isSticky _ = False
|
||||
#else
|
||||
isSticky = checkMode stickyMode
|
||||
|
||||
stickyMode :: FileMode
|
||||
stickyMode = 512
|
||||
|
||||
setSticky :: FilePath -> IO ()
|
||||
setSticky f = modifyFileMode f $ addModes [stickyMode]
|
||||
#endif
|
||||
|
||||
{- Writes a file, ensuring that its modes do not allow it to be read
|
||||
- or written by anyone other than the current user,
|
||||
- before any content is written.
|
||||
-
|
||||
- When possible, this is done using the umask.
|
||||
-
|
||||
- On a filesystem that does not support file permissions, this is the same
|
||||
- as writeFile.
|
||||
-}
|
||||
writeFileProtected :: FilePath -> String -> IO ()
|
||||
writeFileProtected file content = withUmask 0o0077 $
|
||||
withFile file WriteMode $ \h -> do
|
||||
void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
|
||||
hPutStr h content
|
|
@ -0,0 +1,132 @@
|
|||
{- GHC File system encoding handling.
|
||||
-
|
||||
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.FileSystemEncoding (
|
||||
fileEncoding,
|
||||
withFilePath,
|
||||
md5FilePath,
|
||||
decodeBS,
|
||||
decodeW8,
|
||||
encodeW8,
|
||||
truncateFilePath,
|
||||
) where
|
||||
|
||||
import qualified GHC.Foreign as GHC
|
||||
import qualified GHC.IO.Encoding as Encoding
|
||||
import Foreign.C
|
||||
import System.IO
|
||||
import System.IO.Unsafe
|
||||
import qualified Data.Hash.MD5 as MD5
|
||||
import Data.Word
|
||||
import Data.Bits.Utils
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
#ifdef mingw32_HOST_OS
|
||||
import qualified Data.ByteString.Lazy.UTF8 as L8
|
||||
#endif
|
||||
|
||||
{- Sets a Handle to use the filesystem encoding. This causes data
|
||||
- written or read from it to be encoded/decoded the same
|
||||
- as ghc 7.4 does to filenames etc. This special encoding
|
||||
- allows "arbitrary undecodable bytes to be round-tripped through it".
|
||||
-}
|
||||
fileEncoding :: Handle -> IO ()
|
||||
#ifndef mingw32_HOST_OS
|
||||
fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
|
||||
#else
|
||||
{- The file system encoding does not work well on Windows,
|
||||
- and Windows only has utf FilePaths anyway. -}
|
||||
fileEncoding h = hSetEncoding h Encoding.utf8
|
||||
#endif
|
||||
|
||||
{- Marshal a Haskell FilePath into a NUL terminated C string using temporary
|
||||
- storage. The FilePath is encoded using the filesystem encoding,
|
||||
- reversing the decoding that should have been done when the FilePath
|
||||
- was obtained. -}
|
||||
withFilePath :: FilePath -> (CString -> IO a) -> IO a
|
||||
withFilePath fp f = Encoding.getFileSystemEncoding
|
||||
>>= \enc -> GHC.withCString enc fp f
|
||||
|
||||
{- Encodes a FilePath into a String, applying the filesystem encoding.
|
||||
-
|
||||
- There are very few things it makes sense to do with such an encoded
|
||||
- string. It's not a legal filename; it should not be displayed.
|
||||
- So this function is not exported, but instead used by the few functions
|
||||
- that can usefully consume it.
|
||||
-
|
||||
- This use of unsafePerformIO is belived to be safe; GHC's interface
|
||||
- only allows doing this conversion with CStrings, and the CString buffer
|
||||
- is allocated, used, and deallocated within the call, with no side
|
||||
- effects.
|
||||
-}
|
||||
{-# NOINLINE _encodeFilePath #-}
|
||||
_encodeFilePath :: FilePath -> String
|
||||
_encodeFilePath fp = unsafePerformIO $ do
|
||||
enc <- Encoding.getFileSystemEncoding
|
||||
GHC.withCString enc fp $ GHC.peekCString Encoding.char8
|
||||
|
||||
{- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -}
|
||||
md5FilePath :: FilePath -> MD5.Str
|
||||
md5FilePath = MD5.Str . _encodeFilePath
|
||||
|
||||
{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
|
||||
decodeBS :: L.ByteString -> FilePath
|
||||
#ifndef mingw32_HOST_OS
|
||||
decodeBS = encodeW8 . L.unpack
|
||||
#else
|
||||
{- On Windows, we assume that the ByteString is utf-8, since Windows
|
||||
- only uses unicode for filenames. -}
|
||||
decodeBS = L8.toString
|
||||
#endif
|
||||
|
||||
{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
|
||||
-
|
||||
- w82c produces a String, which may contain Chars that are invalid
|
||||
- unicode. From there, this is really a simple matter of applying the
|
||||
- file system encoding, only complicated by GHC's interface to doing so.
|
||||
-}
|
||||
{-# NOINLINE encodeW8 #-}
|
||||
encodeW8 :: [Word8] -> FilePath
|
||||
encodeW8 w8 = unsafePerformIO $ do
|
||||
enc <- Encoding.getFileSystemEncoding
|
||||
GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc
|
||||
|
||||
{- Useful when you want the actual number of bytes that will be used to
|
||||
- represent the FilePath on disk. -}
|
||||
decodeW8 :: FilePath -> [Word8]
|
||||
decodeW8 = s2w8 . _encodeFilePath
|
||||
|
||||
{- Truncates a FilePath to the given number of bytes (or less),
|
||||
- as represented on disk.
|
||||
-
|
||||
- Avoids returning an invalid part of a unicode byte sequence, at the
|
||||
- cost of efficiency when running on a large FilePath.
|
||||
-}
|
||||
truncateFilePath :: Int -> FilePath -> FilePath
|
||||
#ifndef mingw32_HOST_OS
|
||||
truncateFilePath n = go . reverse
|
||||
where
|
||||
go f =
|
||||
let bytes = decodeW8 f
|
||||
in if length bytes <= n
|
||||
then reverse f
|
||||
else go (drop 1 f)
|
||||
#else
|
||||
{- On Windows, count the number of bytes used by each utf8 character. -}
|
||||
truncateFilePath n = reverse . go [] n . L8.fromString
|
||||
where
|
||||
go coll cnt bs
|
||||
| cnt <= 0 = coll
|
||||
| otherwise = case L8.decode bs of
|
||||
Just (c, x) | c /= L8.replacement_char ->
|
||||
let x' = fromIntegral x
|
||||
in if cnt - x' < 0
|
||||
then coll
|
||||
else go (c:coll) (cnt - x') (L8.drop 1 bs)
|
||||
_ -> coll
|
||||
#endif
|
|
@ -0,0 +1,61 @@
|
|||
{- Linux library copier and binary shimmer
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
module Utility.LinuxMkLibs where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Maybe
|
||||
import System.Directory
|
||||
import Data.List.Utils
|
||||
import System.Posix.Files
|
||||
import Data.Char
|
||||
import Control.Monad.IfElse
|
||||
|
||||
import Utility.PartialPrelude
|
||||
import Utility.Directory
|
||||
import Utility.Process
|
||||
import Utility.Monad
|
||||
import Utility.Path
|
||||
|
||||
{- Installs a library. If the library is a symlink to another file,
|
||||
- install the file it links to, and update the symlink to be relative. -}
|
||||
installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)
|
||||
installLib installfile top lib = ifM (doesFileExist lib)
|
||||
( do
|
||||
installfile top lib
|
||||
checksymlink lib
|
||||
return $ Just $ parentDir lib
|
||||
, return Nothing
|
||||
)
|
||||
where
|
||||
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
|
||||
l <- readSymbolicLink (inTop top f)
|
||||
let absl = absPathFrom (parentDir f) l
|
||||
let target = relPathDirToFile (parentDir f) absl
|
||||
installfile top absl
|
||||
nukeFile (top ++ f)
|
||||
createSymbolicLink target (inTop top f)
|
||||
checksymlink absl
|
||||
|
||||
-- Note that f is not relative, so cannot use </>
|
||||
inTop :: FilePath -> FilePath -> FilePath
|
||||
inTop top f = top ++ f
|
||||
|
||||
{- Parse ldd output, getting all the libraries that the input files
|
||||
- link to. Note that some of the libraries may not exist
|
||||
- (eg, linux-vdso.so) -}
|
||||
parseLdd :: String -> [FilePath]
|
||||
parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines
|
||||
where
|
||||
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
|
||||
|
||||
{- Get all glibc libs and other support files, including gconv files
|
||||
-
|
||||
- XXX Debian specific. -}
|
||||
glibcLibs :: IO [FilePath]
|
||||
glibcLibs = lines <$> readProcess "sh"
|
||||
["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue