propellor 4.0.3 → 4.0.4

raw patch · 31 files changed

+471/−143 lines, 31 filesdep +hashabledep +splitdep −MissingHPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable, split

Dependencies removed: MissingH

API changes (from Hackage documentation)

Files

• CHANGELOG +15/−0
• debian/changelog +15/−0
• debian/control +4/−2
• joeyconfig.hs +27/−34
• propellor.cabal +18/−11
• src/Propellor/Bootstrap.hs +6/−3
• src/Propellor/Gpg.hs +1/−1
• src/Propellor/Property.hs +7/−7
• src/Propellor/Property/Apt/PPA.hs +2/−1
• src/Propellor/Property/Chroot.hs +1/−1
• src/Propellor/Property/Docker.hs +1/−1
• src/Propellor/Property/Hostname.hs +1/−1
• src/Propellor/Property/Restic.hs +202/−0
• src/Propellor/Property/Sbuild.hs +2/−2
• src/Propellor/Property/SiteSpecific/JoeySites.hs +21/−4
• src/Propellor/Property/Systemd.hs +1/−1
• src/Propellor/Property/ZFS/Process.hs +2/−1
• src/Propellor/Ssh.hs +8/−10
• src/Propellor/Types/Dns.hs +4/−4
• src/Propellor/Types/ZFS.hs +2/−2
• src/Utility/DataUnits.hs +6/−2
• src/Utility/FileMode.hs +20/−2
• src/Utility/FileSystemEncoding.hs +29/−12
• src/Utility/LinuxMkLibs.hs +1/−1
• src/Utility/PartialPrelude.hs +1/−1
• src/Utility/Path.hs +11/−21
• src/Utility/Process.hs +13/−15
• src/Utility/SafeCommand.hs +2/−2
• src/Utility/Scheduled.hs +1/−1
• src/Utility/Split.hs +30/−0
• src/Utility/Tuple.hs +17/−0

@@ -1,3 +1,18 @@+propellor (4.0.5) unstable; urgency=medium++  * Switch cabal file from Extensions to Default-Extensions to fix+    new picky hackage rejection.++ -- Joey Hess <id@joeyh.name>  Sat, 03 Jun 2017 15:07:36 -0400++propellor (4.0.4) unstable; urgency=medium++  * Propellor.Property.Restic added for yet another backup program.+    Thanks, Félix Sipma.+  * Removed dependency on MissingH, instead depends on split and hashable.++ -- Joey Hess <id@joeyh.name>  Sat, 03 Jun 2017 14:56:44 -0400+ propellor (4.0.3) unstable; urgency=medium    * Added Fstab.listed, Fstab.swap, and Mount.swapOn properties.

@@ -1,3 +1,18 @@+propellor (4.0.5) unstable; urgency=medium++  * Switch cabal file from Extensions to Default-Extensions to fix+    new picky hackage rejection.++ -- Joey Hess <id@joeyh.name>  Sat, 03 Jun 2017 15:07:36 -0400++propellor (4.0.4) unstable; urgency=medium++  * Propellor.Property.Restic added for yet another backup program.+    Thanks, Félix Sipma.+  * Removed dependency on MissingH, instead depends on split and hashable.++ -- Joey Hess <id@joeyh.name>  Sat, 03 Jun 2017 14:56:44 -0400+ propellor (4.0.3) unstable; urgency=medium    * Added Fstab.listed, Fstab.swap, and Mount.swapOn properties.

@@ -7,7 +7,7 @@ 	ghc (>= 7.6), 	cabal-install, 	libghc-async-dev,-	libghc-missingh-dev,+	libghc-split-dev, 	libghc-hslogger-dev, 	libghc-unix-compat-dev, 	libghc-ansi-terminal-dev,@@ -18,6 +18,7 @@ 	libghc-exceptions-dev (>= 0.6), 	libghc-stm-dev, 	libghc-text-dev,+	libghc-hashable-dev, 	libghc-concurrent-output-dev, Maintainer: Joey Hess <id@joeyh.name> Standards-Version: 3.9.8@@ -31,7 +32,7 @@ 	ghc (>= 7.4), 	cabal-install, 	libghc-async-dev,-	libghc-missingh-dev,+	libghc-split-dev, 	libghc-hslogger-dev, 	libghc-unix-compat-dev, 	libghc-ansi-terminal-dev,@@ -42,6 +43,7 @@ 	libghc-exceptions-dev (>= 0.6), 	libghc-stm-dev, 	libghc-text-dev,+	libghc-hashable-dev, 	libghc-concurrent-output-dev, 	git, Description: property-based host configuration management in haskell

