summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2017-04-06 20:08:14 -0400
committerJoey Hess2017-04-06 20:16:08 -0400
commit57525e0d0d1d300aa807f1c876945ee5e38a29df (patch)
treed5bd3df239cc9247980d45f9fafb550bd4679643 /src/Propellor/Property
parent544ad71f3fce7d394945b447fcaf938d8067c5b3 (diff)
tweaks to db45x's patch
Removed mountNow as a top-level property, as I don't think it makes sense for anything except for mounted to use it. db45x's patch turns out to have introduced a bug in mounted's use of "mountNow src". That made mountNow check if the device was a mount point, which it isn't. The fix would have been to use "mountNow mnt", but my inlining of mountnow just basically reverted the part of the patch that introduced the bug. swapOn does not involve the fstab so moved to the Mount module. (Also noticed that Mount.mounted is a kind of weird property, given that it fails the next time ran. It's only used internally by some chroot properties, so I left it as-is, but added a comment. It might make sense to make Mount.mounted check like mountNow does if the thing is already mounted.)
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Fstab.hs52
-rw-r--r--src/Propellor/Property/Mount.hs14
2 files changed, 36 insertions, 30 deletions
diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs
index 8196377f..29b85426 100644
--- a/src/Propellor/Property/Fstab.hs
+++ b/src/Propellor/Property/Fstab.hs
@@ -15,16 +15,6 @@ 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 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 mounting the specified
-- `Source` on the specified `MountPoint`, and that it's currently mounted.
--
-- For example:
@@ -34,29 +24,31 @@ listed fs src mnt opts = "/etc/fstab" `File.containsLine` l
-- 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 = (listed fs src mnt opts) `onChange` (mountNow src)
+mounted fs src mnt opts = tightenTargets $
+ listed fs src mnt opts
+ `onChange` mountnow
+ where
+ -- 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
+-- `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]
+swap src = listed "swap" src "none" mempty
+ `onChange` swapOn src
newtype SwapPartition = SwapPartition FilePath
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