From 868e2c473ac43f8e6432b1672f57bbdcb1872174 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Apr 2016 01:03:53 -0400 Subject: Added Propellor.Property.Fstab, and moved the fstabbed property to there. --- debian/changelog | 1 + ...ent_4_09850c15b6ac6849be035956dbb46f44._comment | 17 ++++ propellor.cabal | 1 + src/Propellor/Property/DiskImage.hs | 1 + src/Propellor/Property/Fstab.hs | 111 +++++++++++++++++++++ src/Propellor/Property/Mount.hs | 84 ++-------------- 6 files changed, 138 insertions(+), 77 deletions(-) create mode 100644 doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment create mode 100644 src/Propellor/Property/Fstab.hs diff --git a/debian/changelog b/debian/changelog index 5a73f002..3c3d41ac 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,7 @@ propellor (3.0.2) UNRELEASED; urgency=medium Thanks, Félix Sipma. * Apt.unattendedUpgrades: Enable mailing problems reports to root. Thanks, Félix Sipma. + * Added Propellor.Property.Fstab, and moved the fstabbed property to there. -- Joey Hess Tue, 05 Apr 2016 13:48:47 -0400 diff --git a/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment new file mode 100644 index 00000000..74c959e8 --- /dev/null +++ b/doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 4""" + date="2016-04-07T04:21:39Z" + content=""" +That's quite a nice elegant solution, Frederik! + +It'll work if you use + + `onChange` (cmdProperty "mount" ["-a"] `assume` MadeChange) + +This is ncessary because propellor doesn't know if `cmdProperty` +makes a change or not. In this case we can just assume it did. + +I've added a `Propellor.Property.Fstab.mounted` this evening +that is essentially Frederik's solution. +"""]] diff --git a/propellor.cabal b/propellor.cabal index 322d135e..7f12cbec 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -98,6 +98,7 @@ Library Propellor.Property.FreeBSD Propellor.Property.FreeBSD.Pkg Propellor.Property.FreeBSD.Poudriere + Propellor.Property.Fstab Propellor.Property.Git Propellor.Property.Gpg Propellor.Property.Group diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 718768c2..afeaa287 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -30,6 +30,7 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Propellor.Property.Parted import Propellor.Property.Mount +import Propellor.Property.Fstab (SwapPartition(..), genFstab) import Propellor.Property.Partition import Propellor.Property.Rsync import Propellor.Container diff --git a/src/Propellor/Property/Fstab.hs b/src/Propellor/Property/Fstab.hs new file mode 100644 index 00000000..60f11d8e --- /dev/null +++ b/src/Propellor/Property/Fstab.hs @@ -0,0 +1,111 @@ +module Propellor.Property.Fstab ( + FsType, + Source, + MountPoint, + MountOpts(..), + module Propellor.Property.Fstab, +) where + +import Propellor.Base +import qualified Propellor.Property.File as File +import Propellor.Property.Mount + +import Data.Char +import Data.List +import Utility.Table + +-- | Ensures that contains a line mounting the specified +-- `Source` on the specified `MountPoint`, and that it's currently mounted. +-- +-- For example: +-- +-- > mounted "auto" "/dev/sdb1" "/srv" mempty +-- +-- 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) $ + cmdProperty "mount" [mnt] + +newtype SwapPartition = SwapPartition FilePath + +-- | Replaces with a file that should cause the currently +-- mounted partitions to be re-mounted the same way on boot. +-- +-- For each specified MountPoint, the UUID of each partition +-- (or if there is no UUID, its label), its filesystem type, +-- and its mount options are all automatically probed. +-- +-- The SwapPartitions are also included in the generated fstab. +fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux +fstabbed mnts swaps = property' "fstabbed" $ \o -> do + fstab <- liftIO $ genFstab mnts swaps id + ensureProperty o $ + "/etc/fstab" `File.hasContent` fstab + +genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String] +genFstab mnts swaps mnttransform = do + fstab <- liftIO $ mapM getcfg (sort mnts) + swapfstab <- liftIO $ mapM getswapcfg swaps + return $ header ++ formatTable (legend : fstab ++ swapfstab) + where + header = + [ "# /etc/fstab: static file system information. See fstab(5)" + , "# " + ] + legend = ["# ", "", "", "", "", ""] + getcfg mnt = sequence + [ fromMaybe (error $ "unable to find mount source for " ++ mnt) + <$> getM (\a -> a mnt) + [ uuidprefix getMountUUID + , sourceprefix getMountLabel + , getMountSource + ] + , pure (mnttransform mnt) + , fromMaybe "auto" <$> getFsType mnt + , formatMountOpts <$> getFsMountOpts mnt + , pure "0" + , pure (if mnt == "/" then "1" else "2") + ] + getswapcfg (SwapPartition swap) = sequence + [ fromMaybe swap <$> getM (\a -> a swap) + [ uuidprefix getSourceUUID + , sourceprefix getSourceLabel + ] + , pure "none" + , pure "swap" + , pure (formatMountOpts mempty) + , pure "0" + , pure "0" + ] + prefix s getter m = fmap (s ++) <$> getter m + uuidprefix = prefix "UUID=" + sourceprefix = prefix "LABEL=" + +-- | Checks if is not configured. +-- This is the case if it doesn't exist, or +-- consists entirely of blank lines or comments. +-- +-- So, if you want to only replace the fstab once, and then never touch it +-- again, allowing local modifications: +-- +-- > check noFstab (fstabbed mnts []) +noFstab :: IO Bool +noFstab = ifM (doesFileExist "/etc/fstab") + ( null . filter iscfg . lines <$> readFile "/etc/fstab" + , return True + ) + where + iscfg l + | null l = False + | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 943986c6..bb0f60a7 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -1,14 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-} +-- | Properties in this module ensure that things are currently mounted, +-- but without making the mount persistent. Use `Propellor.Property.Fstab` +-- to configure persistent mounts. + module Propellor.Property.Mount where import Propellor.Base -import qualified Propellor.Property.File as File import Utility.Path -import Data.Char import Data.List -import Utility.Table -- | type of filesystem to mount ("auto" to autodetect) type FsType = String @@ -20,6 +21,8 @@ type Source = String type MountPoint = FilePath -- | Filesystem mount options. Eg, MountOpts ["errors=remount-ro"] +-- +-- For default mount options, use `mempty`. newtype MountOpts = MountOpts [String] deriving Monoid @@ -36,7 +39,7 @@ formatMountOpts :: MountOpts -> String formatMountOpts (MountOpts []) = "defaults" formatMountOpts (MountOpts l) = intercalate "," l --- | Mounts a device. +-- | Mounts a device, without listing it in . mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike mounted fs src mnt opts = property (mnt ++ " mounted") $ toResult <$> liftIO (mount fs src mnt opts) @@ -57,79 +60,6 @@ mount fs src mnt opts = boolSystem "mount" $ , Param mnt ] -newtype SwapPartition = SwapPartition FilePath - --- | Replaces with a file that should cause the currently --- mounted partitions to be re-mounted the same way on boot. --- --- For each specified MountPoint, the UUID of each partition --- (or if there is no UUID, its label), its filesystem type, --- and its mount options are all automatically probed. --- --- The SwapPartitions are also included in the generated fstab. -fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux -fstabbed mnts swaps = property' "fstabbed" $ \o -> do - fstab <- liftIO $ genFstab mnts swaps id - ensureProperty o $ - "/etc/fstab" `File.hasContent` fstab - -genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String] -genFstab mnts swaps mnttransform = do - fstab <- liftIO $ mapM getcfg (sort mnts) - swapfstab <- liftIO $ mapM getswapcfg swaps - return $ header ++ formatTable (legend : fstab ++ swapfstab) - where - header = - [ "# /etc/fstab: static file system information. See fstab(5)" - , "# " - ] - legend = ["# ", "", "", "", "", ""] - getcfg mnt = sequence - [ fromMaybe (error $ "unable to find mount source for " ++ mnt) - <$> getM (\a -> a mnt) - [ uuidprefix getMountUUID - , sourceprefix getMountLabel - , getMountSource - ] - , pure (mnttransform mnt) - , fromMaybe "auto" <$> getFsType mnt - , formatMountOpts <$> getFsMountOpts mnt - , pure "0" - , pure (if mnt == "/" then "1" else "2") - ] - getswapcfg (SwapPartition swap) = sequence - [ fromMaybe swap <$> getM (\a -> a swap) - [ uuidprefix getSourceUUID - , sourceprefix getSourceLabel - ] - , pure "none" - , pure "swap" - , pure (formatMountOpts mempty) - , pure "0" - , pure "0" - ] - prefix s getter m = fmap (s ++) <$> getter m - uuidprefix = prefix "UUID=" - sourceprefix = prefix "LABEL=" - --- | Checks if is not configured. --- This is the case if it doesn't exist, or --- consists entirely of blank lines or comments. --- --- So, if you want to only replace the fstab once, and then never touch it --- again, allowing local modifications: --- --- > check noFstab (fstabbed mnts []) -noFstab :: IO Bool -noFstab = ifM (doesFileExist "/etc/fstab") - ( null . filter iscfg . lines <$> readFile "/etc/fstab" - , return True - ) - where - iscfg l - | null l = False - | otherwise = not $ "#" `isPrefixOf` dropWhile isSpace l - -- | Lists all mount points of the system. mountPoints :: IO [MountPoint] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] -- cgit v1.2.3