summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Fstab.hs
diff options
context:
space:
mode:
authorDaniel Brooks2017-04-04 23:32:57 -0700
committerDaniel Brooks2017-04-04 23:32:57 -0700
commitbaf65fa9fff4b8451ba7f1ee129484723a8deb9b (patch)
tree7f818c5e654da479a5b73fc0a07900cae39a74df /src/Propellor/Property/Fstab.hs
parent4031b974e8035a74f582aa95780c5d3413032625 (diff)
break Fstab.mounted into smaller pieces which can be composed
Diffstat (limited to 'src/Propellor/Property/Fstab.hs')
-rw-r--r--src/Propellor/Property/Fstab.hs52
1 files changed, 36 insertions, 16 deletions
diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
index 602276ea..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,20 +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) $
- if fs == "swap"
- then cmdProperty "swapon" [mnt]
- else cmdProperty "mount" [mnt]
+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
@@ -79,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
]