summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2017-04-06 19:40:00 -0400
committerJoey Hess2017-04-06 19:40:00 -0400
commitf07d53694fb9a1636dc33586d3d474d8c252e497 (patch)
tree0bef514f2b862be255c4cd7d895d465fa68996d6
parentabc6a32c938c9b241428ca749b2dd2b39b9f7cc0 (diff)
parentbaf65fa9fff4b8451ba7f1ee129484723a8deb9b (diff)
Merge remote-tracking branch 'db48x/fstab-swap'
-rw-r--r--src/Propellor/Property/Fstab.hs48
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
]