propellor 4.0.6 → 4.1.0

raw patch · 19 files changed

+275/−83 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +29/−0
• debian/changelog +29/−0
• joeyconfig.hs +32/−13
• propellor.cabal +2/−1
• src/Propellor/Bootstrap.hs +2/−0
• src/Propellor/Engine.hs +56/−0
• src/Propellor/Message.hs +0/−23
• src/Propellor/Property.hs +1/−0
• src/Propellor/Property/Apache.hs +4/−4
• src/Propellor/Property/Bootstrap.hs +8/−7
• src/Propellor/Property/Chroot.hs +7/−11
• src/Propellor/Property/DiskImage.hs +12/−2
• src/Propellor/Property/Docker.hs +4/−6
• src/Propellor/Property/File.hs +38/−12
• src/Propellor/Property/HostingProvider/Linode.hs +1/−0
• src/Propellor/Property/LightDM.hs +2/−1
• src/Propellor/Property/SiteSpecific/JoeySites.hs +1/−1
• src/Propellor/Property/User.hs +6/−2
• src/Propellor/Property/XFCE.hs +41/−0

@@ -1,3 +1,32 @@+propellor (4.1.0) unstable; urgency=medium++  * User.hasInsecurePassword makes sure shadow passwords are enabled,+    so if the insecure password is later changed, the new password won't be+    exposed.+  * Bugfix: Apache.httpsVirtualHost' must create ssl/hn/ dir earlier+    Thanks, Sean Whitton.+  * Bootstrap.clonedFrom: Fix bug that broke copying .git/config into+    chroot.+  * Diskimage.imageExists: Align disk image size to multiple of 4096+    sector size, since some programs (such as VBoxManage convertdd)+    refuse to operate on disk images not aligned to a sector size.+  * Bootstrap.bootstrappedFrom: Fix bug that caused propellor to only+    be built from the bootstrapped config the first time.+  * Bootstrap.bootstrappedFrom: Avoid doing anything when not run in a+    chroot.+  * When provisioning a container, output was buffered until the whole+    process was done; now output will be displayed immediately.+  * LightDM.autoLogin: Make it require LightDM.installed.+    (minor API change as the type changed)+  * Propellor.Property.XFCE added with some useful properties for the+    desktop environment.+  * Added File.applyPath property.+  * Added File.checkOverwrite.+  * File.isCopyOf: Fix bug that prevented this property from working+    when the destination file did not yet exist.++ -- Joey Hess <id@joeyh.name>  Wed, 05 Jul 2017 17:30:00 -0400+ propellor (4.0.6) unstable; urgency=medium    * Fix bug that sometimes made --spin fail with 

@@ -1,3 +1,32 @@+propellor (4.1.0) unstable; urgency=medium++  * User.hasInsecurePassword makes sure shadow passwords are enabled,+    so if the insecure password is later changed, the new password won't be+    exposed.+  * Bugfix: Apache.httpsVirtualHost' must create ssl/hn/ dir earlier+    Thanks, Sean Whitton.+  * Bootstrap.clonedFrom: Fix bug that broke copying .git/config into+    chroot.+  * Diskimage.imageExists: Align disk image size to multiple of 4096+    sector size, since some programs (such as VBoxManage convertdd)+    refuse to operate on disk images not aligned to a sector size.+  * Bootstrap.bootstrappedFrom: Fix bug that caused propellor to only+    be built from the bootstrapped config the first time.+  * Bootstrap.bootstrappedFrom: Avoid doing anything when not run in a+    chroot.+  * When provisioning a container, output was buffered until the whole+    process was done; now output will be displayed immediately.+  * LightDM.autoLogin: Make it require LightDM.installed.+    (minor API change as the type changed)+  * Propellor.Property.XFCE added with some useful properties for the+    desktop environment.+  * Added File.applyPath property.+  * Added File.checkOverwrite.+  * File.isCopyOf: Fix bug that prevented this property from working+    when the destination file did not yet exist.++ -- Joey Hess <id@joeyh.name>  Wed, 05 Jul 2017 17:30:00 -0400+ propellor (4.0.6) unstable; urgency=medium    * Fix bug that sometimes made --spin fail with 

