module Propellor.Property.Grub (
GrubDevice,
OSDevice,
GrubTarget(..),
installed,
mkConfig,
installed',
configured,
cmdline_Linux_default,
boots,
bootsMounted,
TimeoutSecs,
chainPVGrub
) where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Mount
import Propellor.Property.Chroot (inChroot)
import Propellor.Types.Info
import Propellor.Types.Bootloader
import Utility.SafeCommand
import Data.List
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"
configured :: String -> String -> Property DebianLike
configured k v = ConfFile.adjustSection
("grub configured with " ++ k ++ "=" ++ v)
isline
(not . isline)
(const [l])
(const [l])
simpleConfigFile
`onChange` mkConfig
where
isline s = (k ++ "=") `isPrefixOf` s
l = k ++ "=" ++ shellEscape v
simpleConfigFile :: FilePath
simpleConfigFile = "/etc/default/grub"
cmdline_Linux_default :: String -> RevertableProperty DebianLike DebianLike
cmdline_Linux_default w = setup <!> undo
where
setup = ConfFile.adjustSection
("linux command line includes " ++ w)
isline
(not . isline)
(map (mkline . addw . getws))
(++ [mkline [w]])
simpleConfigFile
`onChange` mkConfig
undo = ConfFile.adjustSection
("linux command line does not include " ++ w)
isline
(not . isline)
(map (mkline . rmw . getws))
(++ [mkline [""]])
simpleConfigFile
`onChange` mkConfig
k = "GRUB_CMDLINE_LINUX_DEFAULT"
isline s = (k ++ "=") `isPrefixOf` s
mkline ws = k ++ "=" ++ shellEscape (unwords ws)
getws = concatMap words . shellUnEscape . drop 1 . dropWhile (/= '=')
addw ws
| w `elem` ws = ws
| otherwise = ws ++ [w]
rmw = filter (/= w)
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