Merge remote-tracking branch 'origin' into joeyconfig

2 files changed, 35 insertions, 8 deletions

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/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