summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/DiskImage.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/DiskImage.hs')
-rw-r--r--src/Propellor/Property/DiskImage.hs144
1 files changed, 80 insertions, 64 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 90b7010b..9300b201 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -13,11 +13,7 @@ module Propellor.Property.DiskImage (
imageRebuilt,
imageBuiltFrom,
imageExists,
- -- * Finalization
- Finalization,
- grubBooted,
Grub.BIOS(..),
- noFinalization,
) where
import Propellor.Base
@@ -33,6 +29,8 @@ import Propellor.Property.Mount
import Propellor.Property.Fstab (SwapPartition(..), genFstab)
import Propellor.Property.Partition
import Propellor.Property.Rsync
+import Propellor.Types.Info
+import Propellor.Types.Bootloader
import Propellor.Container
import Utility.Path
@@ -49,7 +47,11 @@ type DiskImage = FilePath
-- First the specified Chroot is set up, and its properties are satisfied.
--
-- Then, the disk image is set up, and the chroot is copied into the
--- appropriate partition(s) of it.
+-- appropriate partition(s) of it.
+--
+-- The partitions default to being sized just large enough to fit the files
+-- from the chroot. You can use `addFreeSpace` to make them a bit larger
+-- than that, or `setSize` to use a fixed size.
--
-- Note that the disk image file is reused if it already exists,
-- to avoid expensive IO to generate a new one. And, it's updated in-place,
@@ -67,7 +69,7 @@ type DiskImage = FilePath
-- >
-- > foo = host "foo.example.com" $ props
-- > & imageBuilt "/srv/diskimages/disk.img" mychroot
--- > MSDOS (grubBooted PC)
+-- > MSDOS
-- > [ partition EXT2 `mountedAt` "/boot"
-- > `setFlag` BootFlag
-- > , partition EXT4 `mountedAt` "/"
@@ -79,6 +81,7 @@ type DiskImage = FilePath
-- > mychroot d = debootstrapped mempty d $ props
-- > & osDebian Unstable X86_64
-- > & Apt.installed ["linux-image-amd64"]
+-- > & Grub.installed PC
-- > & User.hasPassword (User "root")
-- > & User.accountFor (User "demo")
-- > & User.hasPassword (User "demo")
@@ -92,7 +95,7 @@ type DiskImage = FilePath
-- > foo = host "foo.example.com" $ props
-- > & imageBuilt "/srv/diskimages/bar-disk.img"
-- > (hostChroot bar (Debootstrapped mempty))
--- > MSDOS (grubBooted PC)
+-- > MSDOS
-- > [ partition EXT2 `mountedAt` "/boot"
-- > `setFlag` BootFlag
-- > , partition EXT4 `mountedAt` "/"
@@ -104,18 +107,19 @@ type DiskImage = FilePath
-- > bar = host "bar.example.com" $ props
-- > & osDebian Unstable X86_64
-- > & Apt.installed ["linux-image-amd64"]
+-- > & Grub.installed PC
-- > & hasPassword (User "root")
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageBuilt = imageBuilt' 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.
-imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageRebuilt = imageBuilt' True
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
-imageBuilt' rebuild img mkchroot tabletype final partspec =
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
+imageBuilt' rebuild img mkchroot tabletype partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
`requires` (cleanrebuild <!> (doNothing :: Property UnixLike))
@@ -135,12 +139,16 @@ imageBuilt' rebuild img mkchroot tabletype final partspec =
-- Before ensuring any other properties of the chroot,
-- avoid starting services. Reverted by imageFinalized.
&^ Chroot.noServices
- -- First stage finalization.
- & fst final
& cachesCleaned
-- Only propagate privdata Info from this chroot, nothing else.
propprivdataonly (Chroot.Chroot d b ip h) =
Chroot.Chroot d b (\c _ -> ip c onlyPrivData) h
+ -- Pick boot loader finalization based on which bootloader is
+ -- installed.
+ final = case fromInfo (containerInfo chroot) of
+ [GrubInstalled] -> grubBooted
+ [] -> unbootable "no bootloader is installed"
+ _ -> unbootable "multiple bootloaders are installed; don't know which to use"
-- | This property is automatically added to the chroot when building a
-- disk image. It cleans any caches of information that can be omitted;
@@ -247,7 +255,7 @@ getMountSz szm l (Just mntpt) =
--
-- If the file is too large, truncates it down to the specified size.
imageExists :: FilePath -> ByteSize -> Property Linux
-imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
+imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do
ms <- catchMaybeIO $ getFileStatus img
case ms of
Just s
@@ -258,21 +266,24 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
_ -> do
L.writeFile img (L.replicate (fromIntegral sz) 0)
return MadeChange
-
--- | A pair of properties. The first property is satisfied within the
--- chroot, and is typically used to download the boot loader.
---
--- The second property is run after the disk image is created,
--- with its populated partition tree mounted in the provided
--- location from the provided loop devices. This will typically
--- take care of installing the boot loader to the image.
+ where
+ sz = ceiling (fromInteger isz / sectorsize) * ceiling sectorsize
+ -- Disks have a sector size, and making a disk image not
+ -- aligned to a sector size will confuse some programs.
+ -- Common sector sizes are 512 and 4096; use 4096 as it's larger.
+ sectorsize = 4096 :: Double
+
+-- | A property that is run after the disk image is created, with
+-- its populated partition tree mounted in the provided
+-- location from the provided loop devices. This is typically used to
+-- install a boot loader in the image's superblock.
--
--- It's ok if the second property leaves additional things mounted
+-- It's ok if the property leaves additional things mounted
-- in the partition tree.
-type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
+type Finalization = (FilePath -> [LoopDev] -> Property Linux)
imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
-imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
+imageFinalized final mnts mntopts devs (PartTable _ parts) =
property' "disk image finalized" $ \w ->
withTmpDir "mnt" $ \top ->
go w top `finally` liftIO (unmountall top)
@@ -316,48 +327,53 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
allowservices top = nukeFile (top ++ "/usr/sbin/policy-rc.d")
-noFinalization :: Finalization
-noFinalization = (doNothing, \_ _ -> doNothing)
+unbootable :: String -> Finalization
+unbootable msg = \_ _ -> property desc $ do
+ warningMessage (desc ++ ": " ++ msg)
+ return FailedChange
+ where
+ desc = "image is not bootable"
-- | Makes grub be the boot loader of the disk image.
-grubBooted :: Grub.BIOS -> Finalization
-grubBooted bios = (Grub.installed' bios, boots)
+--
+-- This does not install the grub package. You will need to add
+-- the `Grub.installed` property to the chroot.
+grubBooted :: Finalization
+grubBooted mnt loopdevs = combineProperties "disk image boots using grub" $ props
+ -- bind mount host /dev so grub can access the loop devices
+ & bindMount "/dev" (inmnt "/dev")
+ & mounted "proc" "proc" (inmnt "/proc") mempty
+ & mounted "sysfs" "sys" (inmnt "/sys") mempty
+ -- update the initramfs so it gets the uuid of the root partition
+ & inchroot "update-initramfs" ["-u"]
+ `assume` MadeChange
+ -- work around for http://bugs.debian.org/802717
+ & check haveosprober (inchroot "chmod" ["-x", osprober])
+ & inchroot "update-grub" []
+ `assume` MadeChange
+ & check haveosprober (inchroot "chmod" ["+x", osprober])
+ & inchroot "grub-install" [wholediskloopdev]
+ `assume` MadeChange
+ -- sync all buffered changes out to the disk image
+ -- may not be necessary, but seemed needed sometimes
+ -- when using the disk image right away.
+ & cmdProperty "sync" []
+ `assume` NoChange
where
- boots mnt loopdevs = combineProperties "disk image boots using grub" $ props
- -- bind mount host /dev so grub can access the loop devices
- & bindMount "/dev" (inmnt "/dev")
- & mounted "proc" "proc" (inmnt "/proc") mempty
- & mounted "sysfs" "sys" (inmnt "/sys") mempty
- -- update the initramfs so it gets the uuid of the root partition
- & inchroot "update-initramfs" ["-u"]
- `assume` MadeChange
- -- work around for http://bugs.debian.org/802717
- & check haveosprober (inchroot "chmod" ["-x", osprober])
- & inchroot "update-grub" []
- `assume` MadeChange
- & check haveosprober (inchroot "chmod" ["+x", osprober])
- & inchroot "grub-install" [wholediskloopdev]
- `assume` MadeChange
- -- sync all buffered changes out to the disk image
- -- may not be necessary, but seemed needed sometimes
- -- when using the disk image right away.
- & cmdProperty "sync" []
- `assume` NoChange
- where
- -- cannot use </> since the filepath is absolute
- inmnt f = mnt ++ f
-
- inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
-
- haveosprober = doesFileExist (inmnt osprober)
- osprober = "/etc/grub.d/30_os-prober"
-
- -- It doesn't matter which loopdev we use; all
- -- come from the same disk image, and it's the loop dev
- -- for the whole disk image we seek.
- wholediskloopdev = case loopdevs of
- (l:_) -> wholeDiskLoopDev l
- [] -> error "No loop devs provided!"
+ -- cannot use </> since the filepath is absolute
+ inmnt f = mnt ++ f
+
+ inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
+
+ haveosprober = doesFileExist (inmnt osprober)
+ osprober = "/etc/grub.d/30_os-prober"
+
+ -- It doesn't matter which loopdev we use; all
+ -- come from the same disk image, and it's the loop dev
+ -- for the whole disk image we seek.
+ wholediskloopdev = case loopdevs of
+ (l:_) -> wholeDiskLoopDev l
+ [] -> error "No loop devs provided!"
isChild :: FilePath -> Maybe MountPoint -> Bool
isChild mntpt (Just d)