From e85a15d160005929a9d5ea5cb21c25751856c5ae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Sep 2015 11:09:50 -0700 Subject: keystone for disk image creation Untested, and grub booting not done. --- src/Propellor/Property/DiskImage.hs | 65 +++++++++++++++++++++++++++++-------- src/Propellor/Property/Parted.hs | 11 +++++++ 2 files changed, 63 insertions(+), 13 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 5bdd8f1a..f649b7bb 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -3,6 +3,7 @@ module Propellor.Property.DiskImage ( built, rebuilt, + exists, MountPoint, MkPartTable, fitChrootSize, @@ -13,14 +14,17 @@ module Propellor.Property.DiskImage ( ) where import Propellor -import Propellor.Property.Chroot +import Propellor.Property.Chroot (Chroot) +import qualified Propellor.Property.Chroot as Chroot import Propellor.Property.Parted import qualified Propellor.Property.Grub as Grub +import qualified Propellor.Property.File as File import qualified Data.Map.Strict as M +import qualified Data.ByteString.Lazy as L import System.Posix.Files --- | Creates a bootable disk image. +-- | Creates a bootable disk image in the specified file. -- -- First the specified Chroot is set up, and its properties are satisfied. -- @@ -39,21 +43,51 @@ import System.Posix.Files -- > , (Nothing, const (mkPartition LinuxSwap (MegaBytes 256))) -- > ] -- > in built chroot partitions (grubBooted PC) -built :: (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty +built :: FilePath -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty built = built' False -- | Like 'built', but the chroot is deleted and rebuilt from scratch each -- time. This is more expensive, but useful to ensure reproducible results -- when the properties of the chroot have been changed. -rebuilt :: (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty +rebuilt :: FilePath -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty rebuilt = built' True -built' :: Bool -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty -built' rebuild mkparttable mkchroot final = undefined +built' :: Bool -> FilePath -> (FilePath -> Chroot) -> MkPartTable -> DiskImageFinalization -> RevertableProperty +built' rebuild img mkchroot mkparttable final = + (mkimg unmkimg) + `requires` Chroot.provisioned (mkchroot chrootdir) + `describe` desc + where + desc = "built disk image " ++ img + unmkimg = File.notPresent img + chrootdir = img ++ ".chroot" + mkimg = property desc $ do + szm <- liftIO $ M.map toPartSize <$> dirSizes chrootdir + -- tie the knot! + let (mnts, t) = mkparttable (map (getMountSz szm) mnts) + let disksz = partTableSize t + ensureProperty $ + exists img disksz + `before` + partitioned YesReallyDeleteDiskContents img t --- TODO tie the knot --- let f = fitChrootSize MSDOS [(Just "/", mkPartition EXT2)] --- let (mnts, t) = f (map (MegaBytes . fromIntegral . length . show) mnts) +-- | Ensures that a disk image file of the specified size exists. +-- +-- If the file doesn't exist, or is too small, creates a new one, full of 0's. +-- +-- If the file is too large, truncates it down to the specified size. +exists :: FilePath -> ByteSize -> Property NoInfo +exists img sz = property ("disk image exists" ++ img) $ liftIO $ do + ms <- catchMaybeIO $ getFileStatus img + case ms of + Just s + | toInteger (fileSize s) == toInteger sz -> return NoChange + | toInteger (fileSize s) > toInteger sz -> do + setFileSize img (fromInteger sz) + return MadeChange + _ -> do + L.writeFile img (L.replicate (fromIntegral sz) 0) + return MadeChange -- | Generates a map of the sizes of the contents of -- every directory in a filesystem tree. @@ -78,20 +112,25 @@ dirSizes top = go M.empty top [top] -- | Where a partition is mounted. Use Nothing for eg, LinuxSwap. type MountPoint = Maybe FilePath +getMountSz :: (M.Map FilePath PartSize) -> MountPoint -> PartSize +getMountSz _ Nothing = defSz +getMountSz szm (Just mntpt) = M.findWithDefault defSz mntpt szm + +defSz :: PartSize +defSz = MegaBytes 128 + -- | This is provided with a list of the sizes of directories in the chroot -- under each mount point. The input list corresponds to the list of mount -- points that the function returns! This trick is accomplished by -- exploiting laziness and tying the knot. -- --- (Partitions that are not mounted (ie, LinuxSwap) will have 128 MegaBytes +-- (Partitions that are not to be mounted (ie, LinuxSwap), or that have +-- no corresponding directory in the chroot will have 128 MegaBytes -- provided as a default size.) type MkPartTable = [PartSize] -> ([MountPoint], PartTable) -- | The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition. --- --- Partitions that are not mounted (ie, LinuxSwap) will have their size --- set to 128 MegaBytes, unless it's overridden. fitChrootSize :: TableType -> [(MountPoint, PartSize -> Partition)] -> MkPartTable fitChrootSize tt l basesizes = (mounts, parttable) where diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 29d94b4c..4e2efe24 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -3,12 +3,14 @@ module Propellor.Property.Parted ( TableType(..), PartTable(..), + partTableSize, Partition(..), mkPartition, Partition.Fs(..), PartSize(..), ByteSize, toPartSize, + fromPartSize, Partition.MkfsOpts, PartType(..), PartFlag(..), @@ -45,6 +47,12 @@ instance Monoid PartTable where -- | uses the TableType of the second parameter mappend (PartTable _l1 ps1) (PartTable l2 ps2) = PartTable l2 (ps1 ++ ps2) +-- | Gets the total size of the disk specified by the partition table. +partTableSize :: PartTable -> ByteSize +partTableSize (PartTable _ ps) = fromPartSize $ + -- add 1 megabyte to hold the partition table itself + mconcat (MegaBytes 1 : map partSize ps) + -- | A partition on the disk. data Partition = Partition { partType :: PartType @@ -89,6 +97,9 @@ instance PartedVal PartSize where toPartSize :: ByteSize -> PartSize toPartSize b = MegaBytes (b `div` 1000000) +fromPartSize :: PartSize -> ByteSize +fromPartSize (MegaBytes b) = b * 1000000 + instance Monoid PartSize where mempty = MegaBytes 0 mappend (MegaBytes a) (MegaBytes b) = MegaBytes (a + b) -- cgit v1.2.3