@@ -48,15 +48,16 @@ hosts =                 --                  (o)  ` 	[ darkstar 	, gnu+	, dragon 	, clam 	, mayfly-	, oyster 	, orca 	, baleen 	, honeybee 	, kite 	, elephant 	, beaver+	, mouse 	, pell 	, keysafe 	] ++ monsters@@ -86,9 +87,8 @@ 	& ipv6 "2001:4830:1600:187::2" 	& Aiccu.hasConfig "T18376" "JHZ2-SIXXS" -	& Apt.buildDep ["git-annex"] `period` Daily- 	& JoeySites.dkimMilter+	& JoeySites.postfixSaslPasswordClient 	& JoeySites.alarmClock "*-*-* 7:30" (User "joey") 		"/usr/bin/timeout 45m /home/joey/bin/goodmorning" 	& Ssh.userKeys (User "joey") hostContext@@ -112,13 +112,19 @@  gnu :: Host gnu = host "gnu.kitenet.net" $ props-	& Apt.buildDep ["git-annex"] `period` Daily+	& Postfix.satellite +dragon :: Host+dragon = host "dragon.kitenet.net" $ props+	& ipv6 "2001:4830:1600:187::2"+	& JoeySites.dkimMilter+	& JoeySites.postfixSaslPasswordClient+ clam :: Host clam = host "clam.kitenet.net" $ props 	& standardSystem Unstable X86_64 		["Unreliable server. Anything here may be lost at any time!" ]-	& ipv4 "167.88.41.194"+	& ipv4 "64.137.231.62"  	& CloudAtCost.decruft 	& Ssh.hostKeys hostContext@@ -157,31 +163,6 @@ 	& Tor.named "kite3" 	& Tor.bandwidthRate (Tor.PerMonth "400 GB") -oyster :: Host-oyster = host "oyster.kitenet.net" $ props-	& standardSystem Unstable X86_64-		[ "Unreliable server. Anything here may be lost at any time!" ]-	& ipv4 "64.137.179.21"--	& CloudAtCost.decruft-	& Ssh.hostKeys hostContext-		[ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBP0ws/IxQegVU0RhqnIm5A/vRSPTO70wD4o2Bd1jL970dTetNyXzvWGe1spEbLjIYSLIO7WvOBSE5RhplBKFMUU=")-		]-	& Apt.unattendedUpgrades-	& Network.ipv6to4-	& Systemd.persistentJournal-	& Journald.systemMaxUse "500MiB"-	& Apt.serviceInstalledRunning "swapspace"--	& Tor.isRelay-	& Tor.named "kite4"-	& Tor.bandwidthRate (Tor.PerMonth "400 GB")--	-- Nothing is using http port 80, so listen on-	-- that port for ssh, for traveling on bad networks that-	-- block 22.-	& Ssh.listenPort (Port 80)- baleen :: Host baleen = host "baleen.kitenet.net" $ props 	& standardSystem Unstable X86_64 [ "New git-annex build box." ]@@ -286,6 +267,8 @@ 	& Journald.systemMaxUse "500MiB" 	& Ssh.passwordAuthentication True 	& Fail2Ban.installed -- since ssh password authentication is allowed+	-- Allow ssh -R to forward ports via kite+	& Ssh.setSshdConfig "GatewayPorts" "clientspecified" 	& Apt.serviceInstalledRunning "ntp" 	& "/etc/timezone" `File.hasContent` ["US/Eastern"] @@ -356,7 +339,9 @@ 	& JoeySites.oldUseNetServer hosts  	& alias "ns4.kitenet.net"-	& myDnsPrimary True "kitenet.net" []+	& myDnsPrimary True "kitenet.net"+		[ (RelDomain "mouse-onion", CNAME $ AbsDomain "htieo6yu2qtcn2j3.onion")+		] 	& myDnsPrimary True "joeyh.name" [] 	& myDnsPrimary True "ikiwiki.info" [] 	& myDnsPrimary True "olduse.net"@@ -366,6 +351,10 @@ 	& branchableSecondary 	& Dns.secondaryFor ["animx"] hosts "animx.eu.org" +	& alias "debug-me.joeyh.name"+	-- debug-me installed manually until package is available+	& Systemd.enabled "debug-me"+ 	-- testing 	& Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html" 		(LetsEncrypt.AgreeTOS (Just "id@joeyh.name"))@@ -450,6 +439,13 @@ 	& Cron.niceJob "system disk backed up" Cron.Weekly (User "root") "/" 		"rsync -a -x / /home/joey/lib/backup/beaver.kitenet.net/" +mouse :: Host+mouse = host "mouse.kitenet.net" $ props+	& ipv4 "67.223.19.96"+	& Apt.installed ["ssh"]+	& Tor.installed+	& Tor.hiddenServiceAvailable "ssh" (Port 22)+ -- Branchable is not completely deployed with propellor yet. pell :: Host pell = host "pell.branchable.com" $ props@@ -650,9 +646,6 @@ 		& Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" 	, host "ns6.gandi.net" $ props 		& ipv4 "217.70.177.40"-	, host "mouse.kitenet.net" $ props-		& ipv6 "2001:4830:1600:492::2"-		& ipv4 "67.223.19.96" 	, host "animx" $ props 		& ipv4 "76.7.162.186" 		& ipv4 "76.7.162.187"

@@ -1,6 +1,6 @@ Name: propellor-Version: 4.0.3-Cabal-Version: >= 1.8+Version: 4.0.4+Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -36,46 +36,49 @@  It is configured using haskell.  Executable propellor+  Default-Language: Haskell98   Main-Is: wrapper.hs   GHC-Options: -threaded -Wall -fno-warn-tabs -O0   if impl(ghc >= 8.0)     GHC-Options: -fno-warn-redundant-constraints-  Extensions: TypeOperators+  Default-Extensions: TypeOperators   Hs-Source-Dirs: src   Build-Depends:     -- propellor needs to support the ghc shipped in Debian stable,     -- and also only depends on packages in Debian stable.     base >= 4.5, base < 5,-    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,+    directory, filepath, IfElse, process, bytestring, hslogger, split,     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,-    time, mtl, transformers, exceptions (>= 0.6), stm, text+    time, mtl, transformers, exceptions (>= 0.6), stm, text, hashable   Other-Modules:     Propellor.DotDir  Executable propellor-config+  Default-Language: Haskell98   Main-Is: config.hs   GHC-Options: -threaded -Wall -fno-warn-tabs -O0   if impl(ghc >= 8.0)     GHC-Options: -fno-warn-redundant-constraints-  Extensions: TypeOperators+  Default-Extensions: TypeOperators   Hs-Source-Dirs: src   Build-Depends:     base >= 4.5, base < 5,-    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,+    directory, filepath, IfElse, process, bytestring, hslogger, split,     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,-    time, mtl, transformers, exceptions (>= 0.6), stm, text+    time, mtl, transformers, exceptions (>= 0.6), stm, text, hashable  Library+  Default-Language: Haskell98   GHC-Options: -Wall -fno-warn-tabs -O0   if impl(ghc >= 8.0)     GHC-Options: -fno-warn-redundant-constraints-  Extensions: TypeOperators+  Default-Extensions: TypeOperators   Hs-Source-Dirs: src   Build-Depends:     base >= 4.5, base < 5,-    MissingH, directory, filepath, IfElse, process, bytestring, hslogger,+    directory, filepath, IfElse, process, bytestring, hslogger, split,     unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async,-    time, mtl, transformers, exceptions (>= 0.6), stm, text+    time, mtl, transformers, exceptions (>= 0.6), stm, text, hashable    Exposed-Modules:     Propellor@@ -136,6 +139,7 @@     Propellor.Property.PropellorRepo     Propellor.Property.Prosody     Propellor.Property.Reboot+    Propellor.Property.Restic     Propellor.Property.Rsync     Propellor.Property.Sbuild     Propellor.Property.Scheduled@@ -221,10 +225,13 @@     Utility.Process.NonConcurrent     Utility.SafeCommand     Utility.Scheduled+    Utility.Scheduled+    Utility.Split     Utility.SystemDirectory     Utility.Table     Utility.ThreadScheduler     Utility.Tmp+    Utility.Tuple     Utility.UserInfo     System.Console.Concurrent     System.Console.Concurrent.Internal

@@ -83,7 +83,7 @@ 		, "ghc" 		, "cabal-install" 		, "libghc-async-dev"-		, "libghc-missingh-dev"+		, "libghc-split-dev" 		, "libghc-hslogger-dev" 		, "libghc-unix-compat-dev" 		, "libghc-ansi-terminal-dev"@@ -94,13 +94,14 @@ 		, "libghc-exceptions-dev" 		, "libghc-stm-dev" 		, "libghc-text-dev"+		, "libghc-hashable-dev" 		] 	fbsddeps = 		[ "gnupg" 		, "ghc" 		, "hs-cabal-install" 		, "hs-async"-		, "hs-MissingH"+		, "hs-split" 		, "hs-hslogger" 		, "hs-unix-compat" 		, "hs-ansi-terminal"@@ -111,13 +112,14 @@ 		, "hs-exceptions" 		, "hs-stm" 		, "hs-text"+		, "hs-hashable" 		] 	archlinuxdeps = 		[ "gnupg" 		, "ghc" 		, "cabal-install" 		, "haskell-async"-		, "haskell-missingh"+		, "haskell-split" 		, "haskell-hslogger" 		, "haskell-unix-compat" 		, "haskell-ansi-terminal"@@ -129,6 +131,7 @@ 		, "haskell-exceptions" 		, "haskell-stm" 		, "haskell-text"+		, "hashell-hashable" 		]  installGitCommand :: Maybe System -> ShellCommand

@@ -2,7 +2,6 @@  import System.IO import Data.Maybe-import Data.List.Utils import Control.Monad import Control.Applicative import Prelude@@ -18,6 +17,7 @@ import Utility.Tmp import Utility.Env import Utility.Directory+import Utility.Split  type KeyId = String 

@@ -50,8 +50,8 @@ import Control.Monad.IfElse import "mtl" Control.Monad.RWS.Strict import System.Posix.Files-import qualified Data.Hash.MD5 as MD5 import Data.List+import Data.Hashable import Control.Applicative import Prelude @@ -64,8 +64,8 @@ import Propellor.EnsureProperty import Utility.Exception import Utility.Monad-import Utility.Misc import Utility.Directory+import Utility.Misc  -- | Makes a perhaps non-idempotent Property be idempotent by using a flag -- file to indicate whether it has run before.@@ -228,12 +228,12 @@ -- Changes to mtime etc that do not change file content are treated as -- NoChange. changesFileContent :: Checkable p i => p i -> FilePath -> Property i-changesFileContent p f = checkResult getmd5 comparemd5 p+changesFileContent p f = checkResult gethash comparehash p   where-	getmd5 = catchMaybeIO $ MD5.md5 . MD5.Str <$> readFileStrict f-	comparemd5 oldmd5 = do-		newmd5 <- getmd5-		return $ if oldmd5 == newmd5 then NoChange else MadeChange+	gethash = catchMaybeIO $ hash <$> readFileStrict f+	comparehash oldhash = do+		newhash <- gethash+		return $ if oldhash == newhash then NoChange else MadeChange  -- | Determines if the first file is newer than the second file. --

@@ -6,10 +6,11 @@ import Data.List import Control.Applicative import Prelude-import Data.String.Utils import Data.String (IsString(..))+ import Propellor.Base import qualified Propellor.Property.Apt as Apt+import Utility.Split  -- | Ensure software-properties-common is installed. installed :: Property DebianLike

@@ -33,9 +33,9 @@ import qualified Propellor.Shim as Shim import Propellor.Property.Mount import Utility.FileMode+import Utility.Split  import qualified Data.Map as M-import Data.List.Utils import System.Posix.Directory import System.Console.Concurrent 

@@ -59,13 +59,13 @@ import qualified Propellor.Shim as Shim import Utility.Path import Utility.ThreadScheduler+import Utility.Split  import Control.Concurrent.Async hiding (link) import System.Posix.Directory import System.Posix.Process import Prelude hiding (init) import Data.List hiding (init)-import Data.List.Utils import qualified Data.Map as M import System.Console.Concurrent 

@@ -3,9 +3,9 @@ import Propellor.Base import qualified Propellor.Property.File as File import Propellor.Property.Chroot (inChroot)+import Utility.Split  import Data.List-import Data.List.Utils  -- | Ensures that the hostname is set using best practices, to whatever -- name the `Host` has.

@@ -0,0 +1,202 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>+--+-- Support for the restic backup tool <https://github.com/restic/restic>++module Propellor.Property.Restic+	( ResticRepo (..)+	, installed+	, repoExists+	, init+	, restored+	, backup+	, KeepPolicy (..)+	) where++import Propellor.Base hiding (init)+import Prelude hiding (init)+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Cron as Cron+import qualified Propellor.Property.File as File+import Data.List (intercalate)++type Url = String++type ResticParam = String++data ResticRepo+	= Direct FilePath+	| SFTP User HostName FilePath+	| REST Url++instance ConfigurableValue ResticRepo where+	val (Direct fp) = fp+	val (SFTP u h fp) = "sftp:" ++ val u ++ "@" ++ val h ++ ":" ++ fp+	val (REST url) = "rest:" ++ url++installed :: Property DebianLike+installed = withOS desc $ \w o -> case o of+	(Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $+		Apt.installedBackport ["restic"]+	_ -> ensureProperty w $+		Apt.installed ["restic"]+  where+	desc = "installed restic"++repoExists :: ResticRepo -> IO Bool+repoExists repo = boolSystem "restic"+	[ Param "-r"+	, File (val repo)+	, Param "--password-file"+	, File (getPasswordFile repo)+	, Param "snapshots"+	]++passwordFileDir :: FilePath+passwordFileDir = "/etc/restic-keys"++getPasswordFile :: ResticRepo -> FilePath+getPasswordFile repo = passwordFileDir </> File.configFileName (val repo)++passwordFileConfigured :: ResticRepo -> Property (HasInfo + UnixLike)+passwordFileConfigured repo = propertyList "restic password file" $ props+	& File.dirExists passwordFileDir+	& File.mode passwordFileDir 0O2700+	& getPasswordFile repo `File.hasPrivContent` hostContext++-- | Inits a new restic repository+init :: ResticRepo -> Property (HasInfo + DebianLike)+init repo = check (not <$> repoExists repo) (cmdProperty "restic" initargs)+	`requires` installed+	`requires` passwordFileConfigured repo+  where+	initargs =+		[ "-r"+		, val repo+		, "--password-file"+		, getPasswordFile repo+		, "init"+		]++-- | Restores a directory from a restic 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 -> ResticRepo -> Property (HasInfo + DebianLike)+restored dir repo = go+	`requires` init repo+  where+	go :: Property DebianLike+	go = property (dir ++ " restored by restic") $ ifM (liftIO needsRestore)+		( do+			warningMessage $ dir ++ " is empty/missing; restoring from backup ..."+			liftIO restore+		, noChange+		)++	needsRestore = null <$> catchDefaultIO [] (dirContents dir)++	restore = withTmpDirIn (takeDirectory dir) "restic-restore" $ \tmpdir -> do+		ok <- boolSystem "restic"+			[ Param "-r"+			, File (val repo)+			, Param "--password-file"+			, File (getPasswordFile repo)+			, Param "restore"+			, Param "latest"+			, Param "--target"+			, File tmpdir+			]+		let restoreddir = tmpdir ++ "/" ++ dir+		ifM (pure ok <&&> doesDirectoryExist restoreddir)+			( do+				void $ tryIO $ removeDirectory dir+				renameDirectory restoreddir dir+				return MadeChange+			, return FailedChange+			)++-- | Installs a cron job that causes a given directory to be backed+-- up, by running restic 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.+-- For example:+--+-- >	& Restic.backup "/srv/git"+-- >		(Restic.SFTP (User root) (HostName myserver) /mnt/backup/git.restic")+-- >		Cron.Daily+-- >		["--exclude=/srv/git/tobeignored"]+-- >		[Restic.KeepDays 7, Restic.KeepWeeks 4, Restic.KeepMonths 6, Restic.KeepYears 1]+--+-- Since restic uses a fair amount of system resources, only one restic+-- backup job will be run at a time. Other jobs will wait their turns to+-- run.+backup :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)+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 -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)+backup' dir repo crontimes extraargs kp = cronjob+	`describe` desc+	`requires` init repo+  where+	desc = val repo ++ " restic backup"+	cronjob = Cron.niceJob ("restic_backup" ++ dir) crontimes (User "root") "/" $+		"flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd+	lockfile = "/var/lock/propellor-restic.lock"+	backupcmd = intercalate " && " $+		createCommand+		: if null kp then [] else [pruneCommand]+	createCommand = unwords $+		[ "restic"+		, "-r"+		, shellEscape (val repo)+		, "--password-file"+		, shellEscape (getPasswordFile repo)+		]+		++ map shellEscape extraargs +++		[ "backup"+		, shellEscape dir+		]+	pruneCommand = unwords $+		[ "restic"+		, "-r"+		, shellEscape (val repo)+		, "--password-file"+		, shellEscape (getPasswordFile repo)+		, "forget"+		, "--prune"+		]+		+++		map keepParam kp++-- | Constructs a ResticParam 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 restic prune to clean out+-- generations not specified here.+keepParam :: KeepPolicy -> ResticParam+keepParam (KeepLast n) = "--keep-last=" ++ val n+keepParam (KeepHours n) = "--keep-hourly=" ++ val n+keepParam (KeepDays n) = "--keep-daily=" ++ val n+keepParam (KeepWeeks n) = "--keep-weekly=" ++ val n+keepParam (KeepMonths n) = "--keep-monthly=" ++ val n+keepParam (KeepYears n) = "--keep-yearly=" ++ val n++-- | Policy for backup generations to keep. For example, KeepDays 30 will+-- keep the latest backup for each day when a backup was made, and keep the+-- last 30 such backups. When multiple KeepPolicies are combined together,+-- backups meeting any policy are kept. See restic's man page for details.+data KeepPolicy+	= KeepLast Int+	| KeepHours Int+	| KeepDays Int+	| KeepWeeks Int+	| KeepMonths Int+	| KeepYears Int

@@ -98,10 +98,10 @@ import qualified Propellor.Property.Schroot as Schroot import qualified Propellor.Property.Reboot as Reboot import qualified Propellor.Property.User as User- import Utility.FileMode+import Utility.Split+ import Data.List-import Data.List.Utils  type Suite = String 

@@ -22,10 +22,10 @@ import qualified Propellor.Property.Fail2Ban as Fail2Ban import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import Utility.FileMode+import Utility.Split  import Data.List import System.Posix.Files-import Data.String.Utils  scrollBox :: Property (HasInfo + DebianLike) scrollBox = propertyList "scroll server" $ props@@ -681,6 +681,10 @@ 		& File.ownerGroup "/etc/mail/dkim.key" (User "opendkim") (Group "opendkim") 		& "/etc/default/opendkim" `File.containsLine` 			"SOCKET=\"inet:8891@localhost\""+			`onChange` +				(cmdProperty "/lib/opendkim/opendkim.service.generate" []+				`assume` MadeChange)+			`onChange` Service.restarted "opendkim" 		& "/etc/opendkim.conf" `File.containsLines` 			[ "KeyFile /etc/mail/dkim.key" 			, "SubDomains yes"@@ -694,9 +698,22 @@ domainKey :: (BindDomain, Record) domainKey = (RelDomain "mail._domainkey", TXT "v=DKIM1; k=rsa; p=MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQCc+/rfzNdt5DseBBmfB3C6sVM7FgVvf4h1FeCfyfwPpVcmPdW6M2I+NtJsbRkNbEICxiP6QY2UM0uoo9TmPqLgiCCG2vtuiG6XMsS0Y/gGwqKM7ntg/7vT1Go9vcquOFFuLa5PnzpVf8hB9+PMFdS4NPTvWL2c5xxshl/RJzICnQIDAQAB") -hasJoeyCAChain :: Property (HasInfo + UnixLike)-hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`-	Context "joeyca.pem"+postfixSaslPasswordClient :: Property (HasInfo + DebianLike)+postfixSaslPasswordClient = combineProperties "postfix uses SASL password to authenticate with smarthost" $ props+	& Postfix.satellite+	& Postfix.mappedFile "/etc/postfix/sasl_passwd" +		(`File.hasPrivContent` (Context "kitenet.net"))+	& Postfix.mainCfFile `File.containsLines`+		[ "# TLS setup for SASL auth to kite"+		, "smtp_sasl_auth_enable = yes"+		, "smtp_tls_security_level = encrypt"+		, "smtp_sasl_tls_security_options = noanonymous"+		, "relayhost = [kitenet.net]"+		, "smtp_sasl_password_maps = hash:/etc/postfix/sasl_passwd"+		, "# kite's fingerprint"+		, "smtp_tls_fingerprint_cert_match = 13:B0:0C:F3:11:83:A5:EB:A9:37:C6:C5:ED:16:60:86"+		]+		`onChange` Postfix.reloaded  hasPostfixCert :: Context -> Property (HasInfo + UnixLike) hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props

