diff options
| -rw-r--r-- | debian/changelog | 9 | ||||
| -rw-r--r-- | propellor.cabal | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/DiskImage.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Property/Parted.hs | 77 | ||||
| -rw-r--r-- | src/Propellor/Property/Parted/Types.hs | 53 |
5 files changed, 98 insertions, 49 deletions
diff --git a/debian/changelog b/debian/changelog index 94cbca20..bfb884ce 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,14 @@ -propellor (5.1.1) UNRELEASED; urgency=medium +propellor (5.2.0) UNRELEASED; urgency=medium * bootstrappedFrom: Set up local privdata file. * Parted: Fix names used for FAT and VFAT partitions. + * 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. + * Fixed rounding bug in Parted.calcPartTable. -- Joey Hess <id@joeyh.name> Wed, 29 Nov 2017 11:45:08 -0400 diff --git a/propellor.cabal b/propellor.cabal index 5f9d9ce5..9837146a 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 5.1.0 +Version: 5.2.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name> 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) |