From 4e20a920baa6c9106179c3d8a1e8e66ffd50ce9c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Dec 2017 16:10:34 -0400 Subject: disk partition alignment Cheap flash drives need partitions aligned to 4 MiB in order to not be slow (and to avoid extra writes). 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. --- src/Propellor/Property/DiskImage.hs | 6 +-- src/Propellor/Property/Parted.hs | 77 ++++++++++++++++++++++------------ src/Propellor/Property/Parted/Types.hs | 53 +++++++++++++++-------- 3 files changed, 89 insertions(+), 47 deletions(-) (limited to 'src/Propellor') 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) -- cgit v1.2.3