summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Parted.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Parted.hs')
-rw-r--r--src/Propellor/Property/Parted.hs77
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