summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Parted.hs
diff options
context:
space:
mode:
authorJoey Hess2015-08-25 15:53:00 -0700
committerJoey Hess2015-08-25 15:53:00 -0700
commit5462723243355c387746b10298db747d95e3e2c9 (patch)
treeef3bb13b75d27bd9ff778122741004bf84c4ebec /src/Propellor/Property/Parted.hs
parent324632dd6c849abc992bd05d644ca7c4b305e8e4 (diff)
working on parted
Diffstat (limited to 'src/Propellor/Property/Parted.hs')
-rw-r--r--src/Propellor/Property/Parted.hs129
1 files changed, 129 insertions, 0 deletions
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
new file mode 100644
index 00000000..3a927354
--- /dev/null
+++ b/src/Propellor/Property/Parted.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Propellor.Property.Parted (
+ TableType(..),
+ PartTable(..),
+ PartType(..),
+ FsType,
+ PartFlag(..),
+ Eep(..),
+ partitioned,
+ parted,
+ installed,
+) where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import Utility.DataUnits
+import Data.Char
+
+class PartedVal a where
+ val :: 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
+ val = 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)
+
+-- | A partition on the disk.
+data Partition = Partition
+ { partType :: PartType
+ , partFs :: FsType
+ , partSize :: ByteSize
+ , 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)
+
+-- | Type of a partition.
+data PartType = Primary | Logical | Extended
+ deriving (Show)
+
+instance PartedVal PartType where
+ val Primary = "primary"
+ val Logical = "logical"
+ val Extended = "extended"
+
+-- | Eg, "ext4" or "fat16" or "ntfs" or "hfs+" or "linux-swap"
+type FsType = String
+
+-- | 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
+ 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"
+
+data Eep = YesReallyDeleteDiskContents
+
+-- | Partitions a disk using parted. Does not mkfs filesystems.
+--
+-- The FilePath can be a disk device (eg, /dev/sda), or a disk image file.
+--
+-- This deletes any existing partitions in the disk! Use with EXTREME caution!
+partitioned :: Eep -> FilePath -> PartTable -> Property NoInfo
+partitioned eep disk (PartTable tabletype parts) =
+ parted eep disk (concat (setunits : mklabel : mkparts (1 :: Integer) 0 parts []))
+ `describe` (disk ++ " partitioned")
+ where
+ mklabel = ["mklabel", val tabletype]
+ mkflag partnum (f, b) =
+ [ "set"
+ , show partnum
+ , val f
+ , val b
+ ]
+ setunits = ["unit", "B"]
+ mkpart partnum offset p =
+ [ "mkpart"
+ , show partnum
+ , val (partType p)
+ , partFs p
+ , show offset
+ , show (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
+
+-- | Runs parted on a disk with the specified parameters.
+--
+-- Parted is run in script mode, so it will never prompt for input.
+-- It is asked to use optimal alignment for the disk, for best performance.
+parted :: Eep -> FilePath -> [String] -> Property NoInfo
+parted YesReallyDeleteDiskContents disk ps =
+ cmdProperty "parted" ("--script":"--align":"optimal":disk:ps)
+ `requires` installed
+
+-- | Gets parted installed.
+installed :: Property NoInfo
+installed = Apt.installed ["parted"]