@@ -55,9 +55,9 @@ import qualified Propellor.Property.File as File import Propellor.Property.Systemd.Core import Utility.FileMode+import Utility.Split  import Data.List-import Data.List.Utils import qualified Data.Map as M  type ServiceName = String

@@ -5,7 +5,8 @@ module Propellor.Property.ZFS.Process where  import Propellor.Base-import Data.String.Utils (split)+import Utility.Split+ import Data.List  -- | Gets the properties of a ZFS volume.

@@ -6,7 +6,7 @@  import System.PosixCompat import Data.Time.Clock.POSIX-import qualified Data.Hash.MD5 as MD5+import Data.Hashable  -- Parameters can be passed to both ssh and scp, to enable a ssh connection -- caching socket.@@ -50,24 +50,22 @@ -- 100 bytes. Try to never construct a filename longer than that. -- -- When space allows, include the full hostname in the socket filename.--- Otherwise, include at least a partial md5sum of it,--- to avoid using the same socket file for multiple hosts.+-- Otherwise, a checksum of the hostname is included in the name, to+-- avoid using the same socket file for multiple hosts. socketFile :: FilePath -> HostName -> FilePath socketFile home hn = selectSocketFile-	[  sshdir </> hn ++ ".sock"+	[ sshdir </> hn ++ ".sock" 	, sshdir </> hn-	, sshdir </> take 10 hn ++ "-" ++ md5-	, sshdir </> md5-	, home </> ".propellor-" ++ md5+	, sshdir </> take 10 hn ++ "-" ++ checksum+	, sshdir </> checksum 	]-	(".propellor-" ++ md5)+	(home </> ".propellor-" ++ checksum)   where 	sshdir = home </> ".ssh" </> "propellor"-	md5 = take 9 $ MD5.md5s $ MD5.Str hn+	checksum = take 9 $ show $ abs $ hash hn  selectSocketFile :: [FilePath] -> FilePath -> FilePath selectSocketFile [] d = d-selectSocketFile [f] _ = f selectSocketFile (f:fs) d 	| valid_unix_socket_path f = f 	| otherwise = selectSocketFile fs d

@@ -6,12 +6,12 @@ import Propellor.Types.Empty import Propellor.Types.Info import Propellor.Types.ConfigurableValue+import Utility.Split  import Data.Word import qualified Data.Map as M import qualified Data.Set as S import Data.List-import Data.String.Utils (split, replace) import Data.Monoid import Prelude @@ -102,14 +102,14 @@ type ReverseIP = String  reverseIP :: IPAddr -> ReverseIP-reverseIP (IPv4 addr) = intercalate "." (reverse $ split "." addr) ++ ".in-addr.arpa"+reverseIP (IPv4 addr) = intercalate "." (reverse $ splitc '.' addr) ++ ".in-addr.arpa" reverseIP addr@(IPv6 _) = reverse (intersperse '.' $ replace ":" "" $ val $ canonicalIP addr) ++ ".ip6.arpa"  -- | Converts an IP address (particularly IPv6) to canonical, fully -- expanded form. canonicalIP :: IPAddr -> IPAddr canonicalIP (IPv4 addr) = IPv4 addr-canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":" $ replaceImplicitGroups addr+canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ splitc ':' $ replaceImplicitGroups addr   where 	canonicalGroup g 		| l <= 4    = replicate (4 - l) '0' ++ g@@ -117,7 +117,7 @@ 	  where 		l = length g 	emptyGroups n = iterate (++ ":") "" !! n-	numberOfImplicitGroups a = 8 - length (split ":" $ replace "::" "" a)+	numberOfImplicitGroups a = 8 - length (splitc ':' $ replace "::" "" a) 	replaceImplicitGroups a = concat $ aux $ split "::" a 	  where 		aux [] = []

@@ -7,10 +7,10 @@ module Propellor.Types.ZFS where  import Propellor.Types.ConfigurableValue+import Utility.Split  import Data.String import qualified Data.Set as Set-import qualified Data.String.Utils as SU import Data.List  -- | A single ZFS filesystem.@@ -46,7 +46,7 @@ 	show = val  instance IsString ZDataset where-	fromString s = ZDataset $ SU.split "/" s+	fromString s = ZDataset $ splitc '/' s  instance IsString ZPool where 	fromString p = ZPool p

@@ -45,6 +45,7 @@ 	ByteSize,  	roughSize,+	roughSize', 	compareSizes, 	readSize ) where@@ -109,7 +110,10 @@  {- approximate display of a particular number of bytes -} roughSize :: [Unit] -> Bool -> ByteSize -> String-roughSize units short i+roughSize units short i = roughSize' units short 2 i++roughSize' :: [Unit] -> Bool -> Int -> ByteSize -> String+roughSize' units short precision i 	| i < 0 = '-' : findUnit units' (negate i) 	| otherwise = findUnit units' i   where@@ -123,7 +127,7 @@ 	showUnit x (Unit size abbrev name) = s ++ " " ++ unit 	  where 		v = (fromInteger x :: Double) / fromInteger size-		s = showImprecise 2 v+		s = showImprecise precision v 		unit 			| short = abbrev 			| s == "1" = name

@@ -1,6 +1,6 @@ {- File mode utilities.  -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -130,6 +130,21 @@ withUmask _ a = a #endif +getUmask :: IO FileMode+#ifndef mingw32_HOST_OS+getUmask = bracket setup cleanup return+  where+	setup = setFileCreationMask nullFileMode+	cleanup = setFileCreationMask+#else+getUmask = return nullFileMode+#endif++defaultFileMode :: IO FileMode+defaultFileMode = do+	umask <- getUmask+	return $ intersectFileModes (complement umask) stdFileMode+ combineModes :: [FileMode] -> FileMode combineModes [] = 0 combineModes [m] = m@@ -162,7 +177,10 @@ 	(\h -> hPutStr h content)  writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()-writeFileProtected' file writer = withUmask 0o0077 $+writeFileProtected' file writer = protectedOutput $ 	withFile file WriteMode $ \h -> do 		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes 		writer h++protectedOutput :: IO a -> IO a+protectedOutput = withUmask 0o0077

@@ -10,8 +10,8 @@  module Utility.FileSystemEncoding ( 	useFileSystemEncoding,+	fileEncoding, 	withFilePath,-	md5FilePath, 	decodeBS, 	encodeBS, 	decodeW8,@@ -19,6 +19,10 @@ 	encodeW8NUL, 	decodeW8NUL, 	truncateFilePath,+	s2w8,+	w82s,+	c2w8,+	w82c, ) where  import qualified GHC.Foreign as GHC@@ -26,17 +30,15 @@ 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 Data.List-import Data.List.Utils import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS import qualified Data.ByteString.Lazy.UTF8 as L8 #endif  import Utility.Exception+import Utility.Split  {- Makes all subsequent Handles that are opened, as well as stdio Handles,  - use the filesystem encoding, instead of the encoding of the current@@ -63,6 +65,13 @@ 	hSetEncoding stderr e 	Encoding.setLocaleEncoding e	 +fileEncoding :: Handle -> IO ()+#ifndef mingw32_HOST_OS+fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding+#else+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@@ -93,10 +102,6 @@ 	GHC.withCString enc fp (GHC.peekCString Encoding.char8) 		`catchNonAsync` (\_ -> return fp) -{- 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@@ -137,14 +142,26 @@  {- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -} encodeW8NUL :: [Word8] -> FilePath-encodeW8NUL = intercalate nul . map encodeW8 . split (s2w8 nul)+encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)   where-	nul = ['\NUL']+	nul = '\NUL'  decodeW8NUL :: FilePath -> [Word8]-decodeW8NUL = intercalate (s2w8 nul) . map decodeW8 . split nul+decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul   where-	nul = ['\NUL']+	nul = '\NUL'++c2w8 :: Char -> Word8+c2w8 = fromIntegral . fromEnum++w82c :: Word8 -> Char+w82c = toEnum . fromIntegral++s2w8 :: String -> [Word8]+s2w8 = map c2w8++w82s :: [Word8] -> String+w82s = map w82c  {- Truncates a FilePath to the given number of bytes (or less),  - as represented on disk.

@@ -12,10 +12,10 @@ import Utility.Process import Utility.Monad import Utility.Path+import Utility.Split  import Data.Maybe import System.FilePath-import Data.List.Utils import System.Posix.Files import Data.Char import Control.Monad.IfElse

@@ -2,7 +2,7 @@  - bugs.  -  - This exports functions that conflict with the prelude, which avoids- - them being accidentially used.+ - them being accidentally used.  -}  {-# OPTIONS_GHC -fno-warn-tabs #-}

@@ -10,7 +10,6 @@  module Utility.Path where -import Data.String.Utils import System.FilePath import Data.List import Data.Maybe@@ -25,10 +24,10 @@ import Utility.Exception #endif -import qualified "MissingH" System.Path as MissingH import Utility.Monad import Utility.UserInfo import Utility.Directory+import Utility.Split  {- Simplifies a path, removing any "." component, collapsing "dir/..",   - and removing the trailing path separator.@@ -68,18 +67,6 @@ absPathFrom :: FilePath -> FilePath -> FilePath absPathFrom dir path = simplifyPath (combine dir path) -{- On Windows, this converts the paths to unix-style, in order to run- - MissingH's absNormPath on them. -}-absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath-#ifndef mingw32_HOST_OS-absNormPathUnix dir path = MissingH.absNormPath dir path-#else-absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos path)-  where-	fromdos = replace "\\" "/"-	todos = replace "/" "\\"-#endif- {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -} parentDir :: FilePath -> FilePath parentDir = takeDirectory . dropTrailingPathSeparator@@ -89,12 +76,13 @@ upFrom :: FilePath -> Maybe FilePath upFrom dir 	| length dirs < 2 = Nothing-	| otherwise = Just $ joinDrive drive (intercalate s $ init dirs)+	| otherwise = Just $ joinDrive drive $ intercalate s $ init dirs   where-	-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""+	-- on Unix, the drive will be "/" when the dir is absolute,+	-- otherwise "" 	(drive, path) = splitDrive dir-	dirs = filter (not . null) $ split s path 	s = [pathSeparator]+	dirs = filter (not . null) $ split s path  prop_upFrom_basics :: FilePath -> Bool prop_upFrom_basics dir@@ -149,11 +137,11 @@ relPathDirToFileAbs :: FilePath -> FilePath -> FilePath relPathDirToFileAbs from to 	| takeDrive from /= takeDrive to = to-	| otherwise = intercalate s $ dotdots ++ uncommon+	| otherwise = joinPath $ dotdots ++ uncommon   where-	s = [pathSeparator]-	pfrom = split s from-	pto = split s to+	pfrom = sp from+	pto = sp to+	sp = map dropTrailingPathSeparator . splitPath 	common = map fst $ takeWhile same $ zip pfrom pto 	same (c,d) = c == d 	uncommon = drop numcommon pto@@ -227,6 +215,8 @@  -  - The command may be fully qualified already, in which case it will  - be returned if it exists.+ -+ - Note that this will find commands in PATH that are not executable.  -} searchPath :: String -> IO (Maybe FilePath) searchPath command

@@ -174,22 +174,21 @@ -- returns a transcript combining its stdout and stderr, and -- whether it succeeded or failed. processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)-processTranscript = processTranscript' id+processTranscript cmd opts = processTranscript' (proc cmd opts) -processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)-processTranscript' modproc cmd opts input = do+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)+processTranscript' cp input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order  - the process writes them. -} 	(readf, writef) <- System.Posix.IO.createPipe 	readh <- System.Posix.IO.fdToHandle readf 	writeh <- System.Posix.IO.fdToHandle writef-	p@(_, _, _, pid) <- createProcess $ modproc $-		(proc cmd opts)-			{ std_in = if isJust input then CreatePipe else Inherit-			, std_out = UseHandle writeh-			, std_err = UseHandle writeh-			}+	p@(_, _, _, pid) <- createProcess $ cp+		{ std_in = if isJust input then CreatePipe else Inherit+		, std_out = UseHandle writeh+		, std_err = UseHandle writeh+		} 	hClose writeh  	get <- mkreader readh@@ -200,12 +199,11 @@ 	return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -}-	p@(_, _, _, pid) <- createProcess $ modproc $-		(proc cmd opts)-			{ std_in = if isJust input then CreatePipe else Inherit-			, std_out = CreatePipe-			, std_err = CreatePipe-			}+	p@(_, _, _, pid) <- createProcess $ cp+		{ std_in = if isJust input then CreatePipe else Inherit+		, std_out = CreatePipe+		, std_err = CreatePipe+		}  	getout <- mkreader (stdoutHandle p) 	geterr <- mkreader (stderrHandle p)

