disk partition alignment

Cheap flash drives need partitions aligned to 4 MiB in order to not be slow
(and to avoid extra writes). <https://lwn.net/Articles/428584/>
And at least 1 MiB alignment is generally a good idea, and most people
seem to think 4 MiB is for all drives.

I noticed that Parted.partitioned does not do that; the first
partition started at an offset of 1 MB, and subsequent partitions
from where it ends. (The 1 MB offset came from the PartedVal PartSize
instance, and note that it was not 1 MiB.)

* Parted: Add an Alignment parameter. (API change)
  A good default to use is safeAlignment, which is 4MiB,
  well suited for inexpensive flash drives, and fine for other disks too.
  Previously, a very non-optimial 1MB (not 1MiB) alignment had been used.
* DiskImage: Use safeAlignment. It didn't seem worth making the
  alignment configurable here.

Alignment is implemented by offsetting the first partition's start
position so it's aligned (making sure to leave room for the partition
table). Each partition is then extended as needed so the next partition
will start properly aligned.

Note that parted rejects partition tables that don't fit in cylinder
bounderies. Before, propellor let parted deal with the fine details
of layout, so that was not a problem. Now it's possible to set some
wacky Alignment not divisible by 512, or use Byte sizes for partitions
and create a partition table that parted rejects. But, using
safeAlignment and MegaBytes should always be safe.

Also, this fixes a rounding bug in Parted.calcPartTable.
It was rounding up to the nearest MegaByte when allocating remaining
disk space, so returned partition table that was actually larger than
the disk size.

This commit was sponsored by an anonymous bitcoiner.

1 files changed, 51 insertions, 26 deletions

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