From d1cbc66cb06482a5cb4168fc44b7e84fd4e8849e Mon Sep 17 00:00:00 2001 From: Daniel Brooks Date: Tue, 4 Apr 2017 13:56:03 -0700 Subject: property 'mount' a swap partition in Fstab.mounted --- src/Propellor/Property/Fstab.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs index 60f11d8e..602276ea 100644 --- a/src/Propellor/Property/Fstab.hs +++ b/src/Propellor/Property/Fstab.hs @@ -35,7 +35,9 @@ mounted fs src mnt opts = tightenTargets $ -- This use of mountPoints, which is linux-only, is why this -- property currently only supports linux. mountnow = check (notElem mnt <$> mountPoints) $ - cmdProperty "mount" [mnt] + if fs == "swap" + then cmdProperty "swapon" [mnt] + else cmdProperty "mount" [mnt] newtype SwapPartition = SwapPartition FilePath -- cgit v1.2.3 From baf65fa9fff4b8451ba7f1ee129484723a8deb9b Mon Sep 17 00:00:00 2001 From: Daniel Brooks Date: Tue, 4 Apr 2017 23:32:57 -0700 Subject: break Fstab.mounted into smaller pieces which can be composed --- src/Propellor/Property/Fstab.hs | 52 ++++++++++++++++++++++++++++------------- 1 file changed, 36 insertions(+), 16 deletions(-) (limited to 'src/Propellor') 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 @@ -14,6 +14,17 @@ 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 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 contains a line mounting the specified -- `Source` on the specified `MountPoint`, and that it's currently mounted. -- @@ -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 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 ] -- cgit v1.2.3 From 544ad71f3fce7d394945b447fcaf938d8067c5b3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 6 Apr 2017 19:43:48 -0400 Subject: listed property should work on !Linux --- src/Propellor/Property/Fstab.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs index 7bf18726..8196377f 100644 --- a/src/Propellor/Property/Fstab.hs +++ b/src/Propellor/Property/Fstab.hs @@ -16,10 +16,9 @@ import Utility.Table -- | Ensures that 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") +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" -- cgit v1.2.3 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 (limited to 'src/Propellor') 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