module Propellor.Property.Parted (
TableType(..),
PartTable(..),
partTableSize,
Partition(..),
mkPartition,
Partition.Fs(..),
PartSize(..),
ByteSize,
toPartSize,
fromPartSize,
reducePartSize,
Partition.MkfsOpts,
PartType(..),
PartFlag(..),
Eep(..),
partitioned,
parted,
installed,
) where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits
import Data.Char
import System.Posix.Files
class PartedVal a where
val :: a -> String
data TableType = MSDOS | GPT | AIX | AMIGA | BSD | DVH | LOOP | MAC | PC98 | SUN
deriving (Show)
instance PartedVal TableType where
val = map toLower . show
data PartTable = PartTable TableType [Partition]
deriving (Show)
instance Monoid PartTable where
mempty = PartTable MSDOS []
mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)
partTableSize :: PartTable -> ByteSize
partTableSize (PartTable _ ps) = fromPartSize $
mconcat (MegaBytes 1 : map partSize ps)
data Partition = Partition
{ partType :: PartType
, partSize :: PartSize
, partFs :: Partition.Fs
, partMkFsOpts :: Partition.MkfsOpts
, partFlags :: [(PartFlag, Bool)]
, partName :: Maybe String
}
deriving (Show)
mkPartition :: Partition.Fs -> PartSize -> Partition
mkPartition fs sz = Partition
{ partType = Primary
, partSize = sz
, partFs = fs
, partMkFsOpts = []
, partFlags = []
, partName = Nothing
}
data PartType = Primary | Logical | Extended
deriving (Show)
instance PartedVal PartType where
val Primary = "primary"
val Logical = "logical"
val Extended = "extended"
newtype PartSize = MegaBytes Integer
deriving (Show)
instance PartedVal PartSize where
val (MegaBytes n)
| n > 0 = show n ++ "MB"
| otherwise = show "1MB"
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)
data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag
deriving (Show)
instance PartedVal PartFlag where
val BootFlag = "boot"
val RootFlag = "root"
val SwapFlag = "swap"
val HiddenFlag = "hidden"
val RaidFlag = "raid"
val LvmFlag = "lvm"
val LbaFlag = "lba"
val LegacyBootFlag = "legacy_boot"
val IrstFlag = "irst"
val EspFlag = "esp"
val PaloFlag = "palo"
instance PartedVal Bool where
val True = "on"
val False = "off"
instance PartedVal Partition.Fs where
val Partition.EXT2 = "ext2"
val Partition.EXT3 = "ext3"
val Partition.EXT4 = "ext4"
val Partition.BTRFS = "btrfs"
val Partition.REISERFS = "reiserfs"
val Partition.XFS = "xfs"
val Partition.FAT = "fat"
val Partition.VFAT = "vfat"
val Partition.NTFS = "ntfs"
val Partition.LinuxSwap = "linux-swap"
data Eep = YesReallyDeleteDiskContents
partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
isdev <- liftIO $ isBlockDevice <$> getFileStatus disk
ensureProperty w $ combineProperties desc $ props
& parted eep disk partedparams
& if isdev
then formatl (map (\n -> disk ++ show n) [1 :: Int ..])
else Partition.kpartx disk (formatl . map Partition.partitionLoopDev)
where
desc = disk ++ " partitioned"
formatl devs = combineProperties desc (toProps $ map format (zip parts devs))
partedparams = concat $ mklabel : mkparts (1 :: Integer) mempty parts []
format (p, dev) = Partition.formatted' (partMkFsOpts p)
Partition.YesReallyFormatPartition (partFs p) dev
mklabel = ["mklabel", val tabletype]
mkflag partnum (f, b) =
[ "set"
, show partnum
, val f
, val b
]
mkpart partnum offset p =
[ "mkpart"
, val (partType p)
, val (partFs p)
, val offset
, val (offset <> partSize p)
] ++ case partName p of
Just n -> ["name", show partnum, n]
Nothing -> []
mkparts partnum offset (p:ps) c =
mkparts (partnum+1) (offset <> partSize p) ps
(c ++ mkpart partnum offset p : map (mkflag partnum) (partFlags p))
mkparts _ _ [] c = c
parted :: Eep -> FilePath -> [String] -> Property DebianLike
parted YesReallyDeleteDiskContents disk ps = p `requires` installed
where
p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
`assume` MadeChange
installed :: Property DebianLike
installed = Apt.installed ["parted"]