summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog1
-rw-r--r--doc/forum/newbie_trying_to_set_up_NFS_mount/comment_4_09850c15b6ac6849be035956dbb46f44._comment17
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/DiskImage.hs1
-rw-r--r--src/Propellor/Property/Fstab.hs111
-rw-r--r--src/Propellor/Property/Mount.hs84
6 files changed, 138 insertions, 77 deletions
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 <id@joeyh.name> 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 </etc/fstab> 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 </etc/fstab> 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 = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
+ 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 </etc/fstab> 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 </etc/fstab>.
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 </etc/fstab> 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 = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
- 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 </etc/fstab> 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"]