Merge branch 'joeyconfig' of ssh://propellor.branchable.com into joeyconfig

20 files changed, 425 insertions, 48 deletions

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 9d2d603d..a3b7f315 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -83,7 +83,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "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 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "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 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "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 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
 		, "haskell-exceptions"
 		, "haskell-stm"
 		, "haskell-text"
+		, "hashell-hashable"
 		]
 
 installGitCommand :: Maybe System -> ShellCommand
@@ -144,7 +147,7 @@ installGitCommand msys = case msys of
 	-- assume a debian derived system when not specified
 	Nothing -> use apt
   where
-	use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
+	use cmds = "if ! git --version >/dev/null 2>&1; then " ++ intercalate " && " cmds ++ "; fi"
 	apt =
 		[ "apt-get update"
 		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index 6ac153cc..43c4eddf 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -2,7 +2,6 @@ module Propellor.Gpg where
 
 import System.IO
 import Data.Maybe
-import Data.List.Utils
 import Control.Monad
 import Control.Applicative
 import Prelude
@@ -18,6 +17,7 @@ import Utility.Misc
 import Utility.Tmp
 import Utility.Env
 import Utility.Directory
+import Utility.Split
 
 type KeyId = String
 
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 94c82c9f..8b2a4e3d 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -50,8 +50,8 @@ import Data.Monoid
 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.Info
 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 @@ changesFile p f = checkResult getstat comparestat p
 -- 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.
 --
diff --git a/src/Propellor/Property/Apt/PPA.hs b/src/Propellor/Property/Apt/PPA.hs
index 346125ff..a8f7db15 100644
--- a/src/Propellor/Property/Apt/PPA.hs
+++ b/src/Propellor/Property/Apt/PPA.hs
@@ -6,10 +6,11 @@ module Propellor.Property.Apt.PPA where
 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
diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs
new file mode 100644
index 00000000..5678a865
--- /dev/null
+++ b/src/Propellor/Property/Bootstrap.hs
@@ -0,0 +1,111 @@
+module Propellor.Property.Bootstrap (RepoSource(..), bootstrappedFrom, clonedFrom) where
+
+import Propellor.Base
+import Propellor.Bootstrap
+import Propellor.Property.Chroot
+
+import Data.List
+import qualified Data.ByteString as B
+
+-- | Where a propellor repository should be bootstrapped from.
+data RepoSource
+	= GitRepoUrl String
+	| GitRepoOutsideChroot
+	-- ^ When used in a chroot, this copies the git repository from
+	-- outside the chroot, including its configuration.
+
+-- | 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.
+--
+-- 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
+  where
+	go :: Property Linux
+	go = property "Propellor bootstrapped" $ do
+		system <- getOS
+		assumeChange $ exposeTrueLocaldir $ const $ 
+			runShellCommand $ buildShellCommand
+				[ "cd " ++ localdir
+				, bootstrapPropellorCommand system
+				]
+
+-- | Clones the propellor repeository into /usr/local/propellor/
+--
+-- If the propellor repo has already been cloned, pulls to get it
+-- up-to-date.
+clonedFrom :: RepoSource -> Property Linux
+clonedFrom reposource = case reposource of
+	GitRepoOutsideChroot -> go `onChange` copygitconfig
+	_ -> go
+  where
+	go :: Property Linux
+	go = property ("Propellor repo cloned from " ++ sourcedesc) $
+		ifM needclone (makeclone, updateclone)
+	
+	makeclone = do
+		let tmpclone = localdir ++ ".tmpclone"
+		system <- getOS
+		assumeChange $ exposeTrueLocaldir $ \sysdir -> do
+			let originloc = case reposource of
+				GitRepoUrl s -> s
+				GitRepoOutsideChroot -> sysdir
+			runShellCommand $ buildShellCommand
+				[ installGitCommand system
+				, "rm -rf " ++ tmpclone
+				, "git clone " ++ shellEscape originloc ++ " " ++ tmpclone
+				, "mkdir -p " ++ localdir
+				-- This is done rather than deleting
+				-- the old localdir, because if it is bound
+				-- mounted from outside the chroot, deleting
+				-- it after unmounting in unshare will remove
+				-- the bind mount outside the unshare.
+				, "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)"
+				, "rm -rf " ++ tmpclone
+				]
+	
+	updateclone = assumeChange $ exposeTrueLocaldir $ const $
+		runShellCommand $ buildShellCommand
+			[ "cd " ++ localdir
+			, "git pull"
+			]
+	
+	-- Copy the git config of the repo outside the chroot into the
+	-- chroot. This way it has the same remote urls, and other git
+	-- configuration.
+	copygitconfig :: Property Linux
+	copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do
+		let gitconfig = localdir <> ".git" <> "config"
+		cfg <- liftIO $ B.readFile gitconfig
+		exposeTrueLocaldir $ const $
+			liftIO $ B.writeFile gitconfig cfg
+		return MadeChange
+
+	needclone = (inChroot <&&> truelocaldirisempty)
+		<||> (liftIO (not <$> doesDirectoryExist localdir))
+	
+	truelocaldirisempty = exposeTrueLocaldir $ const $
+		runShellCommand ("test ! -d " ++ localdir ++ "/.git")
+
+	sourcedesc = case reposource of
+		GitRepoUrl s -> s
+		GitRepoOutsideChroot -> localdir ++ " outside the chroot"
+
+assumeChange :: Propellor Bool -> Propellor Result
+assumeChange a = do
+	ok <- a
+	return (cmdResult ok <> MadeChange)
+
+buildShellCommand :: [String] -> String
+buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")")
+
+runShellCommand :: String -> Propellor Bool
+runShellCommand s = liftIO $ boolSystem "sh" [ Param "-c", Param s]
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 7738d97e..ad2ae705 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Chroot (
 	ChrootTarball(..),
 	noServices,
 	inChroot,
+	exposeTrueLocaldir,
 	-- * Internal use
 	provisioned',
 	propagateChrootInfo,
@@ -32,9 +33,9 @@ import qualified Propellor.Property.File as File
 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
 
@@ -295,6 +296,38 @@ setInChroot h = h { hostInfo = hostInfo h `addInfo` InfoVal (InChroot True) }
 newtype InChroot = InChroot Bool
 	deriving (Typeable, Show)
 
+-- | Runs an action with the true localdir exposed,
+-- not the one bind-mounted into a chroot. The action is passed the
+-- path containing the contents of the localdir outside the chroot.
+--
+-- In a chroot, this is accomplished by temporily bind mounting the localdir
+-- to a temp directory, to preserve access to the original bind mount. Then
+-- we unmount the localdir to expose the true localdir. Finally, to cleanup,
+-- the temp directory is bind mounted back to the localdir.
+exposeTrueLocaldir :: (FilePath -> Propellor a) -> Propellor a
+exposeTrueLocaldir a = ifM inChroot
+	( withTmpDirIn (takeDirectory localdir) "propellor.tmp" $ \tmpdir ->
+		bracket_
+			(movebindmount localdir tmpdir)
+			(movebindmount tmpdir localdir)
+			(a tmpdir)
+	, a localdir
+	)
+  where
+	movebindmount from to = liftIO $ do
+		run "mount" [Param "--bind", File from, File to]
+		-- Have to lazy unmount, because the propellor process
+		-- is running in the localdir that it's unmounting..
+		run "umount" [Param "-l", File from]
+		-- We were in the old localdir; move to the new one after
+		-- flipping the bind mounts. Otherwise, commands that try
+		-- to access the cwd will fail because it got umounted out
+		-- from under.
+		changeWorkingDirectory "/"
+		changeWorkingDirectory localdir
+	run cmd ps = unlessM (boolSystem cmd ps) $
+		error $ "exposeTrueLocaldir failed to run " ++ show (cmd, ps)
+
 -- | Generates a Chroot that has all the properties of a Host.
 -- 
 -- Note that it's possible to create loops using this, where a host
diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs
index 6b84acb5..f2de1a27 100644
--- a/src/Propellor/Property/Cmd.hs
+++ b/src/Propellor/Property/Cmd.hs
@@ -33,6 +33,7 @@ module Propellor.Property.Cmd (
 	Script,
 	scriptProperty,
 	userScriptProperty,
+	cmdResult,
 	-- * Lower-level interface for running commands
 	CommandParam(..),
 	boolSystem,
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 1080418b..d53bab71 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -59,13 +59,13 @@ import qualified Propellor.Property.Pacman as Pacman
 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
 
diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
index 60f11d8e..29b85426 100644
--- a/src/Propellor/Property/Fstab.hs
+++ b/src/Propellor/Property/Fstab.hs
@@ -24,19 +24,32 @@ import Utility.Table
 -- Note that if anything else is already mounted at the `MountPoint`, it
 -- will be left as-is by this property.
 mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux
-mounted fs src mnt opts = tightenTargets $
-	"/etc/fstab" `File.containsLine` l
-		`describe` (mnt ++ " mounted by fstab")
+mounted fs src mnt opts = tightenTargets $ 
+	listed fs src mnt opts
 		`onChange` mountnow
   where
-	l = intercalate "\t" [src, mnt, fs, formatMountOpts opts, dump, passno]
-	dump = "0"
-	passno = "2"
 	-- This use of mountPoints, which is linux-only, is why this
 	-- property currently only supports linux.
 	mountnow = check (notElem mnt <$> mountPoints) $
 		cmdProperty "mount" [mnt]
 
+-- | Ensures that </etc/fstab> contains a line mounting the specified
+-- `Source` on the specified `MountPoint`. Does not ensure that it's
+-- currently `mounted`.
+listed :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
+listed fs src mnt opts = "/etc/fstab" `File.containsLine` l
+	`describe` (mnt ++ " mounted by fstab")
+  where
+	l = intercalate "\t" [src, mnt, fs, formatMountOpts opts, dump, passno]
+	dump = "0"
+	passno = "2"
+
+-- | Ensures that </etc/fstab> contains a line enabling the specified
+-- `Source` to be used as swap space, and that it's enabled.
+swap :: Source -> Property Linux
+swap src = listed "swap" src "none" mempty
+	`onChange` swapOn src
+
 newtype SwapPartition = SwapPartition FilePath
 
 -- | Replaces </etc/fstab> with a file that should cause the currently
@@ -77,8 +90,8 @@ genFstab mnts swaps mnttransform = do
 		, pure "0"
 		, pure (if mnt == "/" then "1" else "2")
 		]
-	getswapcfg (SwapPartition swap) = sequence
-		[ fromMaybe swap <$> getM (\a -> a swap)
+	getswapcfg (SwapPartition s) = sequence
+		[ fromMaybe s <$> getM (\a -> a s)
 			[ uuidprefix getSourceUUID
 			, sourceprefix getSourceLabel
 			]
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index e1342d91..1eb9d690 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -3,9 +3,9 @@ module Propellor.Property.Hostname where
 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.
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index 026509a9..5dcc5fe1 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -40,6 +40,9 @@ formatMountOpts (MountOpts []) = "defaults"
 formatMountOpts (MountOpts l) = intercalate "," l
 
 -- | Mounts a device, without listing it in </etc/fstab>.
+--
+-- Note that this property will fail if the device is already mounted
+-- at the MountPoint.
 mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
 mounted fs src mnt opts = property (mnt ++ " mounted") $ 
 	toResult <$> liftIO (mount fs src mnt opts)
@@ -52,6 +55,17 @@ bindMount src dest = tightenTargets $
 		`assume` MadeChange
 		`describe` ("bind mounted " ++ src ++ " to " ++ dest)
 
+-- | Enables swapping to a device, which must be formatted already as a swap
+-- partition.
+swapOn :: Source -> RevertableProperty Linux Linux
+swapOn mnt = tightenTargets doswapon <!> tightenTargets doswapoff
+  where
+	swaps = lines <$> readProcess "swapon" ["--show=NAME"]
+	doswapon = check (notElem mnt <$> swaps) $
+		cmdProperty "swapon" [mnt]
+	doswapoff = check (elem mnt <$> swaps) $
+		cmdProperty "swapoff" [mnt]
+
 mount :: FsType -> Source -> MountPoint -> MountOpts -> IO Bool
 mount fs src mnt opts = boolSystem "mount" $
 	[ Param "-t", Param fs
diff --git a/src/Propellor/Property/Restic.hs b/src/Propellor/Property/Restic.hs
new file mode 100644
index 00000000..64cd4091
--- /dev/null
+++ b/src/Propellor/Property/Restic.hs
@@ -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
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index 00109381..460d0b16 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -98,10 +98,10 @@ import qualified Propellor.Property.File as File
 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
 
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 28246dfe..9b4a3378 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -22,10 +22,10 @@ import qualified Propellor.Property.Systemd as Systemd
 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
@@ -573,8 +573,8 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
 		, "# Enable postgrey."
 		, "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_sasl_authenticated,,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"
 
-		, "# Enable spamass-milter, amavis-milter, opendkim"
-		, "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock inet:localhost:8891"
+		, "# Enable spamass-milter, amavis-milter (opendkim is not enabled because it causes mails forwarded from eg gmail to be rejected)"
+		, "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"
 		, "# opendkim is used for outgoing mail"
 		, "non_smtpd_milters = inet:localhost:8891"
 		, "milter_connect_macros = j {daemon_name} v {if_name} _"
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 7c40bd16..d1a94aa8 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -55,9 +55,9 @@ import qualified Propellor.Property.Apt as Apt
 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
diff --git a/src/Propellor/Property/ZFS/Process.hs b/src/Propellor/Property/ZFS/Process.hs
index 372bac6d..42b23df2 100644
--- a/src/Propellor/Property/ZFS/Process.hs
+++ b/src/Propellor/Property/ZFS/Process.hs
@@ -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.
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 447f8e9f..3b3729f9 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -87,7 +87,7 @@ spin' mprivdata relay target hst = do
 
 	-- And now we can run it.
 	unlessM (boolSystemNonConcurrent "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
-		error "remote propellor failed"
+		giveup "remote propellor failed"
   where
 	hn = fromMaybe target relay
 	sys = case fromInfo (hostInfo hst) of
diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs
index a7a9452e..a8f50ed0 100644
--- a/src/Propellor/Ssh.hs
+++ b/src/Propellor/Ssh.hs
@@ -6,7 +6,7 @@ import Utility.FileSystemEncoding
 
 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 @@ sshCachingParams hn = do
 -- 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
diff --git a/src/Propellor/Types/Dns.hs b/src/Propellor/Types/Dns.hs
index 8d62e63b..87756d81 100644
--- a/src/Propellor/Types/Dns.hs
+++ b/src/Propellor/Types/Dns.hs
@@ -6,12 +6,12 @@ import Propellor.Types.OS (HostName)
 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 @@ data Record
 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 @@ canonicalIP (IPv6 addr) = IPv6 $ intercalate ":" $ map canonicalGroup $ split ":
 	  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 [] = []
diff --git a/src/Propellor/Types/ZFS.hs b/src/Propellor/Types/ZFS.hs
index 22b848fa..c68f6ba5 100644
--- a/src/Propellor/Types/ZFS.hs
+++ b/src/Propellor/Types/ZFS.hs
@@ -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 @@ instance Show ZDataset where
 	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