diff options
Diffstat (limited to 'src/Propellor/Property/Reboot.hs')
-rw-r--r-- | src/Propellor/Property/Reboot.hs | 111 |
1 files changed, 109 insertions, 2 deletions
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 5b854fa3..31731dc2 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -1,12 +1,34 @@ -module Propellor.Property.Reboot where +module Propellor.Property.Reboot ( + now, + atEnd, + toDistroKernel, + toKernelNewerThan, + KernelVersion, +) where import Propellor.Base +import Data.List +import Data.Version +import Text.ParserCombinators.ReadP + +-- | Kernel version number, in a string. +type KernelVersion = String + +-- | Using this property causes an immediate reboot. +-- +-- So, this is not a useful property on its own, but it can be useful to +-- compose with other properties. For example: +-- +-- > Apt.installed ["new-kernel"] +-- > `onChange` Reboot.now now :: Property Linux now = tightenTargets $ cmdProperty "reboot" [] `assume` MadeChange `describe` "reboot now" +type Force = Bool + -- | Schedules a reboot at the end of the current propellor run. -- -- The `Result` code of the entire propellor run can be checked; @@ -14,7 +36,7 @@ now = tightenTargets $ cmdProperty "reboot" [] -- -- The reboot can be forced to run, which bypasses the init system. Useful -- if the init system might not be running for some reason. -atEnd :: Bool -> (Result -> Bool) -> Property Linux +atEnd :: Force -> (Result -> Bool) -> Property Linux atEnd force resultok = property "scheduled reboot at end of propellor run" $ do endAction "rebooting" atend return NoChange @@ -28,3 +50,88 @@ atEnd force resultok = property "scheduled reboot at end of propellor run" $ do rebootparams | force = [Param "--force"] | otherwise = [] + +-- | Reboots immediately if a kernel other than the distro-installed kernel is +-- running. +-- +-- This will only work if you have taken measures to ensure that the other +-- kernel won't just get booted again. +-- See 'Propellor.Property.HostingProvider.DigitalOcean' +-- for an example of how to do this. +toDistroKernel :: Property DebianLike +toDistroKernel = check (not <$> runningInstalledKernel) now + `describe` "running installed kernel" + +-- | Given a kernel version string @v@, reboots immediately if the running +-- kernel version is strictly less than @v@ and there is an installed kernel +-- version is greater than or equal to @v@. Fails if the requested kernel +-- version is not installed. +-- +-- For this to be useful, you need to have ensured that the installed kernel +-- with the highest version number is the one that will be started after a +-- reboot. +-- +-- This is useful when upgrading to a new version of Debian where you need to +-- ensure that a new enough kernel is running before ensuring other properties. +toKernelNewerThan :: KernelVersion -> Property DebianLike +toKernelNewerThan ver = + property' ("reboot to kernel newer than " ++ ver) $ \w -> do + wantV <- tryReadVersion ver + runningV <- tryReadVersion =<< liftIO runningKernelVersion + installedV <- maximum <$> + (mapM tryReadVersion =<< liftIO installedKernelVersions) + if runningV >= wantV then noChange + else if installedV >= wantV + then ensureProperty w now + else errorMessage $ + "kernel newer than " + ++ ver + ++ " not installed" + +runningInstalledKernel :: IO Bool +runningInstalledKernel = do + kernelver <- runningKernelVersion + when (null kernelver) $ + error "failed to read uname -r" + kernelimages <- installedKernelImages + when (null kernelimages) $ + error "failed to find any installed kernel images" + findVersion kernelver <$> + readProcess "file" ("-L" : kernelimages) + +runningKernelVersion :: IO KernelVersion +runningKernelVersion = takeWhile (/= '\n') <$> readProcess "uname" ["-r"] + +installedKernelImages :: IO [String] +installedKernelImages = concat <$> mapM kernelsIn ["/", "/boot/"] + +-- | File output looks something like this, we want to unambiguously +-- match the running kernel version: +-- Linux kernel x86 boot executable bzImage, version 3.16-3-amd64 (debian-kernel@lists.debian.org) #1 SMP Debian 3.1, RO-rootFS, swap_dev 0x2, Normal VGA +findVersion :: KernelVersion -> String -> Bool +findVersion ver s = (" version " ++ ver ++ " ") `isInfixOf` s + +installedKernelVersions :: IO [KernelVersion] +installedKernelVersions = do + kernelimages <- installedKernelImages + when (null kernelimages) $ + error "failed to find any installed kernel images" + imageLines <- lines <$> readProcess "file" ("-L" : kernelimages) + return $ extractKernelVersion <$> imageLines + +kernelsIn :: FilePath -> IO [FilePath] +kernelsIn d = filter ("vmlinu" `isInfixOf`) <$> dirContents d + +extractKernelVersion :: String -> KernelVersion +extractKernelVersion = + unwords . take 1 . drop 1 . dropWhile (/= "version") . words + +readVersionMaybe :: KernelVersion -> Maybe Version +readVersionMaybe ver = case map fst $ readP_to_S parseVersion ver of + [] -> Nothing + l -> Just $ maximum l + +tryReadVersion :: KernelVersion -> Propellor Version +tryReadVersion ver = case readVersionMaybe ver of + Just x -> return x + Nothing -> errorMessage ("couldn't parse version " ++ ver) |