propellor 4.7.7 → 4.8.0

raw patch · 13 files changed

+458/−175 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +24/−0
• debian/changelog +24/−0
• joeyconfig.hs +34/−38
• propellor.cabal +2/−1
• src/Propellor/Engine.hs +1/−0
• src/Propellor/Property/Apt.hs +3/−1
• src/Propellor/Property/Attic.hs +1/−1
• src/Propellor/Property/Borg.hs +66/−24
• src/Propellor/Property/DiskImage.hs +67/−37
• src/Propellor/Property/Lvm.hs +171/−0
• src/Propellor/Property/Partition.hs +14/−0
• src/Propellor/Property/SiteSpecific/Branchable.hs +19/−11
• src/Propellor/Property/SiteSpecific/JoeySites.hs +32/−62

@@ -1,3 +1,27 @@+propellor (4.8.0) unstable; urgency=medium++  * DiskImage: Made a DiskImage type class, so that different disk image+    formats can be implemented. The properties in this module can generate+    any type that is a member of DiskImage. (API change)+    (To convert existing configs, convert the filename of the disk image+    to RawDiskImage filename.)+  * Removed DiskImage.vmdkBuiltFor property. (API change)+    Instead, use VirtualBoxPointer in the property that creates the disk+    image.+  * Apt.isInstalled: Fix handling of packages that are not known at all+    to apt.+  * Borg: Converted BorgRepo from a String alias to a data type.+    (API change)+  * Borg: Allow specifying ssh private key to use when accessing a borg+    repo by using the BorgRepoUsing constructor with UseSshKey.+  * Borg: Fix broken shell escaping in borg cron job.+  * Attic: Fix broken shell escaping in attic cron job.+  * Make lock file descriptors close-on-exec.+  * Lvm: New module for setting up LVM volumes.+    Thanks, Nicolas Schodet++ -- Joey Hess <id@joeyh.name>  Mon, 25 Sep 2017 14:37:52 -0400+ propellor (4.7.7) unstable; urgency=medium    * Locale: Display an error message when /etc/locale.gen does not contain

@@ -1,3 +1,27 @@+propellor (4.8.0) unstable; urgency=medium++  * DiskImage: Made a DiskImage type class, so that different disk image+    formats can be implemented. The properties in this module can generate+    any type that is a member of DiskImage. (API change)+    (To convert existing configs, convert the filename of the disk image+    to RawDiskImage filename.)+  * Removed DiskImage.vmdkBuiltFor property. (API change)+    Instead, use VirtualBoxPointer in the property that creates the disk+    image.+  * Apt.isInstalled: Fix handling of packages that are not known at all+    to apt.+  * Borg: Converted BorgRepo from a String alias to a data type.+    (API change)+  * Borg: Allow specifying ssh private key to use when accessing a borg+    repo by using the BorgRepoUsing constructor with UseSshKey.+  * Borg: Fix broken shell escaping in borg cron job.+  * Attic: Fix broken shell escaping in attic cron job.+  * Make lock file descriptors close-on-exec.+  * Lvm: New module for setting up LVM volumes.+    Thanks, Nicolas Schodet++ -- Joey Hess <id@joeyh.name>  Mon, 25 Sep 2017 14:37:52 -0400+ propellor (4.7.7) unstable; urgency=medium    * Locale: Display an error message when /etc/locale.gen does not contain

