propellor 0.8.0 → 0.8.1

raw patch · 10 files changed

+136/−58 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• .gitignore +0/−9
• CHANGELOG +10/−0
• config-joey.hs +35/−33
• debian/changelog +10/−0
• propellor.cabal +4/−3
• src/Propellor/CmdLine.hs +6/−4
• src/Propellor/PrivData.hs +12/−8
• src/Propellor/Property/Grub.hs +39/−0
• src/Propellor/Property/HostingProvider/Linode.hs +10/−0
• src/Propellor/Property/Ssh.hs +10/−1

@@ -1,9 +0,0 @@-dist/*-propellor-tags-privdata/local-privdata/keyring.gpg~-Setup-Setup.hi-Setup.o-docker

@@ -1,3 +1,13 @@+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,

@@ -21,8 +21,10 @@ 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@@ -34,7 +36,6 @@      Deployed -}          --  `/-==__ _/__|/__=-|          (       \_ hosts :: [Host]          --   *             \ | |           '--------' hosts =                 --                  (o)  `-	-- My laptop 	[ host "darkstar.kitenet.net" 		& ipv6 "2001:4830:1600:187::2" -- sixxs tunnel @@ -42,8 +43,8 @@ 		& Docker.configured 		& Docker.docked hosts "android-git-annex" -	-- Unreliable server. 	, standardSystem "clam.kitenet.net" Unstable "amd64"+		[ "Unreliable server. Anything here may be lost at any time!" ] 		& ipv4 "162.248.9.29"  		& CloudAtCost.decruft@@ -57,6 +58,7 @@ 	 	-- 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@@ -71,16 +73,27 @@ 		& Docker.garbageCollected `period` Daily 		& Apt.buildDep ["git-annex"] `period` Daily 	-	-- Important stuff that needs not too much memory or CPU.-  	, let ctx = Context "diatom.kitenet.net"-	  in standardSystem "diatom.kitenet.net" Stable "amd64"+  	, 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.hostKey SshDsa ctx-		& Ssh.hostKey SshRsa ctx-		& Ssh.hostKey SshEcdsa ctx+		& Ssh.hostKeys (Context "diatom.kitenet.net") 		& Apt.unattendedUpgrades 		& Apt.serviceInstalledRunning "ntp" 		& Postfix.satellite@@ -133,36 +146,18 @@ 		 		& Dns.secondaryFor ["animx"] hosts "animx.eu.org" -	-- storage and backup server 	, 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.hostKey SshDsa ctx-		& Ssh.hostKey SshRsa ctx-		& Ssh.hostKey SshEcdsa ctx+		& Ssh.hostKeys ctx 		& Ssh.keyImported SshRsa "joey" ctx--		-- PV-grub chaining-		-- http://notes.pault.ag/linode-pv-grub-chainning/-		-- (Adapted to use xvda1/hd0,0 instead of xvda/hd0)-		& "/boot/grub/menu.lst" `File.hasContent`-			[ "default 1" -			, "timeout 30"-			, ""-			, "title grub-xen shim"-			, "root (hd0,0)"-			, "kernel /boot/xen-shim"-			, "boot"-			]-		& "/boot/load.cf" `File.hasContent`-			[ "configfile (xen/xvda1)/boot/grub/grub.cfg" ]-		& Apt.installed ["grub-xen"]-		& flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(xen/xvda1)/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"+		& Apt.serviceInstalledRunning "swapspace"  		& alias "eubackup.kitenet.net" 		& Apt.installed ["obnam", "sshfs", "rsync"]@@ -204,6 +199,11 @@ 		-- 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|      ,.@@ -257,10 +257,13 @@ 	-- temp for an acquantance 	] ++ monsters +type Motd = [String]+ -- This is my standard system setup.-standardSystem :: HostName -> DebianSuite -> Architecture -> Host-standardSystem hn suite arch = host hn+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"]@@ -352,7 +355,6 @@ 		& ipv4 "80.68.85.49" 		& ipv6 "2001:41c8:125:49::10" 		& alias "kitenet.net"-		& alias "kite.kitenet.net" 		& alias "ns1.kitenet.net" 		& alias "ftp.kitenet.net" 		& alias "mail.kitenet.net"

@@ -1,3 +1,13 @@+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,

@@ -1,5 +1,5 @@ Name: propellor-Version: 0.8.0+Version: 0.8.1 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess <joey@kitenet.net>@@ -25,7 +25,6 @@   debian/copyright   debian/rules   debian/lintian-overrides-  .gitignore Synopsis: property-based host configuration management in haskell Description:  Propellor enures that the system it's run in satisfies a list of@@ -81,6 +80,7 @@     Propellor.Property.File     Propellor.Property.Git     Propellor.Property.Gpg+    Propellor.Property.Grub     Propellor.Property.Network     Propellor.Property.Obnam     Propellor.Property.OpenId@@ -92,8 +92,9 @@     Propellor.Property.Sudo     Propellor.Property.Tor     Propellor.Property.User-    Propellor.Property.HostingProvider.DigitalOcean     Propellor.Property.HostingProvider.CloudAtCost+    Propellor.Property.HostingProvider.DigitalOcean+    Propellor.Property.HostingProvider.Linode     Propellor.Property.SiteSpecific.GitHome     Propellor.Property.SiteSpecific.JoeySites     Propellor.Property.SiteSpecific.GitAnnexBuilder

@@ -92,7 +92,7 @@ 	go False (Boot hn) = onlyProcess $ withhost hn boot  	withhost :: HostName -> (Host -> IO ()) -> IO ()-	withhost hn a = maybe (unknownhost hn) a (findHost hostlist hn)+	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)  onlyProcess :: IO a -> IO a onlyProcess a = bracket lock unlock (const a)@@ -106,11 +106,12 @@ 	alreadyrunning = error "Propellor is already running on this host!" 	lockfile = localdir </> ".lock" -unknownhost :: HostName -> IO a-unknownhost h = errorMessage $ unlines+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 ()@@ -209,7 +210,8 @@ 	bootstrapcmd = shellWrap $ intercalate " ; " 		[ "if [ ! -d " ++ localdir ++ " ]" 		, "then " ++ intercalate " && "-			[ "apt-get --no-install-recommends --no-upgrade -y install git make"+			[ "apt-get update"+			, "apt-get --no-install-recommends --no-upgrade -y install git make" 			, "echo " ++ toMarked statusMarker (show NeedGitClone) 			] 		, "else " ++ intercalate " && "

@@ -30,8 +30,6 @@ import Utility.Env import Utility.Table -type PrivMap = M.Map (PrivDataField, Context) PrivData- -- | Allows a Property to access the value of a specific PrivDataField, -- for use in a specific Context. --@@ -75,6 +73,8 @@   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)@@ -109,20 +109,24 @@ listPrivDataFields :: [Host] -> IO () listPrivDataFields hosts = do 	m <- decryptPrivData-	putStrLn "\n"-	let usedby = M.unionsWith (++) $ map mkhostmap hosts-	let rows = map (mkrow usedby) (M.keys m)-	let table = tableWithHeader header rows-	putStr $ unlines $ formatTable table+	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 usedby k@(field, (Context context)) =+	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

@@ -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,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"

@@ -5,6 +5,7 @@ 	hasAuthorizedKeys, 	restartSshd, 	randomHostKeys,+	hostKeys, 	hostKey, 	keyImported, 	knownHost,@@ -75,7 +76,15 @@ 		ensureProperty $ scriptProperty  			[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] --- | Sets ssh host keys.+-- | 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")