Merge remote-tracking branch 'db48x/fstab-swap'

1 files changed, 35 insertions, 13 deletions

diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
index 60f11d8e..7bf18726 100644
--- a/src/Propellor/Property/Fstab.hs
+++ b/src/Propellor/Property/Fstab.hs
@@ -15,6 +15,17 @@ import Data.List
 import Utility.Table
 
 -- | Ensures that </etc/fstab> contains a line mounting the specified
+-- `Source` on the specified `MountPoint`.
+listed :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux
+listed fs src mnt opts = tightenTargets $
+	"/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 mounting the specified
 -- `Source` on the specified `MountPoint`, and that it's currently mounted.
 --
 -- For example:
@@ -24,18 +35,29 @@ 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")
-		`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) $
+mounted fs src mnt opts = (listed fs src mnt opts) `onChange` (mountNow src)
+
+-- | 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)
+
+-- This use of mountPoints, which is linux-only, is why this
+-- property currently only supports linux.
+mountNow :: Source -> RevertableProperty Linux Linux
+mountNow mnt = tightenTargets domount <!> tightenTargets doumount
+  where domount = check (notElem mnt <$> mountPoints) $
 		cmdProperty "mount" [mnt]
+        doumount = check (elem mnt <$> mountPoints) $
+		cmdProperty "umount" [mnt]
+
+swapOn :: Source -> RevertableProperty Linux Linux
+swapOn mnt = tightenTargets doswapon <!> tightenTargets doswapoff
+  where swaps = lines <$> readProcess "swapon" ["--no-headings", "--show=NAME"]
+        doswapon = check (notElem mnt <$> swaps) $
+		cmdProperty "swapon" [mnt]
+        doswapoff = check (elem mnt <$> swaps) $
+		cmdProperty "swapoff" [mnt]
 
 newtype SwapPartition = SwapPartition FilePath
 
@@ -77,8 +99,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
 			]