    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

    -- | 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.
    installed :: GrubTarget -> Property (HasInfo + DebianLike)
    installed grubtarget = installed' grubtarget
    	`onChange` (check (not <$> inChroot) 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
    -- </etc/default/grub>
    --
    -- Example:
    --
    -- >	& Grub.configured "GRUB_TIMEOUT" "10"
    -- >	& Grub.configured "GRUB_TERMINAL_INPUT" "console serial"
    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"

    -- | 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.
    --
    -- <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 (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