From 57525e0d0d1d300aa807f1c876945ee5e38a29df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 6 Apr 2017 20:08:14 -0400 Subject: 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.) --- debian/changelog | 7 +++ ...ent_5_6dc24952c8efa31a401191a8cf2d0b39._comment | 14 ++++++ src/Propellor/Property/Fstab.hs | 52 +++++++++------------- src/Propellor/Property/Mount.hs | 14 ++++++ 4 files changed, 57 insertions(+), 30 deletions(-) create mode 100644 doc/forum/Fstab.mounted_could_call_swapon_when_activating_swap/comment_5_6dc24952c8efa31a401191a8cf2d0b39._comment diff --git a/debian/changelog b/debian/changelog index c3ae1903..dcbe0a3e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +propellor (4.0.3) UNRELEASED; urgency=medium + + * Added Fstab.listed, Fstab.swap, and Mount.swapOn properties. + Thanks, Daniel Brooks. + + -- Joey Hess Thu, 06 Apr 2017 19:40:12 -0400 + propellor (4.0.2) unstable; urgency=medium * Apt.mirror can be used to set the preferred apt mirror of a host, diff --git a/doc/forum/Fstab.mounted_could_call_swapon_when_activating_swap/comment_5_6dc24952c8efa31a401191a8cf2d0b39._comment b/doc/forum/Fstab.mounted_could_call_swapon_when_activating_swap/comment_5_6dc24952c8efa31a401191a8cf2d0b39._comment new file mode 100644 index 00000000..f87500b2 --- /dev/null +++ b/doc/forum/Fstab.mounted_could_call_swapon_when_activating_swap/comment_5_6dc24952c8efa31a401191a8cf2d0b39._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 5""" + date="2017-04-06T23:51:08Z" + content=""" +Merged. Have not tested it either. + +On my Debian system, the swapon command does not support the +`--no-headings` that you used. It's `--noheadings` here. Is that a typo in +your patch? + +I've simply removed that option for now, since it probably won't +hurt if it treats the heading like another device that's swapped on. +"""]] 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 @@ -14,16 +14,6 @@ import Data.Char import Data.List import Utility.Table --- | Ensures that 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 contains a line mounting the specified -- `Source` on the specified `MountPoint`, and that it's currently mounted. -- @@ -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 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 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 . +-- +-- 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 -- cgit v1.2.3