summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/DiskImage.hs6
-rw-r--r--src/Propellor/Property/Parted.hs77
-rw-r--r--src/Propellor/Property/Parted/Types.hs53
3 files changed, 89 insertions, 47 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 6564192f..79865db4 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -265,7 +265,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
imageFinalized final dest mnts mntopts devs parttable
rmimg = undoRevertableProperty (buildDiskImage img)
`before` undoRevertableProperty (imageExists' dest dummyparttable)
- dummyparttable = PartTable tabletype []
+ dummyparttable = PartTable tabletype safeAlignment []
partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike
partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
@@ -300,7 +300,7 @@ fitChrootSize :: TableType -> [PartSpec ()] -> [PartSize] -> ([Maybe MountPoint]
fitChrootSize tt l basesizes = (mounts, mountopts, parttable)
where
(mounts, mountopts, sizers, _) = unzip4 l
- parttable = PartTable tt (zipWith id sizers basesizes)
+ parttable = PartTable tt safeAlignment (zipWith id sizers basesizes)
-- | Generates a map of the sizes of the contents of
-- every directory in a filesystem tree.
@@ -388,7 +388,7 @@ imageExists' dest@(RawDiskImage img) parttable = (setup <!> cleanup) `describe`
type Finalization = (RawDiskImage -> FilePath -> [LoopDev] -> Property Linux)
imageFinalized :: Finalization -> RawDiskImage -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
-imageFinalized final img mnts mntopts devs (PartTable _ parts) =
+imageFinalized final img mnts mntopts devs (PartTable _ _ parts) =
property' "disk image finalized" $ \w ->
withTmpDir "mnt" $ \top ->
go w top `finally` liftIO (unmountall top)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index d60d4a60..8afd62ea 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -13,6 +13,8 @@ module Propellor.Property.Parted (
toPartSize,
fromPartSize,
reducePartSize,
+ Alignment(..),
+ safeAlignment,
Partition.MkfsOpts,
PartType(..),
PartFlag(..),
@@ -50,19 +52,28 @@ data Eep = YesReallyDeleteDiskContents
--
-- This deletes any existing partitions in the disk! Use with EXTREME caution!
partitioned :: Eep -> FilePath -> PartTable -> Property DebianLike
-partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
+partitioned eep disk parttable@(PartTable _ _ parts) = property' desc $ \w -> do
isdev <- liftIO $ isBlockDevice <$> getFileStatus disk
ensureProperty w $ combineProperties desc $ props
- & parted eep disk partedparams
+ & parted eep disk (fst (calcPartedParamsSize parttable))
& 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
+
+-- | Gets the total size of the disk specified by the partition table.
+partTableSize :: PartTable -> ByteSize
+partTableSize = snd . calcPartedParamsSize
+
+calcPartedParamsSize :: PartTable -> ([String], ByteSize)
+calcPartedParamsSize (PartTable tabletype alignment parts) =
+ let (ps, sz) = calcparts (1 :: Integer) firstpos parts []
+ in (concat (mklabel : ps), sz)
+ where
mklabel = ["mklabel", pval tabletype]
mkflag partnum (f, b) =
[ "set"
@@ -70,39 +81,43 @@ partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
, pval f
, pval b
]
- mkpart partnum offset p =
+ mkpart partnum startpos endpos p =
[ "mkpart"
, pval (partType p)
, pval (partFs p)
- , pval offset
- , pval (offset <> partSize p)
+ , partpos startpos
+ , partpos endpos
] ++ 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
+ calcparts partnum startpos (p:ps) c =
+ let endpos = startpos + align (partSize p)
+ in calcparts (partnum+1) endpos ps
+ (c ++ mkpart partnum startpos (endpos-1) p : map (mkflag partnum) (partFlags p))
+ calcparts _ endpos [] c = (c, endpos)
+ partpos n
+ | n > 0 = val n ++ "B"
+ -- parted can't make partitions smaller than 1MB;
+ -- avoid failure in edge cases
+ | otherwise = "1MB"
+ -- Location of the start of the first partition,
+ -- leaving space for the partition table, and aligning.
+ firstpos = align partitionTableOverhead
+ align = alignTo alignment
-- | 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 cylinder alignment for the disk.
parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux)
parted YesReallyDeleteDiskContents disk ps = p `requires` installed
where
- p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
+ p = cmdProperty "parted" ("--script":"--align":"none":disk:ps)
`assume` MadeChange
-- | 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
@@ -112,27 +127,27 @@ partitionTableOverhead = MegaBytes 1
--
-- For example:
--
--- > calcPartTable (DiskSize (1024 * 1024 * 1024 * 100)) MSDOS
+-- > calcPartTable (DiskSize (1024 * 1024 * 1024 * 100)) MSDOS safeAlignment
-- > [ partition EXT2 `mountedAt` "/boot"
-- > `setSize` MegaBytes 256
-- > `setFlag` BootFlag
-- > , partition EXT4 `mountedAt` "/"
--- > `useDisk` RemainingSpace
+-- > `useDiskSpace` RemainingSpace
-- > ]
-calcPartTable :: DiskSize -> TableType -> [PartSpec DiskPart] -> PartTable
-calcPartTable (DiskSize disksize) tt l = PartTable tt (map go l)
+calcPartTable :: DiskSize -> TableType -> Alignment -> [PartSpec DiskPart] -> PartTable
+calcPartTable (DiskSize disksize) tt alignment l =
+ PartTable tt alignment (map go l)
where
go (_, _, mkpart, FixedDiskPart) = mkpart defSz
- go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ toPartSize $
+ go (_, _, mkpart, DynamicDiskPart (Percent p)) = mkpart $ Bytes $
diskremainingafterfixed * fromIntegral p `div` 100
- go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ toPartSize $
+ go (_, _, mkpart, DynamicDiskPart RemainingSpace) = mkpart $ Bytes $
diskremaining `div` genericLength (filter isremainingspace l)
- diskremainingafterfixed =
+ diskremainingafterfixed =
disksize - sumsizes (filter isfixed l)
diskremaining =
disksize - sumsizes (filter (not . isremainingspace) l)
- sumsizes = sum . map fromPartSize . (partitionTableOverhead :) .
- map (partSize . go)
+ sumsizes = partTableSize . PartTable tt alignment . map go
isfixed (_, _, _, FixedDiskPart) = True
isfixed _ = False
isremainingspace (_, _, _, DynamicDiskPart RemainingSpace) = True
@@ -177,3 +192,13 @@ defSz = MegaBytes 128
-- Add an additional 200 mb for temp files, journals, etc.
fudgeSz :: PartSize -> PartSize
fudgeSz (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200)
+
+alignTo :: Alignment -> PartSize -> ByteSize
+alignTo _ (Bytes n) = n -- no alignment done for Bytes
+alignTo (Alignment alignment) partsize
+ | alignment < 1 = n
+ | otherwise = case rem n alignment of
+ 0 -> n
+ r -> n - r + alignment
+ where
+ n = fromPartSize partsize
diff --git a/src/Propellor/Property/Parted/Types.hs b/src/Propellor/Property/Parted/Types.hs
index e32df310..6b6b42e2 100644
--- a/src/Propellor/Property/Parted/Types.hs
+++ b/src/Propellor/Property/Parted/Types.hs
@@ -1,6 +1,5 @@
module Propellor.Property.Parted.Types where
-import Propellor.Base
import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits
@@ -17,14 +16,16 @@ instance PartedVal TableType where
pval = map toLower . show
-- | A disk's partition table.
-data PartTable = PartTable TableType [Partition]
+data PartTable = PartTable TableType Alignment [Partition]
deriving (Show)
instance Monoid PartTable where
- -- | default TableType is MSDOS
- mempty = PartTable MSDOS []
+ -- | default TableType is MSDOS, with a `safeAlignment`.
+ mempty = PartTable MSDOS safeAlignment []
-- | uses the TableType of the second parameter
- mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2)
+ -- and the larger alignment,
+ mappend (PartTable _l1 a1 ps1) (PartTable l2 a2 ps2) =
+ PartTable l2 (max a1 a2) (ps1 ++ ps2)
-- | A partition on the disk.
data Partition = Partition
@@ -57,34 +58,50 @@ instance PartedVal PartType where
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
+-- | Size of a partition.
+data PartSize
+ -- Since disk sizes are typically given in MB, not MiB, this
+ -- uses SI MegaBytes (powers of 10).
+ = MegaBytes Integer
+ -- For more control, the partition size can be given in bytes.
+ -- Note that this will prevent any automatic alignment from
+ -- being done.
+ | Bytes 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)
+toPartSize = toPartSize' ceiling
+
+toPartSize' :: (Double -> Integer) -> ByteSize -> PartSize
+toPartSize' rounder b = MegaBytes $ rounder (fromInteger b / 1000000 :: Double)
fromPartSize :: PartSize -> ByteSize
fromPartSize (MegaBytes b) = b * 1000000
+fromPartSize (Bytes n) = n
instance Monoid PartSize where
mempty = MegaBytes 0
mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)
+ mappend (Bytes a) b = Bytes (a + fromPartSize b)
+ mappend a (Bytes b) = Bytes (b + fromPartSize a)
reducePartSize :: PartSize -> PartSize -> PartSize
reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
+-- | Partitions need to be aligned for optimal efficiency.
+-- The alignment is a number of bytes.
+newtype Alignment = Alignment ByteSize
+ deriving (Show, Eq, Ord)
+
+-- | 4MiB alignment is optimal for inexpensive flash drives and
+-- is a good safe default for all drives.
+safeAlignment :: Alignment
+safeAlignment = Alignment (4*1024*1024)
+
+fromAlignment :: Alignment -> ByteSize
+fromAlignment (Alignment n) = n
+
-- | Flags that can be set on a partition.
data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag
deriving (Show)