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.Types.Info import Propellor.Types.Bootloader import Propellor.Types.Container import Utility.SafeCommand import Data.List -- | Eg, \"hd0,0\" or \"xen/xvda1\" type GrubDevice = String -- | Eg, \"\/dev/sda\" type OSDevice = String -- | Installs the grub package. This does not make grub be used as the -- bootloader. -- -- This includes running update-grub, unless it's run in a chroot -- or container. installed :: GrubTarget -> Property (HasInfo + DebianLike) installed grubtarget = installed' grubtarget `onChange` (check (not <$> hasContainerCapability FilesystemContained) mkConfig) -- | Run update-grub, to generate the grub boot menu. It will be -- automatically updated when kernel packages are installed. mkConfig :: Property DebianLike mkConfig = tightenTargets $ cmdProperty "update-grub" [] `assume` MadeChange -- | Installs grub; does not run update-grub. 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" -- | Sets a simple confguration value, using grub-mkconfig to update -- the grub boot menu accordingly. On Debian, these are written to -- -- -- Example: -- -- > & Grub.configured "GRUB_TIMEOUT" "10" -- > & Grub.configured "GRUB_TERMINAL_INPUT" "console serial" configured :: String -> String -> Property DebianLike configured k v = ConfFile.containsShellSetting simpleConfigFile (k, v) `describe` ("grub configured with " ++ k ++ "=" ++ v) `onChange` mkConfig simpleConfigFile :: FilePath simpleConfigFile = "/etc/default/grub" -- | Adds a word to the default linux command line. -- Any other words in the command line will be left unchanged. -- -- Example: -- -- > & Grub.cmdline_Linux_default "i915.enable_psr=1" -- > ! Grub.cmdline_Linux_default "quiet" 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) -- | Installs grub onto a device's boot loader, -- so the system can boot from that device. -- -- You may want to install grub to multiple devices; eg for a system -- that uses software RAID. -- -- Note that this property does not check if grub is already installed -- on the device; it always does the work to reinstall it. It's a good idea -- to arrange for this property to only run once, by eg making it be run -- onChange after OS.cleanInstallOnce. 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 -- | Use PV-grub chaining to boot -- -- Useful when the VPS's pv-grub is too old to boot a modern kernel image. -- -- -- -- The rootdev should be in the form "hd0", while the bootdev is in the form -- "xen/xvda". 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" -- | This is a version of `boots` that makes grub boot the system mounted -- at a particular directory. The OSDevice should be the underlying disk -- device that grub will be installed to (generally a whole disk, -- not a partition). bootsMounted :: FilePath -> OSDevice -> GrubTarget -> Property Linux bootsMounted mnt wholediskdev grubtarget = combineProperties desc $ props -- remove mounts that are done below to make sure the right thing -- gets mounted & cleanupmounts -- bind mount host /dev so grub can access the loop devices & 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 -- work around for http://bugs.debian.org/802717 & 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 -- sync all buffered changes out to the disk in case it's -- used right away & cmdProperty "sync" [] `assume` NoChange where desc = "grub boots " ++ wholediskdev -- cannot use since the filepath is absolute 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