module Propellor.Property.Reboot (
now,
atEnd,
toDistroKernel,
toKernelNewerThan,
KernelVersion,
) where
import Propellor.Base
import Data.List
import Data.Version
import Text.ParserCombinators.ReadP
type KernelVersion = String
now :: Property Linux
now :: Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
now = 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
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"reboot" []
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall p. IsProp p => p -> String -> p
`describe` String
"reboot now"
type Force = Bool
atEnd :: Force -> (Result -> Bool) -> Property Linux
atEnd :: Bool
-> (Result -> Bool)
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
atEnd Bool
force Result -> Bool
resultok = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"scheduled reboot at end of propellor run" forall a b. (a -> b) -> a -> b
$ do
String -> (Result -> Propellor Result) -> Propellor ()
endAction String
"rebooting" forall {m :: * -> *}. MonadIO m => Result -> m Result
atend
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
where
atend :: Result -> m Result
atend Result
r
| Result -> Bool
resultok Result
r = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall t. ToResult t => t -> Result
toResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [CommandParam] -> IO Bool
boolSystem String
"reboot" [CommandParam]
rebootparams
| Bool
otherwise = do
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage String
"Not rebooting, due to status of propellor run."
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
rebootparams :: [CommandParam]
rebootparams
| Bool
force = [String -> CommandParam
Param String
"--force"]
| Bool
otherwise = []
toDistroKernel :: Property DebianLike
toDistroKernel :: Property DebianLike
toDistroKernel = 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
$ 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
<$> IO Bool
runningInstalledKernel) Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
now
forall p. IsProp p => p -> String -> p
`describe` String
"running installed kernel"
toKernelNewerThan :: KernelVersion -> Property DebianLike
toKernelNewerThan :: String -> Property DebianLike
toKernelNewerThan String
ver =
forall {k} (metatypes :: k).
SingI metatypes =>
String
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (String
"reboot to kernel newer than " forall a. [a] -> [a] -> [a]
++ String
ver) forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
Version
wantV <- String -> Propellor Version
tryReadVersion String
ver
Version
runningV <- String -> Propellor Version
tryReadVersion forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
runningKernelVersion
if Version
runningV forall a. Ord a => a -> a -> Bool
>= Version
wantV then Propellor Result
noChange
else forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor [Version]
installedVs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Version
installedV ->
if Version
installedV forall a. Ord a => a -> a -> Bool
>= Version
wantV
then forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux])
now
else forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage forall a b. (a -> b) -> a -> b
$
String
"kernel newer than "
forall a. [a] -> [a] -> [a]
++ String
ver
forall a. [a] -> [a] -> [a]
++ String
" not installed"
where
installedVs :: Propellor [Version]
installedVs = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Propellor Version
tryReadVersion forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
installedKernelVersions
runningInstalledKernel :: IO Bool
runningInstalledKernel :: IO Bool
runningInstalledKernel = do
String
kernelver <- IO String
runningKernelVersion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
kernelver) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error String
"failed to read uname -r"
[String]
kernelimages <- IO [String]
installedKernelImages
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
kernelimages) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error String
"failed to find any installed kernel images"
String -> String -> Bool
findVersion String
kernelver forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
String -> [String] -> IO String
readProcess String
"file" (String
"-L" forall a. a -> [a] -> [a]
: [String]
kernelimages)
runningKernelVersion :: IO KernelVersion
runningKernelVersion :: IO String
runningKernelVersion = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"uname" [String
"-r"]
installedKernelImages :: IO [String]
installedKernelImages :: IO [String]
installedKernelImages = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
kernelsIn [String
"/", String
"/boot/"]
findVersion :: KernelVersion -> String -> Bool
findVersion :: String -> String -> Bool
findVersion String
ver String
s = (String
" version " forall a. [a] -> [a] -> [a]
++ String
ver forall a. [a] -> [a] -> [a]
++ String
" ") forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s
installedKernelVersions :: IO [KernelVersion]
installedKernelVersions :: IO [String]
installedKernelVersions = do
[String]
kernelimages <- IO [String]
installedKernelImages
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
kernelimages) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> a
error String
"failed to find any installed kernel images"
[String]
imageLines <- String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"file" (String
"-L" forall a. a -> [a] -> [a]
: [String]
kernelimages)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String
extractKernelVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
imageLines
kernelsIn :: FilePath -> IO [FilePath]
kernelsIn :: String -> IO [String]
kernelsIn String
d = forall a. (a -> Bool) -> [a] -> [a]
filter (String
"vmlinu" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
dirContents String
d
extractKernelVersion :: String -> KernelVersion
=
[String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
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
/= String
"version") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
readVersionMaybe :: KernelVersion -> Maybe Version
readVersionMaybe :: String -> Maybe Version
readVersionMaybe String
ver = case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
ver of
[] -> forall a. Maybe a
Nothing
[Version]
l -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Version]
l
tryReadVersion :: KernelVersion -> Propellor Version
tryReadVersion :: String -> Propellor Version
tryReadVersion String
ver = case String -> Maybe Version
readVersionMaybe String
ver of
Just Version
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Version
x
Maybe Version
Nothing -> forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage (String
"couldn't parse version " forall a. [a] -> [a] -> [a]
++ String
ver)