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