From 9f09b6236d33d68850f8d99d1ea482c47b47ae84 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 20:13:47 -0400 Subject: disk image finalization may work --- src/Propellor/Property/DiskImage.hs | 101 ++++++++++++++++++++++++++++-------- 1 file changed, 78 insertions(+), 23 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 8b74f478..4715ba08 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -2,8 +2,6 @@ -- -- This module is designed to be imported unqualified. -- --- TODO run final --- -- TODO avoid starting services while populating chroot and running final module Propellor.Property.DiskImage ( @@ -49,7 +47,8 @@ import Propellor.Property.Partition import Propellor.Property.Rsync import Utility.Path -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, sortBy) +import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.ByteString.Lazy as L import System.Posix.Files @@ -88,7 +87,7 @@ imageRebuilt = imageBuilt' True imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty imageBuilt' rebuild img mkchroot tabletype partspec final = - imageBuiltFrom img chrootdir tabletype partspec (snd final) + imageBuiltFrom img chrootdir tabletype partspec final `requires` Chroot.provisioned chroot `requires` (cleanrebuild doNothing) `describe` desc @@ -107,9 +106,7 @@ imageBuilt' rebuild img mkchroot tabletype partspec final = & Apt.cacheCleaned -- | Builds a disk image from the contents of a chroot. --- --- The passed property is run inside the mounted disk image. -imageBuiltFrom :: DiskImage -> FilePath -> TableType -> [PartSpec] -> Property NoInfo -> RevertableProperty +imageBuiltFrom :: DiskImage -> FilePath -> TableType -> [PartSpec] -> Finalization -> RevertableProperty imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg where desc = img ++ " built from " ++ chrootdir @@ -121,13 +118,18 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg <$> liftIO (dirSizes chrootdir) let calcsz mnts = maybe defSz fudge . getMountSz szm mnts -- tie the knot! - let (mnts, t) = fitChrootSize tabletype partspec (map (calcsz mnts) mnts) + let (mnts, t) = fitChrootSize tabletype partspec $ + map (calcsz mnts) mnts ensureProperty $ imageExists img (partTableSize t) `before` partitioned YesReallyDeleteDiskContents img t `before` - kpartx img (partitionsPopulated chrootdir mnts) + kpartx img (mkimg' mnts) + mkimg' mnts devs = + partitionsPopulated chrootdir mnts devs + `before` + imageFinalized final mnts devs rmimg = File.notPresent img partitionsPopulated :: FilePath -> [MountPoint] -> [LoopDev] -> Property NoInfo @@ -139,7 +141,7 @@ partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go m go (Just mnt) loopdev = withTmpDir "mnt" $ \tmpdir -> bracket (liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir) (const $ liftIO $ umountLazy tmpdir) - $ \mounted -> if mounted + $ \ismounted -> if ismounted then ensureProperty $ syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir else return FailedChange @@ -284,20 +286,73 @@ fitChrootSize tt l basesizes = (mounts, parttable) -- | 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 satisfied chrooted into the resulting --- disk image, and will typically take care of installing the boot loader --- to the disk image. -type Finalization = (Property NoInfo, Property NoInfo) +-- +-- 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. +-- +-- It's ok if the second property leaves additional things mounted +-- in the partition tree. +type Finalization = (Property NoInfo, (FilePath -> [LoopDev] -> Property NoInfo)) + +imageFinalized :: Finalization -> [MountPoint] -> [LoopDev] -> Property NoInfo +imageFinalized (_, final) mnts devs = property "disk image finalized" $ + withTmpDir "mnt" $ \top -> + go top `finally` liftIO (unmountall top) + where + go mnt = do + liftIO $ mountall mnt + ensureProperty $ final mnt devs + + -- Ordered lexographically by mount point, so / comes before /usr + -- comes before /usr/local + orderedmntsdevs :: [(MountPoint, LoopDev)] + orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts devs + + mountall top = forM_ orderedmntsdevs $ \(mp, loopdev) -> case mp of + Nothing -> noop + Just p -> do + let mnt = top ++ p + createDirectoryIfMissing True mnt + unlessM (mount "auto" (partitionLoopDev loopdev) mnt) $ + error $ "failed mounting " ++ mnt + + unmountall top = do + unmountBelow top + umountLazy top + +noFinalization :: Finalization +noFinalization = (doNothing, \_ _ -> doNothing) -- | Makes grub be the boot loader of the disk image. --- TODO not implemented grubBooted :: Grub.BIOS -> Finalization -grubBooted bios = (inchroot, inimg) +grubBooted bios = (Grub.installed' bios, boots) where - -- Need to set up device.map manually before running update-grub. - inchroot = Grub.installed' bios - - inimg = undefined - -noFinalization :: Finalization -noFinalization = (doNothing, doNothing) + boots mnt loopdevs = combineProperties "disk image boots using grub" + -- bind mount host /dev so grub can access the loop devices + [ mounted "bind" "/dev" (mnt <> "dev") + , mounted "proc" "proc" (mnt <> "proc") + , mounted "sysfs" "sys" (mnt <> "sys") + -- work around for http://bugs.debian.org/802717 + , check haveosprober $ inchroot "chmod" ["-x", osprober] + , inchroot "update-grub" [] + , check haveosprober $ inchroot "chmod" ["+x", osprober] + , inchroot "grub-install" [wholediskloopdev] + -- 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" [] + ] + where + inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps) + + haveosprober = doesFileExist (mnt ++ 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!" -- cgit v1.2.3