summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/FlashKernel.hs
diff options
context:
space:
mode:
authorJoey Hess2017-11-17 15:14:02 -0400
committerJoey Hess2017-11-17 15:14:02 -0400
commit1a837867b8ae264fee2b9bacc8fd2a86d0f78ec8 (patch)
treebab422c65e7c8e93ad299351fe7a5a7c7bb39f43 /src/Propellor/Property/FlashKernel.hs
parentf9565ef960a321819fe0760a1277f17c087b5a18 (diff)
update initramfs and flash-kernel during disk image finalization
flashKernelMounted is slightly cargo culted from Grub.bootsMounted, could be refactored. This commit was sponsored by Thom May on Patreon.
Diffstat (limited to 'src/Propellor/Property/FlashKernel.hs')
-rw-r--r--src/Propellor/Property/FlashKernel.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/src/Propellor/Property/FlashKernel.hs b/src/Propellor/Property/FlashKernel.hs
index 7aa8420b..3f65f872 100644
--- a/src/Propellor/Property/FlashKernel.hs
+++ b/src/Propellor/Property/FlashKernel.hs
@@ -5,6 +5,7 @@ module Propellor.Property.FlashKernel where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.Mount
import Propellor.Types.Bootloader
import Propellor.Types.Info
@@ -25,3 +26,38 @@ installed machine = setInfoProperty go (toInfo [FlashKernelInstalled])
`onChange` (cmdProperty "flash-kernel" [] `assume` MadeChange)
`requires` File.dirExists "/etc/flash-kernel"
`requires` Apt.installed ["flash-kernel"]
+
+-- | Runs flash-kernel in the system mounted at a particular directory.
+flashKernelMounted :: FilePath -> Property Linux
+flashKernelMounted mnt = combineProperties desc $ props
+ -- remove mounts that are done below to make sure the right thing
+ -- gets mounted
+ & cleanupmounts
+ & 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
+ & inchroot "flash-kernel" []
+ `assume` MadeChange
+ & cleanupmounts
+ where
+ desc = "flash-kernel run"
+
+ -- cannot use </> since the filepath is absolute
+ inmnt f = mnt ++ f
+
+ inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
+
+ cleanupmounts :: Property Linux
+ cleanupmounts = property desc $ liftIO $ do
+ cleanup "/sys"
+ cleanup "/proc"
+ cleanup "/dev"
+ return NoChange
+ where
+ cleanup m =
+ let mp = inmnt m
+ in whenM (isMounted mp) $
+ umountLazy mp