diff options
Diffstat (limited to 'src/Propellor/Property/Parted.hs')
| -rw-r--r-- | src/Propellor/Property/Parted.hs | 77 |
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 |