From e9fdfd5de1546f880d3bc8868a235a68f5f01e54 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 23 Oct 2015 15:14:00 -0400 Subject: allow specifying filesystem mount options --- src/Propellor/Property/DiskImage/PartSpec.hs | 40 +++++++++++++++++++--------- 1 file changed, 28 insertions(+), 12 deletions(-) (limited to 'src/Propellor/Property/DiskImage') diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs index 1bd4fb01..4b05df03 100644 --- a/src/Propellor/Property/DiskImage/PartSpec.hs +++ b/src/Propellor/Property/DiskImage/PartSpec.hs @@ -14,44 +14,60 @@ import Propellor.Base import Propellor.Property.Parted import Propellor.Property.Mount --- | Specifies a mount point and a constructor for a Partition. +-- | Specifies a mount point, mount options, and a constructor for a Partition. -- -- The size that is eventually provided is the amount of space needed to -- hold the files that appear in the directory where the partition is to be -- mounted. Plus a fudge factor, since filesystems have some space -- overhead. --- --- (Partitions that are not to be mounted (ie, LinuxSwap), or that have --- no corresponding directory in the chroot will have 128 MegaBytes --- provided as a default size.) -type PartSpec = (Maybe MountPoint, PartSize -> Partition) +type PartSpec = (Maybe MountPoint, MountOpts, PartSize -> Partition) +-- | Partitions that are not to be mounted (ie, LinuxSwap), or that have +-- no corresponding directory in the chroot will have 128 MegaBytes +-- provided as a default size. defSz :: PartSize defSz = MegaBytes 128 +-- | Add 2% for filesystem overhead. Rationalle for picking 2%: +-- A filesystem with 1% overhead might just sneak by as acceptable. +-- Double that just in case. Add an additional 3 mb to deal with +-- non-scaling overhead of filesystems (eg, superblocks). +-- Add an additional 200 mb for temp files, journals, etc. +fudge :: PartSize -> PartSize +fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200) + -- | Specifies a swap partition of a given size. swapPartition :: PartSize -> PartSpec -swapPartition sz = (Nothing, const (mkPartition LinuxSwap sz)) +swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz)) -- | Specifies a partition with a given filesystem. -- -- The partition is not mounted anywhere by default; use the combinators -- below to configure it. partition :: Fs -> PartSpec -partition fs = (Nothing, mkPartition fs) +partition fs = (Nothing, mempty, mkPartition fs) -- | Specifies where to mount a partition. mountedAt :: PartSpec -> FilePath -> PartSpec -mountedAt (_, p) mp = (Just mp, p) +mountedAt (_, o, p) mp = (Just mp, o, p) + +-- | Specifies a mount option, such as "noexec" +mountOpt :: ToMountOpts o => PartSpec -> o -> PartSpec +mountOpt (mp, o, p) o' = (mp, o <> toMountOpts o', p) + +-- | Mount option to make a partition be remounted readonly when there's an +-- error accessing it. +errorReadonly :: MountOpts +errorReadonly = toMountOpts "errors=remount-ro" -- | Adds additional free space to the partition. addFreeSpace :: PartSpec -> PartSize -> PartSpec -addFreeSpace (mp, p) freesz = (mp, \sz -> p (sz <> freesz)) +addFreeSpace (mp, o, p) freesz = (mp, o, \sz -> p (sz <> freesz)) -- | Forced a partition to be a specific size, instead of scaling to the -- size needed for the files in the chroot. setSize :: PartSpec -> PartSize -> PartSpec -setSize (mp, p) sz = (mp, const (p sz)) +setSize (mp, o, p) sz = (mp, o, const (p sz)) -- | Sets a flag on the partition. setFlag :: PartSpec -> PartFlag -> PartSpec @@ -62,4 +78,4 @@ extended :: PartSpec -> PartSpec extended s = adjustp s $ \p -> p { partType = Extended } adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec -adjustp (mp, p) f = (mp, f . p) +adjustp (mp, o, p) f = (mp, o, f . p) -- cgit v1.2.3