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
type GrubDevice = String
type OSDevice = String
installed :: GrubTarget -> Property (HasInfo + DebianLike)
installed :: GrubTarget -> Property (HasInfo + DebianLike)
installed GrubTarget
grubtarget = GrubTarget -> Property (HasInfo + DebianLike)
installed' GrubTarget
grubtarget
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContainerCapability -> Propellor Bool
hasContainerCapability ContainerCapability
FilesystemContained) Property DebianLike
mkConfig)
mkConfig :: Property DebianLike
mkConfig :: Property DebianLike
mkConfig = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$ String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"update-grub" []
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
installed' :: GrubTarget -> Property (HasInfo + DebianLike)
installed' :: GrubTarget -> Property (HasInfo + DebianLike)
installed' GrubTarget
grubtarget = forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property DebianLike
aptinstall
(forall v. IsInfo v => v -> Info
toInfo [GrubTarget -> BootloaderInstalled
GrubInstalled GrubTarget
grubtarget])
forall p. IsProp p => p -> String -> p
`describe` String
"grub package installed"
where
aptinstall :: Property DebianLike
aptinstall = [String] -> Property DebianLike
Apt.installed [String
debpkg]
debpkg :: String
debpkg = case GrubTarget
grubtarget of
GrubTarget
PC -> String
"grub-pc"
GrubTarget
EFI64 -> String
"grub-efi-amd64"
GrubTarget
EFI32 -> String
"grub-efi-ia32"
GrubTarget
Coreboot -> String
"grub-coreboot"
GrubTarget
Xen -> String
"grub-xen"
configured :: String -> String -> Property DebianLike
configured :: String -> String -> Property DebianLike
configured String
k String
v = String -> (String, String) -> Property UnixLike
ConfFile.containsShellSetting String
simpleConfigFile (String
k, String
v)
forall p. IsProp p => p -> String -> p
`describe` (String
"grub configured with " forall a. [a] -> [a] -> [a]
++ String
k forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
v)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
mkConfig
simpleConfigFile :: FilePath
simpleConfigFile :: String
simpleConfigFile = String
"/etc/default/grub"
cmdline_Linux_default :: String -> RevertableProperty DebianLike DebianLike
cmdline_Linux_default :: String -> RevertableProperty DebianLike DebianLike
cmdline_Linux_default String
w = Property DebianLike
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
undo
where
setup :: CombinedType (Property UnixLike) (Property DebianLike)
setup = String
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> String
-> Property UnixLike
ConfFile.adjustSection
(String
"linux command line includes " forall a. [a] -> [a] -> [a]
++ String
w)
SectionStart
isline
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline)
(forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
mkline forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjustSection
addw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
getws))
(forall a. [a] -> [a] -> [a]
++ [[String] -> String
mkline [String
w]])
String
simpleConfigFile
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
mkConfig
undo :: CombinedType (Property UnixLike) (Property DebianLike)
undo = String
-> SectionStart
-> SectionStart
-> AdjustSection
-> AdjustSection
-> String
-> Property UnixLike
ConfFile.adjustSection
(String
"linux command line does not include " forall a. [a] -> [a] -> [a]
++ String
w)
SectionStart
isline
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionStart
isline)
(forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
mkline forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdjustSection
rmw forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
getws))
(forall a. [a] -> [a] -> [a]
++ [[String] -> String
mkline [String
""]])
String
simpleConfigFile
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
mkConfig
k :: String
k = String
"GRUB_CMDLINE_LINUX_DEFAULT"
isline :: SectionStart
isline String
s = (String
k forall a. [a] -> [a] -> [a]
++ String
"=") forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
mkline :: [String] -> String
mkline [String]
ws = String
k forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String -> String
shellEscape ([String] -> String
unwords [String]
ws)
getws :: String -> [String]
getws = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
shellUnEscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TimeoutSecs -> [a] -> [a]
drop TimeoutSecs
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=')
addw :: AdjustSection
addw [String]
ws
| String
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ws = [String]
ws
| Bool
otherwise = [String]
ws forall a. [a] -> [a] -> [a]
++ [String
w]
rmw :: AdjustSection
rmw = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
w)
boots :: OSDevice -> Property Linux
boots :: String -> Property Linux
boots String
dev = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (String
"grub boots " forall a. [a] -> [a] -> [a]
++ String
dev) forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w -> do
[BootloaderInstalled]
grubtarget <- forall v. IsInfo v => Propellor v
askInfo
let ps :: [String]
ps = case [BootloaderInstalled]
grubtarget of
[GrubInstalled GrubTarget
t] -> [GrubTarget -> String
targetParam GrubTarget
t]
[BootloaderInstalled]
_ -> []
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
w forall a b. (a -> b) -> a -> b
$
String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"grub-install" ([String]
ps forall a. [a] -> [a] -> [a]
++ [String
dev])
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
targetParam :: GrubTarget -> String
targetParam :: GrubTarget -> String
targetParam GrubTarget
t = String
"--target=" forall a. [a] -> [a] -> [a]
++ case GrubTarget
t of
GrubTarget
PC -> String
"i386-pc"
GrubTarget
EFI32 -> String
"i386-efi"
GrubTarget
EFI64 -> String
"x86_64-efi"
GrubTarget
Coreboot -> String
"i386-coreboot"
GrubTarget
Xen -> String
"x86_64-xen"
type TimeoutSecs = Int
chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property (HasInfo + DebianLike)
chainPVGrub :: String -> String -> TimeoutSecs -> Property (HasInfo + DebianLike)
chainPVGrub String
rootdev String
bootdev TimeoutSecs
timeout = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Property UnixLike
File.dirExists String
"/boot/grub"
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
"/boot/grub/menu.lst" String -> [String] -> Property UnixLike
`File.hasContent`
[ String
"default 1"
, String
"timeout " forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val TimeoutSecs
timeout
, String
""
, String
"title grub-xen shim"
, String
"root (" forall a. [a] -> [a] -> [a]
++ String
rootdev forall a. [a] -> [a] -> [a]
++ String
")"
, String
"kernel /boot/xen-shim"
, String
"boot"
]
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
"/boot/load.cf" String -> [String] -> Property UnixLike
`File.hasContent`
[ String
"configfile (" forall a. [a] -> [a] -> [a]
++ String
bootdev forall a. [a] -> [a] -> [a]
++ String
")/boot/grub/grub.cfg" ]
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& GrubTarget -> Property (HasInfo + DebianLike)
installed GrubTarget
Xen
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& forall a b c. (a -> b -> c) -> b -> a -> c
flip forall i. Property i -> String -> Property i
flagFile String
"/boot/xen-shim" Property UnixLike
xenshim
where
desc :: String
desc = String
"chain PV-grub"
xenshim :: Property UnixLike
xenshim = [String] -> UncheckedProperty UnixLike
scriptProperty [String
"grub-mkimage --prefix '(" forall a. [a] -> [a] -> [a]
++ String
bootdev forall a. [a] -> [a] -> [a]
++ String
")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall p. IsProp p => p -> String -> p
`describe` String
"/boot-xen-shim"
bootsMounted :: FilePath -> OSDevice -> GrubTarget -> Property Linux
bootsMounted :: String -> String -> GrubTarget -> Property Linux
bootsMounted String
mnt String
wholediskdev GrubTarget
grubtarget = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property Linux
cleanupmounts
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> String -> Property Linux
bindMount String
"/dev" (String -> String
inmnt String
"/dev")
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> String -> String -> MountOpts -> Property UnixLike
mounted String
"proc" String
"proc" (String -> String
inmnt String
"/proc") forall a. Monoid a => a
mempty
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> String -> String -> MountOpts -> Property UnixLike
mounted String
"sysfs" String
"sys" (String -> String
inmnt String
"/sys") forall a. Monoid a => a
mempty
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> [String] -> UncheckedProperty UnixLike
inchroot String
"update-initramfs" [String
"-u"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
haveosprober (String -> [String] -> UncheckedProperty UnixLike
inchroot String
"chmod" [String
"-x", String
osprober])
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> [String] -> UncheckedProperty UnixLike
inchroot String
"update-grub" []
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
haveosprober (String -> [String] -> UncheckedProperty UnixLike
inchroot String
"chmod" [String
"+x", String
osprober])
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> [String] -> UncheckedProperty UnixLike
inchroot String
"grub-install" [GrubTarget -> String
targetParam GrubTarget
grubtarget, String
wholediskdev]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& Property Linux
cleanupmounts
forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"sync" []
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
NoChange
where
desc :: String
desc = String
"grub boots " forall a. [a] -> [a] -> [a]
++ String
wholediskdev
inmnt :: String -> String
inmnt String
f = String
mnt forall a. [a] -> [a] -> [a]
++ String
f
inchroot :: String -> [String] -> UncheckedProperty UnixLike
inchroot String
cmd [String]
ps = String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"chroot" ([String
mnt, String
cmd] forall a. [a] -> [a] -> [a]
++ [String]
ps)
haveosprober :: IO Bool
haveosprober = String -> IO Bool
doesFileExist (String -> String
inmnt String
osprober)
osprober :: String
osprober = String
"/etc/grub.d/30_os-prober"
cleanupmounts :: Property Linux
cleanupmounts :: Property Linux
cleanupmounts = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
desc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
cleanup String
"/sys"
String -> IO ()
cleanup String
"/proc"
String -> IO ()
cleanup String
"/dev"
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
where
cleanup :: String -> IO ()
cleanup String
m =
let mp :: String
mp = String -> String
inmnt String
m
in forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> IO Bool
isMounted String
mp) forall a b. (a -> b) -> a -> b
$
String -> IO ()
umountLazy String
mp