@@ -21,6 +21,8 @@ import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.LetsEncrypt as LetsEncrypt+import qualified Propellor.Property.LightDM as LightDM+import qualified Propellor.Property.XFCE as XFCE import qualified Propellor.Property.Grub as Grub import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Gpg as Gpg@@ -47,6 +49,7 @@ hosts :: [Host]          --   *             \ | |           '--------' hosts =                 --                  (o)  ` 	[ darkstar+	, demo 	, gnu 	, dragon 	, clam@@ -88,26 +91,40 @@  	& JoeySites.dkimMilter 	& JoeySites.postfixSaslPasswordClient-	& JoeySites.alarmClock "*-*-* 7:30" (User "joey")-		"/usr/bin/timeout 45m /home/joey/bin/goodmorning"+	-- & JoeySites.alarmClock "*-*-* 7:30" (User "joey")+	--	"/usr/bin/timeout 45m /home/joey/bin/goodmorning" 	& Ssh.userKeys (User "joey") hostContext 		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC1YoyHxZwG5Eg0yiMTJLSWJ/+dMM6zZkZiR4JJ0iUfP+tT2bm/lxYompbSqBeiCq+PYcSC67mALxp1vfmdOV//LWlbXfotpxtyxbdTcQbHhdz4num9rJQz1tjsOsxTEheX5jKirFNC5OiKhqwIuNydKWDS9qHGqsKcZQ8p+n1g9Lr3nJVGY7eRRXzw/HopTpwmGmAmb9IXY6DC2k91KReRZAlOrk0287LaK3eCe1z0bu7LYzqqS+w99iXZ/Qs0m9OqAPnHZjWQQ0fN4xn5JQpZSJ7sqO38TBAimM+IHPmy2FTNVVn9zGM+vN1O2xr3l796QmaUG1+XLL0shfR/OZbb joey@darkstar") 		] -	& imageBuilt "/srv/propellor-disk.img" c MSDOS (grubBooted PC)+	& imageBuilt "/srv/propellor-disk.img"+		(Chroot.hostChroot demo (Chroot.Debootstrapped mempty))+		MSDOS (grubBooted PC) 		[ partition EXT2 `mountedAt` "/boot" 			`setFlag` BootFlag 		, partition EXT4 `mountedAt` "/" 			`mountOpt` errorReadonly+			`addFreeSpace` MegaBytes 256 		, swapPartition (MegaBytes 256) 		]+		`before` File.ownerGroup "/srv/propellor-disk.img" (User "joey") (Group "joey")++demo :: Host+demo = host "demo" $ props+	& osDebian Unstable X86_64+	& Apt.installed ["linux-image-amd64"]+	& bootstrappedFrom GitRepoOutsideChroot+	& User.accountFor user+	& root `User.hasInsecurePassword` "debian"+	& user `User.hasInsecurePassword` "debian"+	& XFCE.installedMin+	& XFCE.networkManager+	& XFCE.defaultPanelFor user File.OverwriteExisting+	& LightDM.autoLogin user+	& Apt.installed ["firefox"]   where-	c d = Chroot.debootstrapped mempty d $ props-		& osDebian Unstable X86_64-		& Hostname.setTo "demo"-		& Apt.installed ["linux-image-amd64"]-		& User "root" `User.hasInsecurePassword` "root"-		& bootstrappedFrom GitRepoOutsideChroot+	user = User "user"+	root = User "root"  gnu :: Host gnu = host "gnu.kitenet.net" $ props@@ -323,6 +340,7 @@ 	& alias "ns4.kitenet.net" 	& myDnsPrimary True "kitenet.net" 		[ (RelDomain "mouse-onion", CNAME $ AbsDomain "htieo6yu2qtcn2j3.onion")+		, (RelDomain "beaver-onion", CNAME $ AbsDomain "tl4xsvaxryjylgxs.onion") 		] 	& myDnsPrimary True "joeyh.name" [] 	& myDnsPrimary True "ikiwiki.info" []@@ -412,9 +430,10 @@ beaver :: Host beaver = host "beaver.kitenet.net" $ props 	& ipv6 "2001:4830:1600:195::2"-	& Apt.serviceInstalledRunning "aiccu" 	& Apt.installed ["ssh"] 	& Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw=="+	& Tor.installed+	& Tor.hiddenServiceAvailable "ssh" (Port 22) 	& alias "usbackup.kitenet.net" 	& JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup" 	& Apt.serviceInstalledRunning "anacron"@@ -521,7 +540,7 @@ -- and administrative sanity. openidProvider :: Systemd.Container openidProvider = Systemd.debContainer "openid-provider" $ props-	& standardContainer (Stable "jessie")+	& standardContainer (Stable "stretch") 	& alias hn 	& OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))   where@@ -530,7 +549,7 @@ -- Exhibit: kite's 90's website on port 1994. ancientKitenet :: Systemd.Container ancientKitenet = Systemd.debContainer "ancient-kitenet" $ props-	& standardContainer (Stable "jessie")+	& standardContainer (Stable "stretch") 	& alias hn 	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html" 		(Just "remotes/origin/old-kitenet.net")@@ -544,7 +563,7 @@  oldusenetShellBox :: Systemd.Container oldusenetShellBox = Systemd.debContainer "oldusenet-shellbox" $ props-	& standardContainer (Stable "jessie")+	& standardContainer (Stable "stretch") 	& alias "shell.olduse.net" 	& JoeySites.oldUseNetShellBox 

@@ -1,5 +1,5 @@ Name: propellor-Version: 4.0.6+Version: 4.1.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -153,6 +153,7 @@     Propellor.Property.Unbound     Propellor.Property.User     Propellor.Property.Uwsgi+    Propellor.Property.XFCE     Propellor.Property.ZFS     Propellor.Property.ZFS.Process     Propellor.Property.ZFS.Properties

@@ -3,6 +3,8 @@ 	checkBinaryCommand, 	installGitCommand, 	buildPropellor,+	checkDepsCommand,+	buildCommand, ) where  import Propellor.Base

@@ -8,6 +8,8 @@ 	fromHost, 	fromHost', 	onlyProcess,+	chainPropellor,+	runChainPropellor, ) where  import System.Exit@@ -17,7 +19,9 @@ import System.PosixCompat import System.Posix.IO import System.FilePath+import System.Console.Concurrent import Control.Applicative+import Control.Concurrent.Async import Prelude  import Propellor.Types@@ -28,6 +32,8 @@ import Propellor.Info import Utility.Exception import Utility.Directory+import Utility.Process+import Utility.PartialPrelude  -- | Gets the Properties of a Host, and ensures them all, -- with nice display of what's being done.@@ -96,3 +102,53 @@ 		return l 	unlock = closeFd 	alreadyrunning = error "Propellor is already running on this host!"++-- | Chains to a propellor sub-Process, forwarding its output on to the+-- display, except for the last line which is a Result.+chainPropellor :: CreateProcess -> IO Result+chainPropellor p = +	-- We want to use outputConcurrent to display output+	-- as it's received. If only stdout were captured,+	-- concurrent-output would buffer all outputConcurrent.+	-- Also capturing stderr avoids that problem.+	withOEHandles createProcessSuccess p $ \(outh, errh) -> do+		(r, ()) <- processChainOutput outh+			`concurrently` forwardChainError errh+		return r++-- | Reads and displays each line from the Handle, except for the last line+-- which is a Result.+processChainOutput :: Handle -> IO Result+processChainOutput h = go Nothing+  where+	go lastline = do+		v <- catchMaybeIO (hGetLine h)+		case v of+			Nothing -> case lastline of+				Nothing -> do+					return FailedChange+				Just l -> case readish l of+					Just r -> pure r+					Nothing -> do+						outputConcurrent (l ++ "\n")+						return FailedChange+			Just s -> do+				outputConcurrent $+					maybe "" (\l -> if null l then "" else l ++ "\n") lastline+				go (Just s)++forwardChainError :: Handle -> IO ()+forwardChainError h = do+	v <- catchMaybeIO (hGetLine h)+	case v of+		Nothing -> return ()+		Just s -> do+			errorConcurrent (s ++ "\n")+			forwardChainError h++-- | Used by propellor sub-Processes that are run by chainPropellor.+runChainPropellor :: Host -> Propellor Result -> IO ()+runChainPropellor h a = do+	r <- runPropellor h a+	flushConcurrentOutput+	putStrLn $ "\n" ++ show r

@@ -14,7 +14,6 @@ 	infoMessage, 	errorMessage, 	stopPropellorMessage,-	processChainOutput, 	messagesDone, 	createProcessConcurrent, 	withConcurrentOutput,@@ -31,7 +30,6 @@  import Propellor.Types import Propellor.Types.Exception-import Utility.PartialPrelude import Utility.Monad import Utility.Exception @@ -141,27 +139,6 @@ 	-- the color set and reset happen in the same line. 	, pure "\n" 	]---- | Reads and displays each line from the Handle, except for the last line--- which is a Result.-processChainOutput :: Handle -> IO Result-processChainOutput h = go Nothing-  where-	go lastline = do-		v <- catchMaybeIO (hGetLine h)-		case v of-			Nothing -> case lastline of-				Nothing -> do-					return FailedChange-				Just l -> case readish l of-					Just r -> pure r-					Nothing -> do-						outputConcurrent (l ++ "\n")-						return FailedChange-			Just s -> do-				outputConcurrent $-					maybe "" (\l -> if null l then "" else l ++ "\n") lastline-				go (Just s)  -- | Called when all messages about properties have been printed. messagesDone :: IO ()

@@ -50,6 +50,7 @@ import Control.Monad.IfElse import "mtl" Control.Monad.RWS.Strict import System.Posix.Files+import Data.Maybe import Data.List import Data.Hashable import Control.Applicative

@@ -189,7 +189,7 @@ 		`requires` modEnabled "ssl" 		`before` setuphttps 	teardown = siteDisabled domain-	setuphttp = siteEnabled' domain $+	setuphttp = (siteEnabled' domain $ 		-- The sslconffile is only created after letsencrypt gets 		-- the cert. The "*" is needed to make apache not error 		-- when the file doesn't exist.@@ -201,23 +201,23 @@ 			, "RewriteRule ^/.well-known/(.*) - [L]" 			-- Everything else redirects to https 			, "RewriteRule ^/(.*) https://" ++ domain ++ "/$1 [L,R,NE]"-			]+			])+		`requires` File.dirExists (takeDirectory cf) 	setuphttps = LetsEncrypt.letsEncrypt letos domain docroot 		`onChange` postsetuphttps 	postsetuphttps = combineProperties (domain ++ " ssl cert installed") $ props-		& File.dirExists (takeDirectory cf) 		& File.hasContent cf sslvhost 			`onChange` reloaded 		-- always reload since the cert has changed 		& reloaded 	  where-		cf = sslconffile "letsencrypt" 		sslvhost = vhost (Port 443) 			[ "SSLEngine on" 			, "SSLCertificateFile " ++ LetsEncrypt.certFile domain 			, "SSLCertificateKeyFile " ++ LetsEncrypt.privKeyFile domain 			, "SSLCertificateChainFile " ++ LetsEncrypt.chainFile domain 			]+	cf = sslconffile "letsencrypt" 	sslconffile s = "/etc/apache2/sites-available/ssl/" ++ domain ++ "/" ++ s ++ ".conf" 	vhost p ls = 		[ "<VirtualHost *:" ++ val p ++">"

@@ -17,17 +17,17 @@ -- | Bootstraps a propellor installation into -- /usr/local/propellor/ ----- Normally, propellor is already bootstrapped when it runs, so this--- property is not useful. However, this can be useful inside a--- chroot used to build a disk image, to make the disk image--- have propellor installed.+-- This property only does anything when used inside a chroot.+-- This is particularly useful inside a chroot used to build a+-- disk image, to make the disk image have propellor installed. -- -- The git repository is cloned (or pulled to update if it already exists). -- -- All build dependencies are installed, using distribution packages -- or falling back to using cabal. bootstrappedFrom :: RepoSource -> Property Linux-bootstrappedFrom reposource = go `requires` clonedFrom reposource+bootstrappedFrom reposource = check inChroot $+	go `requires` clonedFrom reposource   where 	go :: Property Linux 	go = property "Propellor bootstrapped" $ do@@ -35,7 +35,8 @@ 		assumeChange $ exposeTrueLocaldir $ const $  			runShellCommand $ buildShellCommand 				[ "cd " ++ localdir-				, bootstrapPropellorCommand system+				, checkDepsCommand system+				, buildCommand 				]  -- | Clones the propellor repeository into /usr/local/propellor/@@ -83,7 +84,7 @@ 	-- configuration. 	copygitconfig :: Property Linux 	copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do-		let gitconfig = localdir <> ".git" <> "config"+		let gitconfig = localdir </> ".git" </> "config" 		cfg <- liftIO $ B.readFile gitconfig 		exposeTrueLocaldir $ const $ 			liftIO $ B.writeFile gitconfig cfg

@@ -37,7 +37,6 @@  import qualified Data.Map as M import System.Posix.Directory-import System.Console.Concurrent  -- | Specification of a chroot. Normally you'll use `debootstrapped` or -- `bootstrapped` to construct a Chroot value.@@ -201,9 +200,7 @@ 			, "--continue" 			, show cmd 			]-		let p' = p { env = Just pe }-		r <- liftIO $ withHandle StdoutHandle createProcessSuccess p'-			processChainOutput+		r <- liftIO $ chainPropellor (p { env = Just pe }) 		liftIO cleanup 		return r @@ -223,13 +220,12 @@ 	go h = do 		changeWorkingDirectory localdir 		when onconsole forceConsole-		onlyProcess (provisioningLock loc) $ do-			r <- runPropellor (setInChroot h) $ ensureChildProperties $-				if systemdonly-					then [toChildProperty Systemd.installed]-					else hostProperties h-			flushConcurrentOutput-			putStrLn $ "\n" ++ show r+		onlyProcess (provisioningLock loc) $+			runChainPropellor (setInChroot h) $+				ensureChildProperties $+					if systemdonly+						then [toChildProperty Systemd.installed]+						else hostProperties h chain _ _ = errorMessage "bad chain command"  inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ())

@@ -49,7 +49,11 @@ -- First the specified Chroot is set up, and its properties are satisfied. -- -- Then, the disk image is set up, and the chroot is copied into the--- appropriate partition(s) of it.+-- appropriate partition(s) of it. +--+-- The partitions default to being sized just large enough to fit the files+-- from the chroot. You can use `addFreeSpace` to make them a bit larger+-- than that, or `setSize` to use a fixed size. --  -- Note that the disk image file is reused if it already exists, -- to avoid expensive IO to generate a new one. And, it's updated in-place,@@ -247,7 +251,7 @@ -- -- If the file is too large, truncates it down to the specified size. imageExists :: FilePath -> ByteSize -> Property Linux-imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do+imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do 	ms <- catchMaybeIO $ getFileStatus img 	case ms of 		Just s@@ -258,6 +262,12 @@ 		_ -> do 			L.writeFile img (L.replicate (fromIntegral sz) 0) 			return MadeChange+  where+	sz = ceiling (fromInteger isz / sectorsize) * ceiling sectorsize+	-- Disks have a sector size, and making a disk image not+	-- aligned to a sector size will confuse some programs.+	-- Common sector sizes are 512 and 4096; use 4096 as it's larger.+	sectorsize = 4096 :: Double  -- | A pair of properties. The first property is satisfied within the -- chroot, and is typically used to download the boot loader.

@@ -576,8 +576,7 @@ 	let p = inContainerProcess cid 		(if isConsole msgh then ["-it"] else []) 		(shim : params)-	r <- withHandle StdoutHandle createProcessSuccess p $-		processChainOutput+	r <- chainPropellor p 	when (r /= FailedChange) $ 		setProvisionedFlag cid 	return r@@ -596,10 +595,9 @@   where 	go cid h = do 		changeWorkingDirectory localdir-		onlyProcess (provisioningLock cid) $ do-			r <- runPropellor h $ ensureChildProperties $ hostProperties h-			flushConcurrentOutput-			putStrLn $ "\n" ++ show r+		onlyProcess (provisioningLock cid) $+			runChainPropellor h $ +				ensureChildProperties $ hostProperties h  stopContainer :: ContainerId -> IO Bool stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}  module Propellor.Property.File where @@ -105,11 +105,11 @@  -- | Replaces the content of a file with the transformed content of another file basedOn :: FilePath -> (FilePath, [Line] -> [Line]) -> Property UnixLike-f `basedOn` (f', a) = property' desc $ \o -> do-	tmpl <- liftIO $ readFile f'+f `basedOn` (src, a) = property' desc $ \o -> do+	tmpl <- liftIO $ readFile src 	ensureProperty o $ fileProperty desc (\_ -> a $ lines $ tmpl) f   where-	desc = f ++ " is based on " ++ f'+	desc = f ++ " is based on " ++ src  -- | Removes a file. Does not remove symlinks or non-plain-files. notPresent :: FilePath -> Property UnixLike@@ -150,23 +150,26 @@  -- | Ensures that a file is a copy of another (regular) file. isCopyOf :: FilePath -> FilePath -> Property UnixLike-f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f')+f `isCopyOf` src = property desc $ go =<< (liftIO $ tryIO $ getFileStatus src)   where-	desc = f ++ " is copy of " ++ f'+	desc = f ++ " is copy of " ++ src 	go (Right stat) = if isRegularFile stat-		then gocmp =<< (liftIO $ cmp)-		else warningMessage (f' ++ " is not a regular file") >>+		then ifM (liftIO $ doesFileExist f)+			( gocmp =<< (liftIO $ cmp)+			, doit+			)+		else warningMessage (src ++ " is not a regular file") >> 			return FailedChange 	go (Left e) = warningMessage (show e) >> return FailedChange -	cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File f']+	cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File src] 	gocmp ExitSuccess = noChange 	gocmp (ExitFailure 1) = doit 	gocmp _ = warningMessage "cmp failed" >> return FailedChange -	doit = makeChange $ copy f' `viaStableTmp` f-	copy src dest = unlessM (runcp src dest) $ errorMessage "cp failed"-	runcp src dest = boolSystem "cp"+	doit = makeChange $ copy `viaStableTmp` f+	copy dest = unlessM (runcp dest) $ errorMessage "cp failed"+	runcp dest = boolSystem "cp" 		[Param "--preserve=all", Param "--", File src, File dest]  -- | Ensures that a file/dir has the specified owner and group.@@ -177,6 +180,20 @@ 		`changesFile` f 	og = owner ++ ":" ++ group +-- | Given a base directory, and a relative path under that+-- directory, applies a property to each component of the path in turn, +-- starting with the base directory.+--+-- For example, to make a file owned by a user, making sure their home+-- directory and the subdirectories to it are also owned by them:+--+-- > "/home/user/program/file" `hasContent` ["foo"]+-- > 	`before` applyPath "/home/user" ".config/program/file" +-- > 		(\f -> ownerGroup f (User "user") (Group "user"))+applyPath :: Monoid (Property metatypes) => FilePath -> FilePath -> (FilePath -> Property metatypes) -> Property metatypes+applyPath basedir relpath mkp = mconcat $ +	map mkp (scanl (</>) basedir (splitPath relpath))+ -- | Ensures that a file/dir has the specfied mode. mode :: FilePath -> FileMode -> Property UnixLike mode f v = p `changesFile` f@@ -290,3 +307,12 @@ 			Nothing -> '_' : ns ++ unescape cs' 			Just n -> chr n : unescape cs' 	unescape (c:cs) = c : unescape cs++data Overwrite = OverwriteExisting | PreserveExisting++-- | When passed PreserveExisting, only ensures the property when the file+-- does not exist.+checkOverwrite :: Overwrite -> FilePath -> (FilePath -> Property i) -> Property i+checkOverwrite OverwriteExisting f mkp = mkp f+checkOverwrite PreserveExisting f mkp = +	check (not <$> doesFileExist f) (mkp f)

@@ -17,6 +17,7 @@ 	] 	`onChange` Grub.mkConfig 	`requires` Grub.installed Grub.PC+	`describe` "GRUB configured for Linode serial console"  -- | Linode's pv-grub-x86_64 (only used for its older XEN instances) -- does not support booting recent Debian kernels compressed

@@ -10,7 +10,8 @@ installed = Apt.installed ["lightdm"]  -- | Configures LightDM to skip the login screen and autologin as a user.-autoLogin :: User -> Property UnixLike+autoLogin :: User -> Property DebianLike autoLogin (User u) = "/etc/lightdm/lightdm.conf" `ConfFile.containsIniSetting` 	("SeatDefaults", "autologin-user", u) 	`describe` "lightdm autologin"+	`requires` installed

@@ -248,7 +248,7 @@ 		] 		`describe` "cgit configured" 	-- I keep the website used for git.kitenet.net/git.joeyh.name checked into git..-	& Git.cloned (User "root") "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing+	& Git.cloned (User "joey") "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing 	-- Don't need global apache configuration for cgit. 	! Apache.confEnabled "cgit" 	& website "git.kitenet.net"

@@ -97,8 +97,12 @@ -- | Makes a user's password be the passed String. Highly insecure: -- The password is right there in your config file for anyone to see! hasInsecurePassword :: User -> String -> Property DebianLike-hasInsecurePassword u@(User n) p = property (n ++ " has insecure password") $-	chpasswd u p []+hasInsecurePassword u@(User n) p = go+	`requires` shadowConfig True+  where+	go :: Property DebianLike+	go = property (n ++ " has insecure password") $+		chpasswd u p []  chpasswd :: User -> String -> [String] -> Propellor Result chpasswd (User user) v ps = makeChange $ withHandle StdinHandle createProcessSuccess

@@ -0,0 +1,41 @@+module Propellor.Property.XFCE where++import Propellor.Base+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.File as File+import qualified Propellor.Property.User as User++installed :: Property DebianLike+installed = Apt.installed ["task-xfce-desktop"]+	`describe` "XFCE desktop installed"++-- | Minimal install of XFCE, with a terminal emulator and panel,+-- and X and network-manager, but not any of the extra apps.+installedMin :: Property DebianLike+installedMin = Apt.installedMin ["xfce4", "xfce4-terminal", "task-desktop"]+	`describe` "minimal XFCE desktop installed"++-- | Installs network-manager-gnome, which is the way to get+-- network-manager to manage networking in XFCE too.+networkManager :: Property DebianLike+networkManager = Apt.installedMin ["network-manager-gnome"]++-- | Normally at first login, XFCE asks what kind of panel the user wants.+-- This enables the default configuration noninteractively.+defaultPanelFor :: User -> File.Overwrite -> Property DebianLike+defaultPanelFor u@(User username) overwrite = property' desc $ \w -> do+	home <- liftIO $ User.homedir u+	ensureProperty w (go home)+  where+	desc = "default XFCE panel for " ++ username+	basecf = ".config" </> "xfce4" </> "xfconf"+		</> "xfce-perchannel-xml" </> "xfce4-panel.xml"+	-- This location is probably Debian-specific.+	defcf = "/etc/xdg/xfce4/panel/default.xml"+	go :: FilePath -> Property DebianLike+	go home = tightenTargets $ +		File.checkOverwrite overwrite (home </> basecf) $ \cf ->+			cf `File.isCopyOf` defcf+				`before` File.applyPath home basecf+					(\f -> File.ownerGroup f u (userGroup u))+				`requires` Apt.installed ["xfce4-panel"]