@@ -24,7 +24,7 @@ import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import qualified Propellor.Property.Grub as Grub-import qualified Propellor.Property.Obnam as Obnam+import qualified Propellor.Property.Borg as Borg import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd import qualified Propellor.Property.Journald as Journald@@ -94,12 +94,11 @@ 	& 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/test.img" mychroot MSDOS+	& imageBuilt (VirtualBoxPointer "/srv/test.vmdk") mychroot MSDOS 		[ partition EXT2 `mountedAt` "/boot" 		, partition EXT4 `mountedAt` "/" 		, swapPartition (MegaBytes 256) 		]-		`before` vmdkBuiltFor "/srv/test.img"   where 	mychroot d = debootstrapped mempty d $ props 		& osDebian Unstable X86_64@@ -131,6 +130,7 @@ 	& Apt.unattendedUpgrades 	& Systemd.persistentJournal 	& Journald.systemMaxUse "50MiB"+	& Apt.serviceInstalledRunning "swapspace"  	& Tor.isRelay 	& Tor.named "kite1"@@ -230,7 +230,7 @@ kite = host "kite.kitenet.net" $ props 	& standardSystemUnhardened Testing X86_64 [ "Welcome to kite!" ] 	& ipv4 "66.228.36.95"-	-- & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"+	& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2" 	& alias "kitenet.net" 	& alias "wren.kitenet.net" -- temporary 	& Ssh.hostKeys (Context "kitenet.net")@@ -254,30 +254,28 @@ 	& Ssh.setSshdConfig "GatewayPorts" "clientspecified" 	& Apt.serviceInstalledRunning "ntp" 	& "/etc/timezone" `File.hasContent` ["US/Eastern"]--	& Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam"-		, "--client-name=kitenet.net"-		, "--exclude=/home"-		, "--exclude=/var/cache"-		, "--exclude=/var/tmp"+	+	& Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/kite/kite.borg") Cron.Daily+		[ "--exclude=/proc/*"+		, "--exclude=/sys/*"+		, "--exclude=/run/*"+		, "--exclude=/tmp/*"+		, "--exclude=/var/tmp/*"+		, "--exclude=/var/cache/*"+		, "--exclude=/home/joey/lib"+		-- These directories are backed up and restored separately. 		, "--exclude=/srv/git" 		, "--exclude=/var/spool/oldusenet"-		, "--exclude=.*/tmp/"-		, "--one-file-system"-		, Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]-		] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")-		`requires` rootsshkey-		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")-	& Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam"-		, "--client-name=kitenet.net"-		, "--exclude=/home/joey/lib"-		, "--one-file-system"-		, Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]-		] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")-		`requires` rootsshkey-		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")+		]+		[ Borg.KeepDays 7+		, Borg.KeepWeeks 4+		, Borg.KeepMonths 6+		]+		`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")+		`requires` Ssh.userKeys (User "root")+			(Context "kite.kitenet.net")+			[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")+			]  	& alias "smtp.kitenet.net" 	& alias "imap.kitenet.net"@@ -334,7 +332,13 @@ 	& alias "ns4.branchable.com" 	& branchableSecondary 	& Dns.secondaryFor ["animx"] hosts "animx.eu.org"-+	-- Use its own name server (amoung other things this avoids+	-- spamassassin URIBL_BLOCKED.+	& "/etc/resolv.conf" `File.hasContent`+		[ "nameserver 127.0.0.1"+		, "domain kitenet.net"+		, "search kitenet.net"+		] 	& alias "debug-me.joeyh.name" 	-- debug-me installed manually until package is available 	& Systemd.enabled "debug-me"@@ -344,10 +348,6 @@ 		(LetsEncrypt.AgreeTOS (Just "id@joeyh.name")) 	& alias "letsencrypt.joeyh.name"   where-	rootsshkey = Ssh.userKeys (User "root")-		(Context "kite.kitenet.net")-		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")-		]  elephant :: Host elephant = host "elephant.kitenet.net" $ props@@ -374,8 +374,7 @@ 	& Apt.serviceInstalledRunning "swapspace"  	& alias "eubackup.kitenet.net"-	& Apt.installed ["obnam", "sshfs", "rsync"]-	& JoeySites.obnamRepos ["pell", "kite"]+	& Apt.installed ["sshfs", "rsync", "borgbackup"] 	& JoeySites.githubBackup 	& JoeySites.rsyncNetBackup hosts @@ -387,9 +386,6 @@ 	& alias "kgb.kitenet.net" 	& JoeySites.kgbServer -	& alias "mumble.kitenet.net"-	& JoeySites.mumbleServer hosts- 	& alias "ns3.kitenet.net" 	& myDnsSecondary @@ -453,8 +449,8 @@ 	& alias "dist-bugs.kitenet.net" 	& alias "family.kitenet.net" -	& osDebian (Stable "jessie") X86_64-	& Apt.installed ["linux-image-amd64"]+	& osDebian (Stable "stretch") X86_64+	& Apt.installed ["linux-image-686-pae"] 	& Apt.unattendedUpgrades 	& Branchable.server hosts 	& Linode.serialGrub

@@ -1,5 +1,5 @@ Name: propellor-Version: 4.7.7+Version: 4.8.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -127,6 +127,7 @@     Propellor.Property.LightDM     Propellor.Property.Locale     Propellor.Property.Logcheck+    Propellor.Property.Lvm     Propellor.Property.Mount     Propellor.Property.Network     Propellor.Property.Nginx

@@ -97,6 +97,7 @@ 	lock = do 		createDirectoryIfMissing True (takeDirectory lockfile) 		l <- createFile lockfile stdFileMode+		setFdOption l CloseOnExec True 		setLock l (WriteLock, AbsoluteSeek, 0, 0) 			`catchIO` const alreadyrunning 		return l

@@ -331,7 +331,9 @@ isInstalled p = isInstalled' [p]  isInstalled' :: [Package] -> IO Bool-isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps+isInstalled' ps = do+	is <- getInstallStatus ps+	return $ all (== IsInstalled) is && length is == length ps  data InstallStatus = IsInstalled | NotInstalled 	deriving (Show, Eq)

@@ -108,7 +108,7 @@   where 	desc = backupdir ++ " attic backup" 	cronjob = Cron.niceJob ("attic_backup" ++ dir) crontimes (User "root") "/" $-		"flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd+		"flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd 	lockfile = "/var/lock/propellor-attic.lock" 	backupcmd = intercalate ";" $ 		createCommand

@@ -3,7 +3,10 @@ -- Support for the Borg backup tool <https://github.com/borgbackup>  module Propellor.Property.Borg-	( installed+	( BorgParam+	, BorgRepo(..)+	, BorgRepoOpt(..)+	, installed 	, repoExists 	, init 	, restored@@ -17,10 +20,40 @@ import qualified Propellor.Property.Cron as Cron import Data.List (intercalate) +-- | Parameter to pass to a borg command. type BorgParam = String -type BorgRepo = FilePath+-- | A borg repository.+data BorgRepo+	-- | Location of the repository, eg+	-- `BorgRepo "root@myserver:/mnt/backup/git.borg"`+	= BorgRepo String+	-- | Location of the repository, and additional options to use+	-- when accessing the repository.+	| BorgRepoUsing [BorgRepoOpt] String +data BorgRepoOpt +	-- | Use to specify a ssh private key to use when accessing a+	-- BorgRepo.+	= UseSshKey FilePath++repoLoc :: BorgRepo -> String+repoLoc (BorgRepo s) = s+repoLoc (BorgRepoUsing _ s) = s++runBorg :: BorgRepo -> [CommandParam] -> IO Bool+runBorg repo ps = case runBorgEnv repo of+	[] -> boolSystem "borg" ps+	environ -> do+		environ' <- addEntries environ <$> getEnvironment+		boolSystemEnv "borg" ps (Just environ')++runBorgEnv :: BorgRepo -> [(String, String)]+runBorgEnv (BorgRepo _) = []+runBorgEnv (BorgRepoUsing os _) = map go os+  where+	go (UseSshKey k) = ("BORG_RSH", k)+ installed :: Property DebianLike installed = withOS desc $ \w o -> case o of 	(Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $@@ -31,19 +64,20 @@         desc = "installed borgbackup"  repoExists :: BorgRepo -> IO Bool-repoExists repo = boolSystem "borg" [Param "list", File repo]+repoExists repo = runBorg repo [Param "list", Param (repoLoc repo)]  -- | Inits a new borg repository init :: BorgRepo -> Property DebianLike-init backupdir = check (not <$> repoExists backupdir) (cmdProperty "borg" initargs)-	`requires` installed+init repo = check (not <$> repoExists repo)+	(cmdPropertyEnv "borg" initargs (runBorgEnv repo))+		`requires` installed   where 	initargs = 		[ "init"-		, backupdir+		, repoLoc repo 		] --- | Restores a directory from an borg backup.+-- | Restores a directory from a borg backup. -- -- Only does anything if the directory does not exist, or exists, -- but is completely empty.@@ -51,7 +85,7 @@ -- The restore is performed atomically; restoring to a temp directory -- and then moving it to the directory. restored :: FilePath -> BorgRepo -> Property DebianLike-restored dir backupdir = go `requires` installed+restored dir repo = go `requires` installed   where 	go :: Property DebianLike 	go = property (dir ++ " restored by borg") $ ifM (liftIO needsRestore)@@ -64,9 +98,9 @@ 	needsRestore = null <$> catchDefaultIO [] (dirContents dir)  	restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do-		ok <- boolSystem "borg" $+		ok <- runBorg repo $ 			[ Param "extract"-			, Param backupdir+			, Param (repoLoc repo) 			, Param tmpdir 			] 		let restoreddir = tmpdir ++ "/" ++ dir@@ -88,53 +122,61 @@ -- to a host, while also ensuring any changes made to it get backed up. -- For example: ----- >	& Borg.backup "/srv/git" "root@myserver:/mnt/backup/git.borg" Cron.Daily+-- >	& Borg.backup "/srv/git"+-- >		(BorgRepo "root@myserver:/mnt/backup/git.borg") +-- >		Cron.Daily -- >		["--exclude=/srv/git/tobeignored"] -- >		[Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1] ----- Note that this property does not make borg encrypt the backup--- repository.+-- Note that this property does not initialize the backup repository,+-- so that will need to be done once, before-hand. -- -- Since borg uses a fair amount of system resources, only one borg -- backup job will be run at a time. Other jobs will wait their turns to -- run. backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike-backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp-	`requires` restored dir backupdir+backup dir repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp+	`requires` restored dir repo  -- | Does a backup, but does not automatically restore. backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike-backup' dir backupdir crontimes extraargs kp = cronjob+backup' dir repo crontimes extraargs kp = cronjob 	`describe` desc 	`requires` installed   where-	desc = backupdir ++ " borg backup"+	desc = repoLoc repo ++ " borg backup" 	cronjob = Cron.niceJob ("borg_backup" ++ dir) crontimes (User "root") "/" $-		"flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd+		"flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd 	lockfile = "/var/lock/propellor-borg.lock"-	backupcmd = intercalate ";" $-		createCommand-		: if null kp then [] else [pruneCommand]+	backupcmd = intercalate ";" $ concat+		[ concatMap exportenv (runBorgEnv repo)+		, [createCommand]+		, if null kp then [] else [pruneCommand]+		]+	exportenv (k, v) = +		[ k ++ "=" ++ shellEscape v+		, "export " ++ k+		] 	createCommand = unwords $ 		[ "borg" 		, "create" 		, "--stats" 		] 		++ map shellEscape extraargs ++-		[ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)"+		[ shellEscape (repoLoc repo) ++ "::" ++ "$(date --iso-8601=ns --utc)" 		, shellEscape dir 		] 	pruneCommand = unwords $ 		[ "borg" 		, "prune"-		, shellEscape backupdir+		, shellEscape (repoLoc repo) 		] 		++ 		map keepParam kp  -- | Constructs an BorgParam that specifies which old backup generations to -- keep. By default, all generations are kept. However, when this parameter is--- passed to the `backup` property, they will run borg prune to clean out+-- passed to the `backup` property, it will run borg prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> BorgParam keepParam (KeepHours n) = "--keep-hourly=" ++ val n

@@ -8,12 +8,13 @@ 	-- * Partition specification 	module Propellor.Property.DiskImage.PartSpec, 	-- * Properties-	DiskImage,+	DiskImage(..),+	RawDiskImage(..),+	VirtualBoxPointer(..), 	imageBuilt, 	imageRebuilt, 	imageBuiltFrom, 	imageExists,-	vmdkBuiltFor, 	Grub.BIOS(..), ) where @@ -42,8 +43,49 @@ import qualified Data.ByteString.Lazy as L import System.Posix.Files -type DiskImage = FilePath+-- | Type class of disk image formats.+class DiskImage d where+	-- | Get the location where the raw disk image should be stored.+	rawDiskImage :: d -> RawDiskImage+	-- | Describe the disk image (for display to the user)+	describeDiskImage :: d -> String+	-- | Convert the raw disk image file in the+	-- `rawDiskImage` location into the desired disk image format.+	-- For best efficiency, the raw disk imasge file should be left+	-- unchanged on disk.+	buildDiskImage :: d -> RevertableProperty DebianLike Linux +-- | A raw disk image, that can be written directly out to a disk.+newtype RawDiskImage = RawDiskImage FilePath++instance DiskImage RawDiskImage where+	rawDiskImage = id+	describeDiskImage (RawDiskImage f) = f+	buildDiskImage (RawDiskImage _) = doNothing <!> doNothing++-- | A virtualbox .vmdk file, which contains a pointer to the raw disk+-- image. This can be built very quickly.+newtype VirtualBoxPointer = VirtualBoxPointer FilePath++instance DiskImage VirtualBoxPointer where+	rawDiskImage (VirtualBoxPointer f) = RawDiskImage $+		dropExtension f ++ ".img"+	describeDiskImage (VirtualBoxPointer f) = f+	buildDiskImage (VirtualBoxPointer vmdkfile) = (setup <!> cleanup)+		`describe` (vmdkfile ++ " built")+	  where+		setup = cmdProperty "VBoxManage"+			[ "internalcommands", "createrawvmdk"+			, "-filename", vmdkfile+			, "-rawdisk", diskimage+			]+			`changesFile` vmdkfile+			`onChange` File.mode vmdkfile (combineModes (ownerWriteMode : readModes))+			`requires` Apt.installed ["virtualbox"]+			`requires` File.notPresent vmdkfile+		cleanup = tightenTargets $ File.notPresent vmdkfile+		RawDiskImage diskimage = rawDiskImage (VirtualBoxPointer vmdkfile)+ -- | Creates a bootable disk image. -- -- First the specified Chroot is set up, and its properties are satisfied.@@ -70,7 +112,7 @@ -- > import Propellor.Property.Chroot -- >  -- > foo = host "foo.example.com" $ props--- > 	& imageBuilt "/srv/diskimages/disk.img" mychroot+-- > 	& imageBuilt (RawDiskImage "/srv/diskimages/disk.img") mychroot -- >		MSDOS -- >		[ partition EXT2 `mountedAt` "/boot" -- >			`setFlag` BootFlag@@ -95,7 +137,7 @@ -- -- > foo :: Host -- > foo = host "foo.example.com" $ props--- >	& imageBuilt "/srv/diskimages/bar-disk.img"+-- >	& imageBuilt (RawDiskImage "/srv/diskimages/bar-disk.img") -- >		(hostChroot bar (Debootstrapped mempty)) -- >		MSDOS -- >		[ partition EXT2 `mountedAt` "/boot"@@ -111,30 +153,31 @@ -- >	& Apt.installed ["linux-image-amd64"] -- >	& Grub.installed PC -- >	& hasPassword (User "root")-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux+imageBuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt = imageBuilt' False  -- | Like 'built', but the chroot is deleted and rebuilt from scratch each -- time. This is more expensive, but useful to ensure reproducible results -- when the properties of the chroot have been changed.-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux+imageRebuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageRebuilt = imageBuilt' True -imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux+imageBuilt' :: DiskImage d => Bool -> d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt' rebuild img mkchroot tabletype partspec = 	imageBuiltFrom img chrootdir tabletype final partspec 		`requires` Chroot.provisioned chroot 		`requires` (cleanrebuild <!> (doNothing :: Property UnixLike)) 		`describe` desc   where-	desc = "built disk image " ++ img+	desc = "built disk image " ++ describeDiskImage img+	RawDiskImage imgfile = rawDiskImage img 	cleanrebuild :: Property Linux 	cleanrebuild 		| rebuild = property desc $ do 			liftIO $ removeChroot chrootdir 			return MadeChange 		| otherwise = doNothing-	chrootdir = img ++ ".chroot"+	chrootdir = imgfile ++ ".chroot" 	chroot = 		let c = propprivdataonly $ mkchroot chrootdir 		in setContainerProps c $ containerProps c@@ -161,10 +204,11 @@ 	skipit = doNothing :: Property UnixLike  -- | Builds a disk image from the contents of a chroot.-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) UnixLike+imageBuiltFrom :: DiskImage d => d -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg   where-	desc = img ++ " built from " ++ chrootdir+	desc = describeDiskImage img ++ " built from " ++ chrootdir+	dest@(RawDiskImage imgfile) = rawDiskImage img 	mkimg = property' desc $ \w -> do 		-- Unmount helper filesystems such as proc from the chroot 		-- first; don't want to include the contents of those.@@ -176,14 +220,17 @@ 		let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $ 			map (calcsz mnts) mnts 		ensureProperty w $-			imageExists' img parttable+			imageExists' dest parttable 				`before`-			kpartx img (mkimg' mnts mntopts parttable)+			kpartx imgfile (mkimg' mnts mntopts parttable)+				`before`+			buildDiskImage img 	mkimg' mnts mntopts parttable devs = 		partitionsPopulated chrootdir mnts mntopts devs 			`before` 		imageFinalized final mnts mntopts devs parttable-	rmimg = undoRevertableProperty (imageExists' img dummyparttable)+	rmimg = undoRevertableProperty (buildDiskImage img)+		`before` undoRevertableProperty (imageExists' dest dummyparttable) 	dummyparttable = PartTable tabletype []  partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike@@ -255,8 +302,8 @@ -- If the file doesn't exist, or is too small, creates a new one, full of 0's. -- -- If the file is too large, truncates it down to the specified size.-imageExists :: FilePath -> ByteSize -> Property Linux-imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do+imageExists :: RawDiskImage -> ByteSize -> Property Linux+imageExists (RawDiskImage img) isz = property ("disk image exists" ++ img) $ liftIO $ do 	ms <- catchMaybeIO $ getFileStatus img 	case ms of 		Just s@@ -278,14 +325,14 @@ -- -- Avoids repartitioning the disk image, when a file of the right size -- already exists, and it has the same PartTable.-imageExists' :: FilePath -> PartTable -> RevertableProperty DebianLike UnixLike-imageExists' img parttable = (setup <!> cleanup) `describe` desc+imageExists' :: RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike+imageExists' dest@(RawDiskImage img) parttable = (setup <!> cleanup) `describe` desc   where 	desc = "disk image exists " ++ img 	parttablefile = img ++ ".parttable" 	setup = property' desc $ \w -> do 		oldparttable <- liftIO $ catchDefaultIO "" $ readFileStrict parttablefile-		res <- ensureProperty w $ imageExists img (partTableSize parttable)+		res <- ensureProperty w $ imageExists dest (partTableSize parttable) 		if res == NoChange && oldparttable == show parttable 			then return NoChange 			else if res == FailedChange@@ -385,20 +432,3 @@ toSysDir chrootdir d = case makeRelative chrootdir d of 		"." -> "/" 		sysdir -> "/" ++ sysdir---- | Builds a VirtualBox .vmdk file for the specified disk image file.-vmdkBuiltFor :: FilePath -> RevertableProperty DebianLike UnixLike-vmdkBuiltFor diskimage = (setup <!> cleanup)-	`describe` (vmdkfile ++ " built")-  where-	vmdkfile = diskimage ++ ".vmdk"-	setup = cmdProperty "VBoxManage"-		[ "internalcommands", "createrawvmdk"-		, "-filename", vmdkfile-		, "-rawdisk", diskimage-		]-		`changesFile` vmdkfile-		`onChange` File.mode vmdkfile (combineModes (ownerWriteMode : readModes))-		`requires` Apt.installed ["virtualbox"]-		`requires` File.notPresent vmdkfile-	cleanup = File.notPresent vmdkfile

@@ -0,0 +1,171 @@+-- | Maintainer: Nicolas Schodet <nico@ni.fr.eu.org>+--+-- Support for LVM logical volumes.++module Propellor.Property.Lvm (+	lvFormatted,+	installed,+	Eep(..),+	VolumeGroup(..),+	LogicalVolume(..),+) where++import Propellor+import Propellor.Base+import Utility.DataUnits+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Mount as Mount+import qualified Propellor.Property.Partition as Partition++data Eep = YesReallyFormatLogicalVolume++type DataSize = String++newtype VolumeGroup = VolumeGroup String+data LogicalVolume = LogicalVolume String VolumeGroup++-- | Create or resize a logical volume, and make sure it is formatted.  When+-- reverted, remove the logical volume.+--+-- Example use:+--+-- > import qualified Propellor.Property.Lvm as Lvm+-- > import qualified Propellor.Property.Partition as Partition+-- > Lvm.lvFormatted Lvm.YesReallyFormatLogicalVolume+-- >         (Lvm.LogicalVolume "test" (Lvm.VolumeGroup "vg0")) "16m"+-- >         Partition.EXT4+--+-- If size and filesystem match, nothing is done.+--+-- Volume group must have been created already.+lvFormatted+	:: Eep+	-> LogicalVolume+	-> DataSize+	-> Partition.Fs+	-> RevertableProperty DebianLike UnixLike+lvFormatted YesReallyFormatLogicalVolume lv sz fs =+	setup <!> cleanup+  where+	setup :: Property DebianLike+	setup = property' ("formatted logical volume " ++ (vglv lv)) $ \w -> do+		es <- liftIO $ vgExtentSize vg+		case es of+			Nothing -> errorMessage $+				"can not get extent size, does volume group "+				++ vgname ++ " exist?"+			Just extentSize -> do+				case parseSize of+					Nothing -> errorMessage +						"can not parse volume group size"+					Just size -> do+						state <- liftIO $ lvState lv+						let rsize = roundSize extentSize size+						ensureProperty w $+							setupprop rsize state++	cleanup :: Property UnixLike+	cleanup = property' ("removed logical volume " ++ (vglv lv)) $ \w -> do+		exists <- liftIO $ lvExists lv+		ensureProperty w $ if exists+			then removedprop+			else doNothing++	-- Parse size.+	parseSize :: Maybe Integer+	parseSize = readSize dataUnits sz++	-- Round size to next extent size multiple.+	roundSize :: Integer -> Integer -> Integer+	roundSize extentSize s =+		(s + extentSize - 1) `div` extentSize * extentSize++	-- Dispatch to the right props.+	setupprop :: Integer -> (Maybe LvState) -> Property DebianLike+	setupprop size Nothing = createdprop size `before` formatprop+	setupprop size (Just (LvState csize cfs))+		| size == csize && fsMatch fs cfs = doNothing+		| size == csize = formatprop+		| fsMatch fs cfs = tightenTargets $ resizedprop size True+		| otherwise = resizedprop size False `before` formatprop++	createdprop :: Integer -> Property UnixLike+	createdprop size =+		cmdProperty "lvcreate"+			(bytes size $ [ "-n", lvname, "--yes", vgname ])+			`assume` MadeChange++	resizedprop :: Integer -> Bool -> Property UnixLike+	resizedprop size rfs =+		cmdProperty "lvresize"+			(resizeFs rfs $ bytes size $ [ vglv lv ])+			`assume` MadeChange+	  where+		resizeFs True l = "-r" : l+		resizeFs False l = l++	removedprop :: Property UnixLike+	removedprop = cmdProperty "lvremove" [ "-f", vglv lv ]+		`assume` MadeChange++	formatprop :: Property DebianLike+	formatprop = Partition.formatted Partition.YesReallyFormatPartition+		fs (path lv)++	fsMatch :: Partition.Fs -> Maybe Partition.Fs -> Bool+	fsMatch a (Just b) = a == b+	fsMatch _ _ = False++	bytes size l = "-L" : ((show size) ++ "b") : l++	(LogicalVolume lvname vg@(VolumeGroup vgname)) = lv++-- | Make sure needed tools are installed.+installed :: RevertableProperty DebianLike DebianLike+installed = install <!> remove+  where+	install = Apt.installed ["lvm2"]+	remove = Apt.removed ["lvm2"]++data LvState = LvState Integer (Maybe Partition.Fs)++-- Check for logical volume existance.+lvExists :: LogicalVolume -> IO Bool+lvExists lv = doesFileExist (path lv)++-- Return Nothing if logical volume does not exists (or error), else return+-- its size and maybe file system.+lvState :: LogicalVolume -> IO (Maybe LvState)+lvState lv = do+	exists <- lvExists lv+	if not exists+		then return Nothing+		else do+			s <- readLvSize+			fs <- maybe Nothing Partition.parseFs <$> readFs+			return $ do+				size <- s+				return $ LvState size fs+  where+	readLvSize = catchDefaultIO Nothing $ readish+		<$> readProcess "lvs" [ "-o", "size", "--noheadings",+			"--nosuffix", "--units", "b", vglv lv ]+	readFs = Mount.blkidTag "TYPE" (path lv)++-- Read extent size (or Nothing on error).+vgExtentSize :: VolumeGroup -> IO (Maybe Integer)+vgExtentSize (VolumeGroup vgname) =+	catchDefaultIO Nothing $ readish+		<$> readProcess "vgs" [ "-o", "vg_extent_size",+			"--noheadings", "--nosuffix", "--units", "b", vgname ]++-- Give "vgname/lvname" for a LogicalVolume.+vglv :: LogicalVolume -> String+vglv lv =+	vgname </> lvname+  where+	(LogicalVolume lvname (VolumeGroup vgname)) = lv++-- Give device path.+path :: LogicalVolume -> FilePath+path lv = "/dev" </> (vglv lv)

@@ -15,6 +15,20 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap 	deriving (Show, Eq) +-- | Parse commonly used names of filesystems.+parseFs :: String -> Maybe Fs+parseFs "ext2" = Just EXT2+parseFs "ext3" = Just EXT3+parseFs "ext4" = Just EXT4+parseFs "btrfs" = Just BTRFS+parseFs "reiserfs" = Just REISERFS+parseFs "xfs" = Just XFS+parseFs "fat" = Just FAT+parseFs "vfat" = Just VFAT+parseFs "ntfs" = Just NTFS+parseFs "swap" = Just LinuxSwap+parseFs _ = Nothing+ data Eep = YesReallyFormatPartition  -- | Formats a partition.

@@ -8,6 +8,8 @@ import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Sudo as Sudo+import qualified Propellor.Property.Borg as Borg+import qualified Propellor.Property.Cron as Cron  server :: [Host] -> Property (HasInfo + DebianLike) server hosts = propertyList "branchable server" $ props@@ -37,18 +39,24 @@ 	& Postfix.installed 	& Postfix.mainCf ("mailbox_command", "procmail -a \"$EXTENSION\"") 	-	-- Obnam is run by a cron job in ikiwiki-hosting.-	& "/etc/obnam.conf" `File.hasContent`-		[ "[config]"-		, "repository = sftp://joey@eubackup.kitenet.net/home/joey/lib/backup/pell.obnam"-		, "log = /var/log/obnam.log"-		, "encrypt-with = " ++ obnamkey-		, "log-level = info"-		, "log-max = 1048576"-		, "keep = 7d,5w,12m"-		, "upload-queue-size = 128"-		, "lru-size = 128"+	& Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/branchable/pell.borg") Cron.Daily+		[ "--exclude=/proc/*"+		, "--exclude=/sys/*"+		, "--exclude=/run/*"+		, "--exclude=/tmp/*"+		, "--exclude=/var/tmp/*"+		, "--exclude=/var/backups/ikiwiki-hosting-web/*"+		, "--exclude=/var/cache/*"+		, "--exclude=/home/*/source/*"+		, "--exclude=/home/*/public_html/*"+		, "--exclude=/home/*/.git/*" 		]+		[ Borg.KeepDays 7+		, Borg.KeepWeeks 5+		, Borg.KeepMonths 12+		, Borg.KeepYears 1+		]+	-- gpg key that can be used to decrypt the borg backup key 	& Gpg.keyImported (Gpg.GpgKeyId obnamkey) (User "root") 	& Ssh.userKeys (User "root") (Context "branchable.com") 		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn")

@@ -15,7 +15,7 @@ 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.Borg as Borg import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Systemd as Systemd@@ -141,17 +141,17 @@ 		)  	oldUseNetBackup :: Property (HasInfo + DebianLike)-	oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"-		, "--client-name=spool"-		, "--ssh-key=" ++ keyfile-		, Obnam.keepParam [Obnam.KeepDays 30]-		] Obnam.OnlyClient+	oldUseNetBackup = Borg.backup datadir borgrepo +		(Cron.Times "33 4 * * *")+		[]+		[Borg.KeepDays 30] 		`requires` Ssh.userKeyAt (Just keyfile) 			(User "root") 			(Context "olduse.net") 			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")-		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")+		`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")+	borgrepo = Borg.BorgRepoUsing [Borg.UseSshKey keyfile]+		"joey@eubackup.kitenet.net:/home/joey/lib/backup/olduse.net/olduse.net.borg" 	keyfile = "/root/.ssh/olduse.net.key"  oldUseNetShellBox :: Property DebianLike@@ -162,13 +162,13 @@ oldUseNetInstalled :: Apt.Package -> Property DebianLike oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $ 	propertyList ("olduse.net " ++ pkg) $ props-		& 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")+		& 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-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev haskell-stack") 			`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"+			, "HOME=/root dpkg-buildpackage -us -uc" 			, "dpkg -i ../" ++ pkg ++ "_*.deb || true" 			, "apt-get -fy install" -- dependencies 			, "rm -rf /root/tmp/oldusenet"@@ -193,42 +193,20 @@ 					`onChange` Service.running "kgb-bot" 		_ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)" -mumbleServer :: [Host] -> Property (HasInfo + DebianLike)-mumbleServer hosts = combineProperties hn $ props-	& Apt.serviceInstalledRunning "mumble-server"-	& Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam"-		, "--ssh-key=" ++ sshkey-		, "--client-name=mumble"-		, Obnam.keepParam [Obnam.KeepDays 30]-		] Obnam.OnlyClient-		`requires` Ssh.userKeyAt (Just sshkey)-			(User "root")- 			(Context hn)-			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDSXXSM3mM8SNu+qel9R/LkDIkjpV3bfpUtRtYv2PTNqicHP+DdoThrr0ColFCtLH+k2vQJvR2n8uMzHn53Dq2IO3TtD27+7rJSsJwAZ8oftNzuTir8IjAwX5g6JYJs+L0Ny4RB0ausd+An0k/CPMRl79zKxpZd2MBMDNXt8hyqu0vS0v1ohq5VBEVhBBvRvmNQvWOCj7PdrKQXpUBHruZOeVVEdUUXZkVc1H0t7LVfJnE+nGKyWbw2jM+7r3Rn5Semc4R1DxsfaF8lKkZyE88/5uZQ/ddomv8ptz6YZ5b+Bg6wfooWPC3RWAALjxnHaC2yN1VONAvHmT0uNn1o6v0b")-		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")-	& cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]-		`assume` NoChange-  where-	hn = "mumble.debian.net"-	sshkey = "/root/.ssh/mumble.debian.net.key"- -- git.kitenet.net and git.joeyh.name gitServer :: [Host] -> Property (HasInfo + DebianLike) gitServer hosts = propertyList "git.kitenet.net setup" $ props-	& Obnam.backupEncrypted "/srv/git" (Cron.Times "33 3 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"-		, "--ssh-key=" ++ sshkey-		, "--client-name=wren" -- historical-		, Obnam.keepParam [Obnam.KeepDays 30]-		] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1")+	& Borg.backup "/srv/git" borgrepo+		(Cron.Times "33 3 * * *")+		[]+		[Borg.KeepDays 30] 		`requires` Ssh.userKeyAt (Just sshkey) 			(User "root") 			(Context "git.kitenet.net")-			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")-		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")-		`requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net")-		`requires` User.accountFor (User "family")+			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDLwUUkpkI9c2Wcnv/E4v9bJ7WcpiNkToltXfzRDd1F31AYrucfSMgzu3rtDpEL+wSnQLua/taJkWUWT/pyXOAh+90K6O/YeBZmY5CK01rYDz3kSTAtwHkMqednsRjdQS6NNJsuWc1reO8a4pKtsToJ3G9VAKufCkt2b8Nhqz0yLvLYwwU/mdI8DmfX6IgXhdy9njVEG/jsQnLFXY6QEfwKbIPs9O6qo4iFJg3defXX+zVMLsh3NE1P2i2VxMjxJEQdPdy9Z1sVpkiQM+mgJuylQQ5flPK8sxhO9r4uoK/JROkjPJNYoJMlsN+QlK04ABb7JV2JwhAL/Y8ypjQ13JdT")+		`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")+	& Ssh.authorizedKeys (User "family") (Context "git.kitenet.net")+	& User.accountFor (User "family") 	& Apt.installed ["git", "rsync", "cgit"] 	& Apt.installed ["git-annex"] 	& Apt.installed ["kgb-client"]@@ -257,6 +235,8 @@ 	& Apache.modEnabled "cgi"   where 	sshkey = "/root/.ssh/git.kitenet.net.key"+	borgrepo = Borg.BorgRepoUsing [Borg.UseSshKey sshkey]+		"joey@eubackup.kitenet.net:/home/joey/lib/backup/git.kitenet.net/git.kitenet.net.borg" 	website hn = Apache.httpsVirtualHost' hn "/srv/web/git.kitenet.net/" letos 		[ Apache.iconDir 		, "  <Directory /srv/web/git.kitenet.net/>"@@ -440,16 +420,6 @@ 	desc = "backups copied from " ++ srchost ++ " on boot" 	cmd = "sleep 30m && rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir </> srchost -obnamRepos :: [String] -> Property UnixLike-obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) $-	toProps (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 (User "joey") (Group "joey")- podcatcher :: Property DebianLike podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *") 	(User "joey") "/home/joey/lib/sound/podcasts"@@ -520,6 +490,7 @@  	& "/etc/aliases" `File.hasPrivContentExposed` ctx 		`onChange` Postfix.newaliases+	& hasPostfixCert ctx  	& "/etc/postfix/mydomain" `File.containsLines` 		[ "/.*\\.kitenet\\.net/\tOK"@@ -582,9 +553,9 @@ 		, "milter_default_action = accept"  		, "# TLS setup -- server"-		, "smtpd_tls_CAfile = /etc/letsencrypt/live/kitenet.net/fullchain.pem"-		, "smtpd_tls_cert_file = /etc/letsencrypt/live/kitenet.net/cert.pem"-		, "smtpd_tls_key_file = /etc/letsencrypt/live/kitenet.net/privkey.pem"+		, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"+		, "smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem"+		, "smtpd_tls_key_file = /etc/ssl/private/postfix.pem" 		, "smtpd_tls_loglevel = 1" 		, "smtpd_tls_received_header = yes" 		, "smtpd_use_tls = yes"@@ -592,9 +563,9 @@ 		, "smtpd_tls_session_cache_database = sdbm:/etc/postfix/smtpd_scache"  		, "# TLS setup -- client"-		, "smtp_tls_CAfile = /etc/letsencrypt/live/kitenet.net/fullchain.pem"-		, "smtp_tls_cert_file = /etc/letsencrypt/live/kitenet.net/cert.pem"-		, "smtp_tls_key_file = /etc/letsencrypt/live/kitenet.net/privkey.pem"+		, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"+		, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"+		, "smtp_tls_key_file = /etc/ssl/private/postfix.pem" 		, "smtp_tls_loglevel = 1" 		, "smtp_use_tls = yes" 		, "smtp_tls_session_cache_database = sdbm:/etc/postfix/smtp_scache"@@ -613,12 +584,6 @@ 		"!include auth-passwdfile.conf.ext" 		`onChange` Service.restarted "dovecot" 		`describe` "dovecot auth.conf"-	& "/etc/dovecot/conf.d/10-ssl.conf" `File.containsLines`-		[ "ssl_cert = </etc/letsencrypt/live/kitenet.net/fullchain.pem"-		, "ssl_key = </etc/letsencrypt/live/kitenet.net/privkey.pem"-		]-		`onChange` Service.restarted "dovecot"-		`describe` "dovecot letsencrypt certs" 	& File.hasPrivContent dovecotusers ctx 		`onChange` (dovecotusers `File.mode` 			combineModes [ownerReadMode, groupReadMode])@@ -718,6 +683,11 @@ 		, "smtp_sasl_password_maps = hash:/etc/postfix/sasl_passwd" 		] 		`onChange` Postfix.reloaded++hasPostfixCert :: Context -> Property (HasInfo + UnixLike)+hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props+	& "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx+	& "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx  -- Legacy static web sites and redirections from kitenet.net to newer -- sites.