summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-09-02 15:09:47 -0700
committerJoey Hess2015-09-02 15:09:47 -0700
commit418e6a5b4ee36360911cdff14f70357c5c2bfc80 (patch)
tree23eb35df201ba768246c5de5e6ea9b5f8ddcc605
parentf49dd3692708ea8e0adbaa701f562de264f40153 (diff)
propellor spin
-rw-r--r--src/Propellor/Property/DiskImage.hs36
-rw-r--r--src/Propellor/Property/Parted.hs4
2 files changed, 31 insertions, 9 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 59baa8d1..86be3a9b 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -33,6 +33,7 @@ import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.File as File
import Propellor.Property.Parted
import Propellor.Property.Mount
+import Utility.Path
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Lazy as L
@@ -85,13 +86,12 @@ imageBuilt' rebuild img mkchroot mkparttable final =
-- unmount helper filesystems such as proc from the chroot
-- before getting sizes
liftIO $ unmountBelow chrootdir
- szm <- liftIO $ M.mapKeys (toSysDir chrootdir) . M.map toPartSize
- <$> dirSizes chrootdir
+ szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
+ <$> liftIO (dirSizes chrootdir)
-- tie the knot!
- -- TODO when /boot is in part table, size of /
- -- should be reduced by sie of /boot
-- TODO if any size is < 1 MB, use 1 MB for sanity
- let (mnts, t) = mkparttable (map (getMountSz szm) mnts)
+ let (mnts, t) = mkparttable (map (saneSz . fromMaybe defSz . getMountSz szm mnts) mnts)
+ liftIO $ print (mnts, t)
ensureProperty $
imageExists img (partTableSize t)
`before`
@@ -140,6 +140,23 @@ dirSizes top = go M.empty top [top]
else go (M.insertWith (+) dir sz m) dir is
subdirof parent i = not (i `equalFilePath` parent) && takeDirectory i `equalFilePath` parent
+-- | Gets the size to allocate for a particular mount point, given the
+-- map of sizes.
+--
+-- A list of all mount points is provided, so that when eg calculating
+-- the size for /, if /boot is a mount point, its size can be subtracted.
+getMountSz :: (M.Map FilePath PartSize) -> [MountPoint] -> MountPoint -> Maybe PartSize
+getMountSz _ _ Nothing = Nothing
+getMountSz szm l (Just mntpt) =
+ fmap (`reducePartSize` childsz) (M.lookup mntpt szm)
+ where
+ childsz = mconcat $ catMaybes $
+ map (getMountSz szm l) (filter childmntpt l)
+ childmntpt Nothing = False
+ childmntpt (Just d)
+ | d `equalFilePath` mntpt = False
+ | otherwise = mntpt `dirContains` d
+
-- | From a location in a chroot (eg, /tmp/chroot/usr) to
-- the corresponding location inside (eg, /usr).
toSysDir :: FilePath -> FilePath -> FilePath
@@ -162,10 +179,11 @@ mountedAt mkp mntpoint = (Just mntpoint, mkp)
swapPartition :: PartSize -> PartSpec
swapPartition sz = (Nothing, const (mkPartition LinuxSwap sz))
-getMountSz :: (M.Map FilePath PartSize) -> MountPoint -> PartSize
-getMountSz _ Nothing = defSz
-getMountSz szm (Just mntpt) = M.findWithDefault defSz mntpt szm
-
+-- | Avoid partitions smaller than 1 mb; parted gets confused.
+saneSz :: PartSize -> PartSize
+saneSz (MegaBytes n) | n < 1 = MegaBytes 1
+saneSz sz = sz
+
defSz :: PartSize
defSz = MegaBytes 128
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index fcff089a..1ff8677a 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -11,6 +11,7 @@ module Propellor.Property.Parted (
ByteSize,
toPartSize,
fromPartSize,
+ reducePartSize,
Partition.MkfsOpts,
PartType(..),
PartFlag(..),
@@ -104,6 +105,9 @@ instance Monoid PartSize where
mempty = MegaBytes 0
mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b)
+reducePartSize :: PartSize -> PartSize -> PartSize
+reducePartSize (MegaBytes a) (MegaBytes b) = MegaBytes (a - b)
+
-- | Flags that can be set on a partition.
data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag
deriving (Show)