summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Reboot.hs
blob: 909d87fb8028457ee5411a5c08d46d098082f66b (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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
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;
-- the reboot proceeds only if the function returns True.
--
-- 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 :: Force -> (Result -> Bool) -> Property Linux
atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
	endAction "rebooting" atend
	return NoChange
  where
	atend r
		| resultok r = liftIO $ toResult
			<$> boolSystem "reboot" rebootparams
		| otherwise = do
			warningMessage "Not rebooting, due to status of propellor run."
			return FailedChange
	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 = tightenTargets $ 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
		if runningV >= wantV then noChange
			else maximum <$> installedVs >>= \installedV ->
				if installedV >= wantV
					then ensureProperty w now
					else errorMessage $
						"kernel newer than "
						++ ver
						++ " not installed"
  where
	installedVs = mapM tryReadVersion =<< liftIO installedKernelVersions

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)