From cc8fbeda82774f6c9a223a87187408496fcd0d2b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 14:10:52 -0400 Subject: avoid grub install failure in chroot --- src/Propellor/Property/DiskImage.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 8d503e28..3c2b2200 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -292,7 +292,12 @@ type Finalization = (Property NoInfo, Property NoInfo) -- | Makes grub be the boot loader of the disk image. -- TODO not implemented grubBooted :: Grub.BIOS -> Finalization -grubBooted bios = (Grub.installed bios, undefined) +grubBooted bios = (inchroot, inimg) + where + -- Need to set up device.map manually before running update-grub. + inchroot = Grub.installed' bios + + inimg = undefined noFinalization :: Finalization noFinalization = (doNothing, doNothing) -- cgit v1.3-2-g0d8e From 6399d6d2722320346877071866414e450701fbf9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 16:23:24 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 6 +++--- src/Propellor/Property/Parted.hs | 2 +- src/Propellor/Property/Partition.hs | 23 +++++++++++++++++------ 3 files changed, 21 insertions(+), 10 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 3c2b2200..8b74f478 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -130,14 +130,14 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg kpartx img (partitionsPopulated chrootdir mnts) rmimg = File.notPresent img -partitionsPopulated :: FilePath -> [MountPoint] -> [FilePath] -> Property NoInfo +partitionsPopulated :: FilePath -> [MountPoint] -> [LoopDev] -> Property NoInfo partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs where desc = "partitions populated from " ++ chrootdir go Nothing _ = noChange - go (Just mnt) dev = withTmpDir "mnt" $ \tmpdir -> bracket - (liftIO $ mount "auto" dev tmpdir) + go (Just mnt) loopdev = withTmpDir "mnt" $ \tmpdir -> bracket + (liftIO $ mount "auto" (partitionLoopDev loopdev) tmpdir) (const $ liftIO $ umountLazy tmpdir) $ \mounted -> if mounted then ensureProperty $ diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 7bd38a65..834b6c7d 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -160,7 +160,7 @@ partitioned eep disk (PartTable tabletype parts) = property desc $ do [ parted eep disk partedparams , if isdev then formatl (map (\n -> disk ++ show n) [1 :: Int ..]) - else Partition.kpartx disk formatl + else Partition.kpartx disk (formatl . map Partition.partitionLoopDev) ] where desc = disk ++ " partitioned" diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs index 56bc1575..fa381d5d 100644 --- a/src/Propellor/Property/Partition.hs +++ b/src/Propellor/Property/Partition.hs @@ -41,20 +41,31 @@ formatted' opts YesReallyFormatPartition fs dev = -- Be quiet. q l = "-q":l +data LoopDev = LoopDev + { partitionLoopDev :: FilePath -- ^ device for a loop partition + , wholeDiskLoopDev :: FilePath -- ^ corresponding device for the whole loop disk + } deriving (Show) + -- | Uses the kpartx utility to create device maps for partitions contained --- within a disk image file. The resulting devices are passed to the +-- within a disk image file. The resulting loop devices are passed to the -- property, which can operate on them. Always cleans up after itself, -- by removing the device maps after the property is run. -kpartx :: FilePath -> ([FilePath] -> Property NoInfo) -> Property NoInfo +kpartx :: FilePath -> ([LoopDev] -> Property NoInfo) -> Property NoInfo kpartx diskimage mkprop = go `requires` Apt.installed ["kpartx"] where go = property (propertyDesc (mkprop [])) $ do cleanup -- idempotency s <- liftIO $ readProcess "kpartx" ["-avs", diskimage] - r <- ensureProperty (mkprop (devlist s)) + r <- ensureProperty (mkprop (kpartxParse s)) cleanup return r - devlist = mapMaybe (finddev . words) . lines - finddev ("add":"map":s:_) = Just ("/dev/mapper/" ++ s) - finddev _ = Nothing cleanup = void $ liftIO $ boolSystem "kpartx" [Param "-d", File diskimage] + +kpartxParse :: String -> [LoopDev] +kpartxParse = mapMaybe (finddev . words) . lines + where + finddev ("add":"map":ld:_:_:_:_:wd:_) = Just $ LoopDev + { partitionLoopDev = "/dev/mapper/" ++ ld + , wholeDiskLoopDev = wd + } + finddev _ = Nothing -- cgit v1.3-2-g0d8e 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 ++++++++++++++++++++++++++++-------- src/Propellor/Property/Mount.hs | 4 ++ 2 files changed, 82 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!" diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 30d057f5..25984afa 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -36,5 +36,9 @@ unmountBelow d = do forM_ submnts umountLazy -- | Mounts a device. +mounted :: FsType -> Source -> FilePath -> Property NoInfo +mounted fs src mnt = property (mnt ++ " mounted") $ + toResult <$> liftIO (mount fs src mnt) + mount :: FsType -> Source -> FilePath -> IO Bool mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] -- cgit v1.3-2-g0d8e From 69d1021c0c12bae52cbea2cc64399be4e4b3532f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 20:18:11 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 4715ba08..cb38cef3 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -331,9 +331,9 @@ grubBooted bios = (Grub.installed' bios, boots) where 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") + [ mounted "bind" "/dev" (inmnt "/dev") + , mounted "proc" "proc" (inmnt "/proc") + , mounted "sysfs" "sys" (inmnt "/sys") -- work around for http://bugs.debian.org/802717 , check haveosprober $ inchroot "chmod" ["-x", osprober] , inchroot "update-grub" [] @@ -345,9 +345,12 @@ grubBooted bios = (Grub.installed' bios, boots) , cmdProperty "sync" [] ] where + -- cannot use since the filepath is absolute + inmnt f = mnt ++ f + inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps) - haveosprober = doesFileExist (mnt ++ osprober) + haveosprober = doesFileExist (inmnt osprober) osprober = "/etc/grub.d/30_os-prober" -- It doesn't matter which loopdev we use; all -- cgit v1.3-2-g0d8e From c84005cbbf432a8296ee44fec83227b15ce18d38 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 20:22:52 -0400 Subject: propellor spin --- src/Propellor/Property/DiskImage.hs | 2 +- src/Propellor/Property/Mount.hs | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index cb38cef3..dcd522a3 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -331,7 +331,7 @@ grubBooted bios = (Grub.installed' bios, boots) where boots mnt loopdevs = combineProperties "disk image boots using grub" -- bind mount host /dev so grub can access the loop devices - [ mounted "bind" "/dev" (inmnt "/dev") + [ bindMount "/dev" (inmnt "/dev") , mounted "proc" "proc" (inmnt "/proc") , mounted "sysfs" "sys" (inmnt "/sys") -- work around for http://bugs.debian.org/802717 diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 25984afa..09016011 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -40,5 +40,11 @@ mounted :: FsType -> Source -> FilePath -> Property NoInfo mounted fs src mnt = property (mnt ++ " mounted") $ toResult <$> liftIO (mount fs src mnt) +-- | Bind mounts the first directory so its contents also appear +-- in the second directory. +bindMount :: FilePath -> FilePath -> Property NoInfo +bindMount src dest = cmdProperty "mount" ["--bind", src, dest] + `describe` ("bind mounted " ++ src ++ " to " ++ dest) + mount :: FsType -> Source -> FilePath -> IO Bool mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] -- cgit v1.3-2-g0d8e From 5db5d8418e27e187502e0807c3cbb7554dbbbcd1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 22 Oct 2015 20:52:11 -0400 Subject: propellor spin --- config-joey.hs | 11 +++++------ src/Propellor/Property/DiskImage.hs | 19 ++++++++++--------- 2 files changed, 15 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Property/DiskImage.hs') diff --git a/config-joey.hs b/config-joey.hs index cc1a9687..21d7194f 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -81,13 +81,12 @@ darkstar = host "darkstar.kitenet.net" & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net") & JoeySites.dkimMilter - & imageBuilt "/tmp/img" c MSDOS - [ - -- partition EXT2 `mountedAt` "/boot" `setFlag` BootFlag - partition EXT4 `mountedAt` "/" `addFreeSpace` MegaBytes 100 + & imageBuilt "/tmp/img" c MSDOS (grubBooted PC) + [ partition EXT4 `mountedAt` "/" + `addFreeSpace` MegaBytes 100 `setFlag` BootFlag - -- , swapPartition (MegaBytes 256) - ] (grubBooted PC) + , swapPartition (MegaBytes 256) + ] where c d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d & Apt.installed ["linux-image-amd64"] diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index dcd522a3..1e3a5407 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -69,25 +69,26 @@ type DiskImage = FilePath -- > let chroot d = Chroot.debootstrapped (System (Debian Unstable) "amd64") mempty d -- > & Apt.installed ["linux-image-amd64"] -- > & ... --- > in imageBuilt "/srv/images/foo.img" chroot MSDOS +-- > in imageBuilt "/srv/images/foo.img" chroot +-- > MSDOS (grubBooted PC) -- > [ partition EXT2 `mountedAt` "/boot" -- > `setFlag` BootFlag -- > , partition EXT4 `mountedAt` "/" -- > `addFreeSpace` MegaBytes 100 -- > , swapPartition (MegaBytes 256) --- > ] (grubBooted PC) -imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty +-- > ] +imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty 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 -> [PartSpec] -> Finalization -> RevertableProperty +imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty imageRebuilt = imageBuilt' True -imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec] -> Finalization -> RevertableProperty -imageBuilt' rebuild img mkchroot tabletype partspec final = - imageBuiltFrom img chrootdir tabletype partspec final +imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty +imageBuilt' rebuild img mkchroot tabletype final partspec = + imageBuiltFrom img chrootdir tabletype final partspec `requires` Chroot.provisioned chroot `requires` (cleanrebuild doNothing) `describe` desc @@ -106,8 +107,8 @@ imageBuilt' rebuild img mkchroot tabletype partspec final = & Apt.cacheCleaned -- | Builds a disk image from the contents of a chroot. -imageBuiltFrom :: DiskImage -> FilePath -> TableType -> [PartSpec] -> Finalization -> RevertableProperty -imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg +imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty +imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg where desc = img ++ " built from " ++ chrootdir mkimg = property desc $ do -- cgit v1.3-2-g0d8e