summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Grub.hs
blob: 09255587ad06d9d68daf00055abb1e9fb4d42736 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
module Propellor.Property.Grub where

import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt

-- | Eg, \"hd0,0\" or \"xen/xvda1\"
type GrubDevice = String

-- | Eg, \"\/dev/sda\"
type OSDevice = String

type TimeoutSecs = Int

-- | Types of machines that grub can boot.
data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen

-- | Installs the grub package. This does not make grub be used as the
-- bootloader.
--
-- This includes running update-grub.
installed :: BIOS -> Property DebianLike
installed bios = installed' bios `onChange` 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' :: BIOS -> Property DebianLike
installed' bios = Apt.installed [pkg] `describe` "grub package installed"
  where
	pkg = case bios of
		PC -> "grub-pc"
		EFI64 -> "grub-efi-amd64"
		EFI32 -> "grub-efi-ia32"
		Coreboot -> "grub-coreboot"
		Xen -> "grub-xen"

-- | Installs grub onto a device, 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 = tightenTargets $ cmdProperty "grub-install" [dev]
	`assume` MadeChange
	`describe` ("grub boots " ++ dev)

-- | Use PV-grub chaining to boot
--
-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
--
-- <http://notes.pault.ag/linode-pv-grub-chainning/>
--
-- The rootdev should be in the form "hd0", while the bootdev is in the form
-- "xen/xvda".
chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property DebianLike
chainPVGrub rootdev bootdev timeout = combineProperties desc $ props
	& File.dirExists "/boot/grub"
	& "/boot/grub/menu.lst" `File.hasContent`
		[ "default 1" 
		, "timeout " ++ show 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"