module Propellor.Property.Grub (
GrubDevice,
OSDevice,
GrubTarget(..),
installed,
mkConfig,
installed',
boots,
bootsMounted,
TimeoutSecs,
chainPVGrub
) where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Mount
import Propellor.Property.Chroot (inChroot)
import Propellor.Types.Info
import Propellor.Types.Bootloader
type GrubDevice = String
type OSDevice = String
installed :: GrubTarget -> Property (HasInfo + DebianLike)
installed grubtarget = installed' grubtarget
`onChange` (check (not <$> inChroot) mkConfig)
mkConfig :: Property DebianLike
mkConfig = tightenTargets $ cmdProperty "update-grub" []
`assume` MadeChange
installed' :: GrubTarget -> Property (HasInfo + DebianLike)
installed' grubtarget = setInfoProperty aptinstall
(toInfo [GrubInstalled grubtarget])
`describe` "grub package installed"
where
aptinstall = Apt.installed [debpkg]
debpkg = case grubtarget of
PC -> "grub-pc"
EFI64 -> "grub-efi-amd64"
EFI32 -> "grub-efi-ia32"
Coreboot -> "grub-coreboot"
Xen -> "grub-xen"
boots :: OSDevice -> Property Linux
boots dev = property' ("grub boots " ++ dev) $ \w -> do
grubtarget <- askInfo
let ps = case grubtarget of
[GrubInstalled t] -> [targetParam t]
_ -> []
ensureProperty w $
cmdProperty "grub-install" (ps ++ [dev])
`assume` MadeChange
targetParam :: GrubTarget -> String
targetParam t = "--target=" ++ case t of
PC -> "i386-pc"
EFI32 -> "i386-efi"
EFI64 -> "x86_64-efi"
Coreboot -> "i386-coreboot"
Xen -> "x86_64-xen"
type TimeoutSecs = Int
chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property (HasInfo + DebianLike)
chainPVGrub rootdev bootdev timeout = combineProperties desc $ props
& File.dirExists "/boot/grub"
& "/boot/grub/menu.lst" `File.hasContent`
[ "default 1"
, "timeout " ++ val timeout
, ""
, "title grub-xen shim"
, "root (" ++ rootdev ++ ")"
, "kernel /boot/xen-shim"
, "boot"
]
& "/boot/load.cf" `File.hasContent`
[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
& installed Xen
& flip flagFile "/boot/xen-shim" xenshim
where
desc = "chain PV-grub"
xenshim = scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]
`assume` MadeChange
`describe` "/boot-xen-shim"
bootsMounted :: FilePath -> OSDevice -> GrubTarget -> Property Linux
bootsMounted mnt wholediskdev grubtarget = combineProperties desc $ props
& cleanupmounts
& bindMount "/dev" (inmnt "/dev")
& mounted "proc" "proc" (inmnt "/proc") mempty
& mounted "sysfs" "sys" (inmnt "/sys") mempty
& inchroot "update-initramfs" ["-u"]
`assume` MadeChange
& check haveosprober (inchroot "chmod" ["-x", osprober])
& inchroot "update-grub" []
`assume` MadeChange
& check haveosprober (inchroot "chmod" ["+x", osprober])
& inchroot "grub-install" [targetParam grubtarget, wholediskdev]
`assume` MadeChange
& cleanupmounts
& cmdProperty "sync" []
`assume` NoChange
where
desc = "grub boots " ++ wholediskdev
inmnt f = mnt ++ f
inchroot cmd ps = cmdProperty "chroot" ([mnt, cmd] ++ ps)
haveosprober = doesFileExist (inmnt osprober)
osprober = "/etc/grub.d/30_os-prober"
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