diff options
Diffstat (limited to 'src/Propellor/Property/Parted.hs')
| -rw-r--r-- | src/Propellor/Property/Parted.hs | 198 |
1 files changed, 78 insertions, 120 deletions
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index f7ac379f..970f5b9a 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} module Propellor.Property.Parted ( + -- * Types TableType(..), PartTable(..), partTableSize, @@ -15,137 +16,30 @@ module Propellor.Property.Parted ( Partition.MkfsOpts, PartType(..), PartFlag(..), - Eep(..), + -- * Properties partitioned, parted, + Eep(..), installed, + -- * PartSpec combinators + calcPartTable, + DiskSize(..), + DiskPart, + module Propellor.Types.PartSpec, + DiskSpaceUse(..), + useDiskSpace, ) where import Propellor.Base +import Propellor.Property.Parted.Types import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Pacman as Pacman import qualified Propellor.Property.Partition as Partition +import Propellor.Types.PartSpec import Utility.DataUnits -import Data.Char -import System.Posix.Files - -class PartedVal a where - pval :: a -> String - --- | Types of partition tables supported by parted. -data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN - deriving (Show) - -instance PartedVal TableType where - pval = map toLower . show - --- | A disk's partition table. -data PartTable = PartTable TableType [Partition] - deriving (Show) - -instance Monoid PartTable where - -- | default TableType is MSDOS - mempty = PartTable MSDOS [] - -- | uses the TableType of the second parameter - mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2) - --- | Gets the total size of the disk specified by the partition table. -partTableSize :: PartTable -> ByteSize -partTableSize (PartTable _ ps) = fromPartSize $ - -- add 1 megabyte to hold the partition table itself - mconcat (MegaBytes 1 : map partSize ps) - --- | A partition on the disk. -data Partition = Partition - { partType :: PartType - , partSize :: PartSize - , partFs :: Partition.Fs - , partMkFsOpts :: Partition.MkfsOpts - , partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default) - , partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC) - } - deriving (Show) - --- | Makes a Partition with defaults for non-important values. -mkPartition :: Partition.Fs -> PartSize -> Partition -mkPartition fs sz = Partition - { partType = Primary - , partSize = sz - , partFs = fs - , partMkFsOpts = [] - , partFlags = [] - , partName = Nothing - } - --- | Type of a partition. -data PartType = Primary | Logical | Extended - deriving (Show) - -instance PartedVal PartType where - pval Primary = "primary" - pval Logical = "logical" - pval Extended = "extended" - --- | All partition sizing is done in megabytes, so that parted can --- automatically lay out the partitions. --- --- Note that these are SI megabytes, not mebibytes. -newtype PartSize = MegaBytes Integer - deriving (Show) - -instance PartedVal PartSize where - pval (MegaBytes n) - | n > 0 = val n ++ "MB" - -- parted can't make partitions smaller than 1MB; - -- avoid failure in edge cases - | otherwise = "1MB" - --- | Rounds up to the nearest MegaByte. -toPartSize :: ByteSize -> PartSize -toPartSize b = MegaBytes $ ceiling (fromInteger b / 1000000 :: Double) -fromPartSize :: PartSize -> ByteSize -fromPartSize (MegaBytes b) = b * 1000000 - -instance Monoid PartSize where - mempty = MegaBytes 0 - mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b) - -reducePartSize :: PartSize -> PartSize -> PartSize -reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b) - --- | Flags that can be set on a partition. -data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag - deriving (Show) - -instance PartedVal PartFlag where - pval BootFlag = "boot" - pval RootFlag = "root" - pval SwapFlag = "swap" - pval HiddenFlag = "hidden" - pval RaidFlag = "raid" - pval LvmFlag = "lvm" - pval LbaFlag = "lba" - pval LegacyBootFlag = "legacy_boot" - pval IrstFlag = "irst" - pval EspFlag = "esp" - pval PaloFlag = "palo" - -instance PartedVal Bool where - pval True = "on" - pval False = "off" - -instance PartedVal Partition.Fs where - pval Partition.EXT2 = "ext2" - pval Partition.EXT3 = "ext3" - pval Partition.EXT4 = "ext4" - pval Partition.BTRFS = "btrfs" - pval Partition.REISERFS = "reiserfs" - pval Partition.XFS = "xfs" - pval Partition.FAT = "fat" - pval Partition.VFAT = "vfat" - pval Partition.NTFS = "ntfs" - pval Partition.LinuxSwap = "linux-swap" +import System.Posix.Files +import Data.List (genericLength) data Eep = YesReallyDeleteDiskContents @@ -202,3 +96,67 @@ parted YesReallyDeleteDiskContents disk ps = p `requires` installed -- | Gets parted installed. installed :: Property (DebianLike + ArchLinux) installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"] + +-- | Gets the total size of the disk specified by the partition table. +partTableSize :: PartTable -> ByteSize +partTableSize (PartTable _ ps) = fromPartSize $ + mconcat (partitionTableOverhead : map partSize ps) + +-- | Some disk is used to store the partition table itself. Assume less +-- than 1 mb. +partitionTableOverhead :: PartSize +partitionTableOverhead = MegaBytes 1 + +-- | Calculate a partition table, for a given size of disk. +-- +-- For example: +-- +-- > calcPartTable (1024 * 1024 * 1024 * 100) MSDOS +-- > [ partition EXT2 `mountedAt` "/boot" +-- > `setSize` MegaBytes 256 +-- > `setFlag` BootFlag +-- > , partition EXT4 `mountedAt` "/" +-- > `useDisk` RemainingSpace +-- > ] +calcPartTable :: DiskSize -> TableType -> [PartSpec DiskPart] -> PartTable +calcPartTable (DiskSize disksize) tt l = PartTable tt (map go l) + where + go (_, _, mkpart, FixedDiskPart) = mkpart defSz + go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ toPartSize $ + diskremainingafterfixed * fromIntegral p `div` 100 + go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ toPartSize $ + diskremaining `div` genericLength (filter isremainingspace l) + diskremainingafterfixed = + disksize - sumsizes (filter isfixed l) + diskremaining = + disksize - sumsizes (filter (not . isremainingspace) l) + sumsizes = sum . map fromPartSize . (partitionTableOverhead :) . + map (partSize . go) + isfixed (_, _, _, FixedDiskPart) = True + isfixed _ = False + isremainingspace (_, _, _, DynamicDiskPart RemainingSpace) = True + isremainingspace _ = False + +-- | Size of a disk, in bytes. +newtype DiskSize = DiskSize ByteSize + deriving (Show) + +data DiskPart = FixedDiskPart | DynamicDiskPart DiskSpaceUse + +data DiskSpaceUse = Percent Int | RemainingSpace + +instance Monoid DiskPart + where + mempty = FixedDiskPart + mappend FixedDiskPart FixedDiskPart = FixedDiskPart + mappend (DynamicDiskPart (Percent a)) (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent (a + b)) + mappend (DynamicDiskPart RemainingSpace) (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace + mappend (DynamicDiskPart (Percent a)) _ = DynamicDiskPart (Percent a) + mappend _ (DynamicDiskPart (Percent b)) = DynamicDiskPart (Percent b) + mappend (DynamicDiskPart RemainingSpace) _ = DynamicDiskPart RemainingSpace + mappend _ (DynamicDiskPart RemainingSpace) = DynamicDiskPart RemainingSpace + +-- | Make a partition use some percentage of the size of the disk +-- (less all fixed size partitions), or the remaining space in the disk. +useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart +useDiskSpace (mp, o, p, _) diskuse = (mp, o, p, DynamicDiskPart diskuse) |