@@ -11,7 +11,7 @@  import System.Exit import Utility.Process-import Data.String.Utils+import Utility.Split import System.FilePath import Data.Char import Data.List@@ -86,7 +86,7 @@ shellEscape f = "'" ++ escaped ++ "'"   where 	-- replace ' with '"'"'-	escaped = intercalate "'\"'\"'" $ split "'" f+	escaped = intercalate "'\"'\"'" $ splitc '\'' f  -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String]

@@ -29,6 +29,7 @@ import Utility.Data import Utility.PartialPrelude import Utility.Misc+import Utility.Tuple  import Data.List import Data.Time.Clock@@ -37,7 +38,6 @@ import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate import Data.Time.Format ()-import Data.Tuple.Utils import Data.Char import Control.Applicative import Prelude

@@ -0,0 +1,30 @@+{- split utility functions+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Split where++import Data.List (intercalate)+import Data.List.Split (splitOn)++-- | same as Data.List.Utils.split+--+-- intercalate x . splitOn x === id+split :: Eq a => [a] -> [a] -> [[a]]+split = splitOn++-- | Split on a single character. This is over twice as fast as using+-- split on a list of length 1, while producing identical results. -}+splitc :: Eq c => c -> [c] -> [[c]]+splitc c s = case break (== c) s of+	(i, _c:rest) -> i : splitc c rest+	(i, []) -> i : []++-- | same as Data.List.Utils.replace+replace :: Eq a => [a] -> [a] -> [a] -> [a] +replace old new = intercalate new . split old

@@ -0,0 +1,17 @@+{- tuple utility functions+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++module Utility.Tuple where++fst3 :: (a,b,c) -> a+fst3 (a,_,_) = a++snd3 :: (a,b,c) -> b+snd3 (_,b,_) = b++thd3 :: (a,b,c) -> c+thd3 (_,_,c) = c